gcc/ada/cstand.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               C S T A N D                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Atree;    use Atree;
  28 with Csets;    use Csets;
  29 with Debug;    use Debug;
  30 with Einfo;    use Einfo;
  31 with Layout;   use Layout;
  32 with Namet;    use Namet;
  33 with Nlists;   use Nlists;
  34 with Nmake;    use Nmake;
  35 with Opt;      use Opt;
  36 with Output;   use Output;
  37 with Targparm; use Targparm;
  38 with Tbuild;   use Tbuild;
  39 with Ttypes;   use Ttypes;
  40 with Ttypef;   use Ttypef;
  41 with Scn;
  42 with Sem_Mech; use Sem_Mech;
  43 with Sem_Util; use Sem_Util;
  44 with Sinfo;    use Sinfo;
  45 with Snames;   use Snames;
  46 with Stand;    use Stand;
  47 with Uintp;    use Uintp;
  48 with Urealp;   use Urealp;
  49
  50 package body CStand is
  51
  52    Stloc  : constant Source_Ptr := Standard_Location;
  53    Staloc : constant Source_Ptr := Standard_ASCII_Location;
  54    --  Standard abbreviations used throughout this package
  55
  56    -----------------------
  57    -- Local Subprograms --
  58    -----------------------
  59
  60    procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int);
  61    --  Procedure to build standard predefined float base type. The first
  62    --  parameter is the entity for the type, and the second parameter
  63    --  is the size in bits. The third parameter is the digits value.
  64
  65    procedure Build_Signed_Integer_Type (E : Entity_Id; Siz : Int);
  66    --  Procedure to build standard predefined signed integer subtype. The
  67    --  first parameter is the entity for the subtype. The second parameter
  68    --  is the size in bits. The corresponding base type is not built by
  69    --  this routine but instead must be built by the caller where needed.
  70
  71    procedure Create_Operators;
  72    --  Make entries for each of the predefined operators in Standard
  73
  74    procedure Create_Unconstrained_Base_Type
  75      (E : Entity_Id;
  76       K : Entity_Kind);
  77    --  The predefined signed integer types are constrained subtypes which
  78    --  must have a corresponding unconstrained base type. This type is almost
  79    --  useless. The only place it has semantics is Subtypes_Statically_Match.
  80    --  Consequently, we arrange for it to be identical apart from the setting
  81    --  of the constrained bit. This routine takes an entity E for the Type,
  82    --  copies it to estabish the base type, then resets the Ekind of the
  83    --  original entity to K (the Ekind for the subtype). The Etype field of
  84    --  E is set by the call (to point to the created base type entity), and
  85    --  also the Is_Constrained flag of E is set.
  86    --
  87    --  To understand the exact requirement for this, see RM 3.5.4(11) which
  88    --  makes it clear that Integer, for example, is constrained, with the
  89    --  constraint bounds matching the bounds of the (unconstrained) base
  90    --  type. The point is that Integer and Integer'Base have identical
  91    --  bounds, but do not statically match, since a subtype with constraints
  92    --  never matches a subtype with no constraints.
  93
  94    function Identifier_For (S : Standard_Entity_Type) return Node_Id;
  95    --  Returns an identifier node with the same name as the defining
  96    --  identifier corresponding to the given Standard_Entity_Type value
  97
  98    procedure Make_Component
  99      (Rec : Entity_Id;
 100       Typ : Entity_Id;
 101       Nam : String);
 102    --  Build a record component with the given type and name, and append to
 103    --  the list of components of Rec.
 104
 105    function Make_Formal
 106      (Typ         : Entity_Id;
 107       Formal_Name : String) return Entity_Id;
 108    --  Construct entity for subprogram formal with given name and type
 109
 110    function Make_Integer (V : Uint) return Node_Id;
 111    --  Builds integer literal with given value
 112
 113    procedure Make_Name (Id : Entity_Id; Nam : String);
 114    --  Make an entry in the names table for Nam, and set as Chars field of Id
 115
 116    function New_Operator (Op : Name_Id; Typ : Entity_Id) return Entity_Id;
 117    --  Build entity for standard operator with given name and type
 118
 119    function New_Standard_Entity
 120      (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id;
 121    --  Builds a new entity for Standard
 122
 123    procedure Print_Standard;
 124    --  Print representation of package Standard if switch set
 125
 126    procedure Set_Integer_Bounds
 127      (Id  : Entity_Id;
 128       Typ : Entity_Id;
 129       Lb  : Uint;
 130       Hb  : Uint);
 131    --  Procedure to set bounds for integer type or subtype. Id is the entity
 132    --  whose bounds and type are to be set. The Typ parameter is the Etype
 133    --  value for the entity (which will be the same as Id for all predefined
 134    --  integer base types. The third and fourth parameters are the bounds.
 135
 136    ----------------------
 137    -- Build_Float_Type --
 138    ----------------------
 139
 140    procedure Build_Float_Type (E : Entity_Id; Siz : Int; Digs : Int) is
 141    begin
 142       Set_Type_Definition (Parent (E),
 143         Make_Floating_Point_Definition (Stloc,
 144           Digits_Expression => Make_Integer (UI_From_Int (Digs))));
 145       Set_Ekind                      (E, E_Floating_Point_Type);
 146       Set_Etype                      (E, E);
 147       Init_Size                      (E, Siz);
 148       Set_Elem_Alignment             (E);
 149       Init_Digits_Value              (E, Digs);
 150       Set_Float_Bounds               (E);
 151       Set_Is_Frozen                  (E);
 152       Set_Is_Public                  (E);
 153       Set_Size_Known_At_Compile_Time (E);
 154    end Build_Float_Type;
 155
 156    -------------------------------
 157    -- Build_Signed_Integer_Type --
 158    -------------------------------
 159
 160    procedure Build_Signed_Integer_Type (E : Entity_Id; Siz : Int) is
 161       U2Siz1 : constant Uint := 2 ** (Siz - 1);
 162       Lbound : constant Uint := -U2Siz1;
 163       Ubound : constant Uint := U2Siz1 - 1;
 164
 165    begin
 166       Set_Type_Definition (Parent (E),
 167         Make_Signed_Integer_Type_Definition (Stloc,
 168           Low_Bound  => Make_Integer (Lbound),
 169           High_Bound => Make_Integer (Ubound)));
 170
 171       Set_Ekind                      (E, E_Signed_Integer_Type);
 172       Set_Etype                      (E, E);
 173       Init_Size                      (E, Siz);
 174       Set_Elem_Alignment             (E);
 175       Set_Integer_Bounds             (E, E, Lbound, Ubound);
 176       Set_Is_Frozen                  (E);
 177       Set_Is_Public                  (E);
 178       Set_Is_Known_Valid             (E);
 179       Set_Size_Known_At_Compile_Time (E);
 180    end Build_Signed_Integer_Type;
 181
 182    ----------------------
 183    -- Create_Operators --
 184    ----------------------
 185
 186    --  Each operator has an abbreviated signature. The formals have the names
 187    --  LEFT and RIGHT. Their types are not actually used for resolution.
 188
 189    procedure Create_Operators is
 190       Op_Node : Entity_Id;
 191
 192       --  The following tables define the binary and unary operators and their
 193       --  corresponding result type.
 194
 195       Binary_Ops : constant array (S_Binary_Ops) of Name_Id :=
 196
 197          --  There is one entry here for each binary operator, except for the
 198          --  case of concatenation, where there are three entries, one for a
 199          --  String result, one for Wide_String, and one for Wide_Wide_String.
 200
 201         (Name_Op_Add,
 202          Name_Op_And,
 203          Name_Op_Concat,
 204          Name_Op_Concat,
 205          Name_Op_Concat,
 206          Name_Op_Divide,
 207          Name_Op_Eq,
 208          Name_Op_Expon,
 209          Name_Op_Ge,
 210          Name_Op_Gt,
 211          Name_Op_Le,
 212          Name_Op_Lt,
 213          Name_Op_Mod,
 214          Name_Op_Multiply,
 215          Name_Op_Ne,
 216          Name_Op_Or,
 217          Name_Op_Rem,
 218          Name_Op_Subtract,
 219          Name_Op_Xor);
 220
 221       Bin_Op_Types : constant array (S_Binary_Ops) of Entity_Id :=
 222
 223          --  This table has the corresponding result types. The entries are
 224          --  ordered so they correspond to the Binary_Ops array above.
 225
 226         (Universal_Integer,         -- Add
 227          Standard_Boolean,          -- And
 228          Standard_String,           -- Concat (String)
 229          Standard_Wide_String,      -- Concat (Wide_String)
 230          Standard_Wide_Wide_String, -- Concat (Wide_Wide_String)
 231          Universal_Integer,         -- Divide
 232          Standard_Boolean,          -- Eq
 233          Universal_Integer,         -- Expon
 234          Standard_Boolean,          -- Ge
 235          Standard_Boolean,          -- Gt
 236          Standard_Boolean,          -- Le
 237          Standard_Boolean,          -- Lt
 238          Universal_Integer,         -- Mod
 239          Universal_Integer,         -- Multiply
 240          Standard_Boolean,          -- Ne
 241          Standard_Boolean,          -- Or
 242          Universal_Integer,         -- Rem
 243          Universal_Integer,         -- Subtract
 244          Standard_Boolean);         -- Xor
 245
 246       Unary_Ops : constant array (S_Unary_Ops) of Name_Id :=
 247
 248          --  There is one entry here for each unary operator
 249
 250         (Name_Op_Abs,
 251          Name_Op_Subtract,
 252          Name_Op_Not,
 253          Name_Op_Add);
 254
 255       Unary_Op_Types : constant array (S_Unary_Ops) of Entity_Id :=
 256
 257          --  This table has the corresponding result types. The entries are
 258          --  ordered so they correspond to the Unary_Ops array above.
 259
 260         (Universal_Integer,     -- Abs
 261          Universal_Integer,     -- Subtract
 262          Standard_Boolean,      -- Not
 263          Universal_Integer);    -- Add
 264
 265    begin
 266       for J in S_Binary_Ops loop
 267          Op_Node := New_Operator (Binary_Ops (J), Bin_Op_Types (J));
 268          SE (J)  := Op_Node;
 269          Append_Entity (Make_Formal (Any_Type, "LEFT"),  Op_Node);
 270          Append_Entity (Make_Formal (Any_Type, "RIGHT"), Op_Node);
 271       end loop;
 272
 273       for J in S_Unary_Ops loop
 274          Op_Node := New_Operator (Unary_Ops (J), Unary_Op_Types (J));
 275          SE (J)  := Op_Node;
 276          Append_Entity (Make_Formal (Any_Type, "RIGHT"), Op_Node);
 277       end loop;
 278
 279       --  For concatenation, we create a separate operator for each
 280       --  array type. This simplifies the resolution of the component-
 281       --  component concatenation operation. In Standard, we set the types
 282       --  of the formals for string, wide [wide]_string, concatenations.
 283
 284       Set_Etype (First_Entity (Standard_Op_Concat),  Standard_String);
 285       Set_Etype (Last_Entity  (Standard_Op_Concat),  Standard_String);
 286
 287       Set_Etype (First_Entity (Standard_Op_Concatw), Standard_Wide_String);
 288       Set_Etype (Last_Entity  (Standard_Op_Concatw), Standard_Wide_String);
 289
 290       Set_Etype (First_Entity (Standard_Op_Concatww),
 291                   Standard_Wide_Wide_String);
 292
 293       Set_Etype (Last_Entity (Standard_Op_Concatww),
 294                    Standard_Wide_Wide_String);
 295
 296    end Create_Operators;
 297
 298    ---------------------
 299    -- Create_Standard --
 300    ---------------------
 301
 302    --  The tree for the package Standard is prefixed to all compilations.
 303    --  Several entities required by semantic analysis are denoted by global
 304    --  variables that are initialized to point to the corresponding
 305    --  occurrences in STANDARD. The visible entities of STANDARD are
 306    --  created here. The private entities defined in STANDARD are created
 307    --  by Initialize_Standard in the semantics module.
 308
 309    procedure Create_Standard is
 310       Decl_S : constant List_Id := New_List;
 311       --  List of declarations in Standard
 312
 313       Decl_A : constant List_Id := New_List;
 314       --  List of declarations in ASCII
 315
 316       Decl       : Node_Id;
 317       Pspec      : Node_Id;
 318       Tdef_Node  : Node_Id;
 319       Ident_Node : Node_Id;
 320       Ccode      : Char_Code;
 321       E_Id       : Entity_Id;
 322       R_Node     : Node_Id;
 323       B_Node     : Node_Id;
 324
 325       procedure Build_Exception (S : Standard_Entity_Type);
 326       --  Procedure to declare given entity as an exception
 327
 328       ---------------------
 329       -- Build_Exception --
 330       ---------------------
 331
 332       procedure Build_Exception (S : Standard_Entity_Type) is
 333       begin
 334          Set_Ekind          (Standard_Entity (S), E_Exception);
 335          Set_Etype          (Standard_Entity (S), Standard_Exception_Type);
 336          Set_Exception_Code (Standard_Entity (S), Uint_0);
 337          Set_Is_Public      (Standard_Entity (S), True);
 338
 339          Decl :=
 340            Make_Exception_Declaration (Stloc,
 341              Defining_Identifier => Standard_Entity (S));
 342          Append (Decl, Decl_S);
 343       end Build_Exception;
 344
 345    --  Start of processing for Create_Standard
 346
 347    begin
 348       --  Initialize scanner for internal scans of literals
 349
 350       Scn.Initialize_Scanner (No_Unit, Internal_Source_File);
 351
 352       --  First step is to create defining identifiers for each entity
 353
 354       for S in Standard_Entity_Type loop
 355          declare
 356             S_Name : constant String := Standard_Entity_Type'Image (S);
 357             --  Name of entity (note we skip S_ at the start)
 358
 359             Ident_Node : Node_Id;
 360             --  Defining identifier node
 361
 362          begin
 363             Ident_Node := New_Standard_Entity;
 364             Make_Name (Ident_Node, S_Name (3 .. S_Name'Length));
 365             Standard_Entity (S) := Ident_Node;
 366          end;
 367       end loop;
 368
 369       --  Create package declaration node for package Standard
 370
 371       Standard_Package_Node := New_Node (N_Package_Declaration, Stloc);
 372
 373       Pspec := New_Node (N_Package_Specification, Stloc);
 374       Set_Specification (Standard_Package_Node, Pspec);
 375
 376       Set_Defining_Unit_Name (Pspec, Standard_Standard);
 377       Set_Visible_Declarations (Pspec, Decl_S);
 378
 379       Set_Ekind (Standard_Standard, E_Package);
 380       Set_Is_Pure (Standard_Standard);
 381       Set_Is_Compilation_Unit (Standard_Standard);
 382
 383       --  Create type declaration nodes for standard types
 384
 385       for S in S_Types loop
 386          Decl := New_Node (N_Full_Type_Declaration, Stloc);
 387          Set_Defining_Identifier (Decl, Standard_Entity (S));
 388          Set_Is_Frozen (Standard_Entity (S));
 389          Set_Is_Public (Standard_Entity (S));
 390          Append (Decl, Decl_S);
 391       end loop;
 392
 393       --  Create type definition node for type Boolean. The Size is set to
 394       --  1 as required by Ada 95 and current ARG interpretations for Ada/83.
 395
 396       --  Note: Object_Size of Boolean is 8. This means that we do NOT in
 397       --  general know that Boolean variables have valid values, so we do
 398       --  not set the Is_Known_Valid flag.
 399
 400       Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
 401       Set_Literals (Tdef_Node, New_List);
 402       Append (Standard_False, Literals (Tdef_Node));
 403       Append (Standard_True, Literals (Tdef_Node));
 404       Set_Type_Definition (Parent (Standard_Boolean), Tdef_Node);
 405
 406       Set_Ekind          (Standard_Boolean, E_Enumeration_Type);
 407       Set_First_Literal  (Standard_Boolean, Standard_False);
 408       Set_Etype          (Standard_Boolean, Standard_Boolean);
 409       Init_Esize         (Standard_Boolean, Standard_Character_Size);
 410       Init_RM_Size       (Standard_Boolean, 1);
 411       Set_Elem_Alignment (Standard_Boolean);
 412
 413       Set_Is_Unsigned_Type           (Standard_Boolean);
 414       Set_Size_Known_At_Compile_Time (Standard_Boolean);
 415
 416       Set_Ekind           (Standard_True, E_Enumeration_Literal);
 417       Set_Etype           (Standard_True, Standard_Boolean);
 418       Set_Enumeration_Pos (Standard_True, Uint_1);
 419       Set_Enumeration_Rep (Standard_True, Uint_1);
 420       Set_Is_Known_Valid  (Standard_True, True);
 421
 422       Set_Ekind           (Standard_False, E_Enumeration_Literal);
 423       Set_Etype           (Standard_False, Standard_Boolean);
 424       Set_Enumeration_Pos (Standard_False, Uint_0);
 425       Set_Enumeration_Rep (Standard_False, Uint_0);
 426       Set_Is_Known_Valid  (Standard_False, True);
 427
 428       --  For the bounds of Boolean, we create a range node corresponding to
 429
 430       --    range False .. True
 431
 432       --  where the occurrences of the literals must point to the
 433       --  corresponding definition.
 434
 435       R_Node := New_Node (N_Range, Stloc);
 436       B_Node := New_Node (N_Identifier, Stloc);
 437       Set_Chars  (B_Node, Chars (Standard_False));
 438       Set_Entity (B_Node,  Standard_False);
 439       Set_Etype  (B_Node, Standard_Boolean);
 440       Set_Is_Static_Expression (B_Node);
 441       Set_Low_Bound  (R_Node, B_Node);
 442
 443       B_Node := New_Node (N_Identifier, Stloc);
 444       Set_Chars  (B_Node, Chars (Standard_True));
 445       Set_Entity (B_Node,  Standard_True);
 446       Set_Etype  (B_Node, Standard_Boolean);
 447       Set_Is_Static_Expression (B_Node);
 448       Set_High_Bound (R_Node, B_Node);
 449
 450       Set_Scalar_Range (Standard_Boolean, R_Node);
 451       Set_Etype (R_Node, Standard_Boolean);
 452       Set_Parent (R_Node, Standard_Boolean);
 453
 454       --  Record entity identifiers for boolean literals in the
 455       --  Boolean_Literals array, for easy reference during expansion.
 456
 457       Boolean_Literals := (False => Standard_False, True => Standard_True);
 458
 459       --  Create type definition nodes for predefined integer types
 460
 461       Build_Signed_Integer_Type
 462         (Standard_Short_Short_Integer, Standard_Short_Short_Integer_Size);
 463
 464       Build_Signed_Integer_Type
 465         (Standard_Short_Integer, Standard_Short_Integer_Size);
 466
 467       Build_Signed_Integer_Type
 468         (Standard_Integer, Standard_Integer_Size);
 469
 470       declare
 471          LIS : Nat;
 472       begin
 473          if Debug_Flag_M then
 474             LIS := 64;
 475          else
 476             LIS := Standard_Long_Integer_Size;
 477          end if;
 478
 479          Build_Signed_Integer_Type (Standard_Long_Integer, LIS);
 480       end;
 481
 482       Build_Signed_Integer_Type
 483         (Standard_Long_Long_Integer, Standard_Long_Long_Integer_Size);
 484
 485       Create_Unconstrained_Base_Type
 486         (Standard_Short_Short_Integer, E_Signed_Integer_Subtype);
 487
 488       Create_Unconstrained_Base_Type
 489         (Standard_Short_Integer, E_Signed_Integer_Subtype);
 490
 491       Create_Unconstrained_Base_Type
 492         (Standard_Integer, E_Signed_Integer_Subtype);
 493
 494       Create_Unconstrained_Base_Type
 495         (Standard_Long_Integer, E_Signed_Integer_Subtype);
 496
 497       Create_Unconstrained_Base_Type
 498         (Standard_Long_Long_Integer, E_Signed_Integer_Subtype);
 499
 500       --  Create type definition nodes for predefined float types
 501
 502       Build_Float_Type
 503         (Standard_Short_Float,
 504          Standard_Short_Float_Size,
 505          Standard_Short_Float_Digits);
 506
 507       Build_Float_Type
 508         (Standard_Float,
 509          Standard_Float_Size,
 510          Standard_Float_Digits);
 511
 512       Build_Float_Type
 513         (Standard_Long_Float,
 514          Standard_Long_Float_Size,
 515          Standard_Long_Float_Digits);
 516
 517       Build_Float_Type
 518         (Standard_Long_Long_Float,
 519          Standard_Long_Long_Float_Size,
 520          Standard_Long_Long_Float_Digits);
 521
 522       --  Create type definition node for type Character. Note that we do not
 523       --  set the Literals field, since type Character is handled with special
 524       --  routine that do not need a literal list.
 525
 526       Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
 527       Set_Type_Definition (Parent (Standard_Character), Tdef_Node);
 528
 529       Set_Ekind          (Standard_Character, E_Enumeration_Type);
 530       Set_Etype          (Standard_Character, Standard_Character);
 531       Init_Esize         (Standard_Character, Standard_Character_Size);
 532       Init_RM_Size       (Standard_Character, 8);
 533       Set_Elem_Alignment (Standard_Character);
 534
 535       Set_Is_Unsigned_Type           (Standard_Character);
 536       Set_Is_Character_Type          (Standard_Character);
 537       Set_Is_Known_Valid             (Standard_Character);
 538       Set_Size_Known_At_Compile_Time (Standard_Character);
 539
 540       --  Create the bounds for type Character
 541
 542       R_Node := New_Node (N_Range, Stloc);
 543
 544       --  Low bound for type Character (Standard.Nul)
 545
 546       B_Node := New_Node (N_Character_Literal, Stloc);
 547       Set_Is_Static_Expression (B_Node);
 548       Set_Chars                (B_Node, No_Name);
 549       Set_Char_Literal_Value   (B_Node, Uint_0);
 550       Set_Entity               (B_Node, Empty);
 551       Set_Etype                (B_Node, Standard_Character);
 552       Set_Low_Bound (R_Node, B_Node);
 553
 554       --  High bound for type Character
 555
 556       B_Node := New_Node (N_Character_Literal, Stloc);
 557       Set_Is_Static_Expression (B_Node);
 558       Set_Chars                (B_Node, No_Name);
 559       Set_Char_Literal_Value   (B_Node, UI_From_Int (16#FF#));
 560       Set_Entity               (B_Node, Empty);
 561       Set_Etype                (B_Node, Standard_Character);
 562       Set_High_Bound (R_Node, B_Node);
 563
 564       Set_Scalar_Range (Standard_Character, R_Node);
 565       Set_Etype (R_Node, Standard_Character);
 566       Set_Parent (R_Node, Standard_Character);
 567
 568       --  Create type definition for type Wide_Character. Note that we do not
 569       --  set the Literals field, since type Wide_Character is handled with
 570       --  special routines that do not need a literal list.
 571
 572       Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
 573       Set_Type_Definition (Parent (Standard_Wide_Character), Tdef_Node);
 574
 575       Set_Ekind      (Standard_Wide_Character, E_Enumeration_Type);
 576       Set_Etype      (Standard_Wide_Character, Standard_Wide_Character);
 577       Init_Size      (Standard_Wide_Character, Standard_Wide_Character_Size);
 578
 579       Set_Elem_Alignment             (Standard_Wide_Character);
 580       Set_Is_Unsigned_Type           (Standard_Wide_Character);
 581       Set_Is_Character_Type          (Standard_Wide_Character);
 582       Set_Is_Known_Valid             (Standard_Wide_Character);
 583       Set_Size_Known_At_Compile_Time (Standard_Wide_Character);
 584
 585       --  Create the bounds for type Wide_Character
 586
 587       R_Node := New_Node (N_Range, Stloc);
 588
 589       --  Low bound for type Wide_Character
 590
 591       B_Node := New_Node (N_Character_Literal, Stloc);
 592       Set_Is_Static_Expression (B_Node);
 593       Set_Chars                (B_Node, No_Name);    --  ???
 594       Set_Char_Literal_Value   (B_Node, Uint_0);
 595       Set_Entity               (B_Node, Empty);
 596       Set_Etype                (B_Node, Standard_Wide_Character);
 597       Set_Low_Bound (R_Node, B_Node);
 598
 599       --  High bound for type Wide_Character
 600
 601       B_Node := New_Node (N_Character_Literal, Stloc);
 602       Set_Is_Static_Expression (B_Node);
 603       Set_Chars                (B_Node, No_Name);    --  ???
 604       Set_Char_Literal_Value   (B_Node, UI_From_Int (16#FFFF#));
 605       Set_Entity               (B_Node, Empty);
 606       Set_Etype                (B_Node, Standard_Wide_Character);
 607       Set_High_Bound           (R_Node, B_Node);
 608
 609       Set_Scalar_Range (Standard_Wide_Character, R_Node);
 610       Set_Etype (R_Node, Standard_Wide_Character);
 611       Set_Parent (R_Node, Standard_Wide_Character);
 612
 613       --  Create type definition for type Wide_Wide_Character. Note that we
 614       --  do not set the Literals field, since type Wide_Wide_Character is
 615       --  handled with special routines that do not need a literal list.
 616
 617       Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
 618       Set_Type_Definition (Parent (Standard_Wide_Wide_Character), Tdef_Node);
 619
 620       Set_Ekind (Standard_Wide_Wide_Character, E_Enumeration_Type);
 621       Set_Etype (Standard_Wide_Wide_Character,
 622                  Standard_Wide_Wide_Character);
 623       Init_Size (Standard_Wide_Wide_Character,
 624                  Standard_Wide_Wide_Character_Size);
 625
 626       Set_Elem_Alignment             (Standard_Wide_Wide_Character);
 627       Set_Is_Unsigned_Type           (Standard_Wide_Wide_Character);
 628       Set_Is_Character_Type          (Standard_Wide_Wide_Character);
 629       Set_Is_Known_Valid             (Standard_Wide_Wide_Character);
 630       Set_Size_Known_At_Compile_Time (Standard_Wide_Wide_Character);
 631       Set_Is_Ada_2005_Only           (Standard_Wide_Wide_Character);
 632
 633       --  Create the bounds for type Wide_Wide_Character
 634
 635       R_Node := New_Node (N_Range, Stloc);
 636
 637       --  Low bound for type Wide_Wide_Character
 638
 639       B_Node := New_Node (N_Character_Literal, Stloc);
 640       Set_Is_Static_Expression (B_Node);
 641       Set_Chars                (B_Node, No_Name);    --  ???
 642       Set_Char_Literal_Value   (B_Node, Uint_0);
 643       Set_Entity               (B_Node, Empty);
 644       Set_Etype                (B_Node, Standard_Wide_Wide_Character);
 645       Set_Low_Bound (R_Node, B_Node);
 646
 647       --  High bound for type Wide_Wide_Character
 648
 649       B_Node := New_Node (N_Character_Literal, Stloc);
 650       Set_Is_Static_Expression (B_Node);
 651       Set_Chars                (B_Node, No_Name);    --  ???
 652       Set_Char_Literal_Value   (B_Node, UI_From_Int (16#7FFF_FFFF#));
 653       Set_Entity               (B_Node, Empty);
 654       Set_Etype                (B_Node, Standard_Wide_Wide_Character);
 655       Set_High_Bound           (R_Node, B_Node);
 656
 657       Set_Scalar_Range (Standard_Wide_Wide_Character, R_Node);
 658       Set_Etype (R_Node, Standard_Wide_Wide_Character);
 659       Set_Parent (R_Node, Standard_Wide_Wide_Character);
 660
 661       --  Create type definition node for type String
 662
 663       Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
 664
 665       declare
 666          CompDef_Node : Node_Id;
 667       begin
 668          CompDef_Node := New_Node (N_Component_Definition, Stloc);
 669          Set_Aliased_Present      (CompDef_Node, False);
 670          Set_Access_Definition    (CompDef_Node, Empty);
 671          Set_Subtype_Indication   (CompDef_Node, Identifier_For (S_Character));
 672          Set_Component_Definition (Tdef_Node, CompDef_Node);
 673       end;
 674
 675       Set_Subtype_Marks      (Tdef_Node, New_List);
 676       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
 677       Set_Type_Definition (Parent (Standard_String), Tdef_Node);
 678
 679       Set_Ekind          (Standard_String, E_String_Type);
 680       Set_Etype          (Standard_String, Standard_String);
 681       Set_Component_Type (Standard_String, Standard_Character);
 682       Set_Component_Size (Standard_String, Uint_8);
 683       Init_Size_Align    (Standard_String);
 684       Set_Alignment      (Standard_String, Uint_1);
 685
 686       --  On targets where a storage unit is larger than a byte (such as AAMP),
 687       --  pragma Pack has a real effect on the representation of type String,
 688       --  and the type must be marked as having a nonstandard representation.
 689
 690       if System_Storage_Unit > Uint_8 then
 691          Set_Has_Non_Standard_Rep (Standard_String);
 692          Set_Has_Pragma_Pack      (Standard_String);
 693       end if;
 694
 695       --  Set index type of String
 696
 697       E_Id := First
 698         (Subtype_Marks (Type_Definition (Parent (Standard_String))));
 699       Set_First_Index (Standard_String, E_Id);
 700       Set_Entity (E_Id, Standard_Positive);
 701       Set_Etype (E_Id, Standard_Positive);
 702
 703       --  Create type definition node for type Wide_String
 704
 705       Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
 706
 707       declare
 708          CompDef_Node : Node_Id;
 709       begin
 710          CompDef_Node := New_Node (N_Component_Definition, Stloc);
 711          Set_Aliased_Present    (CompDef_Node, False);
 712          Set_Access_Definition  (CompDef_Node, Empty);
 713          Set_Subtype_Indication (CompDef_Node,
 714                                  Identifier_For (S_Wide_Character));
 715          Set_Component_Definition (Tdef_Node, CompDef_Node);
 716       end;
 717
 718       Set_Subtype_Marks (Tdef_Node, New_List);
 719       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
 720       Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);
 721
 722       Set_Ekind          (Standard_Wide_String, E_String_Type);
 723       Set_Etype          (Standard_Wide_String, Standard_Wide_String);
 724       Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
 725       Set_Component_Size (Standard_Wide_String, Uint_16);
 726       Init_Size_Align    (Standard_Wide_String);
 727
 728       --  Set index type of Wide_String
 729
 730       E_Id := First
 731         (Subtype_Marks (Type_Definition (Parent (Standard_Wide_String))));
 732       Set_First_Index (Standard_Wide_String, E_Id);
 733       Set_Entity (E_Id, Standard_Positive);
 734       Set_Etype (E_Id, Standard_Positive);
 735
 736       --  Create type definition node for type Wide_Wide_String
 737
 738       Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
 739
 740       declare
 741          CompDef_Node : Node_Id;
 742       begin
 743          CompDef_Node := New_Node (N_Component_Definition, Stloc);
 744          Set_Aliased_Present    (CompDef_Node, False);
 745          Set_Access_Definition  (CompDef_Node, Empty);
 746          Set_Subtype_Indication (CompDef_Node,
 747                                  Identifier_For (S_Wide_Wide_Character));
 748          Set_Component_Definition (Tdef_Node, CompDef_Node);
 749       end;
 750
 751       Set_Subtype_Marks (Tdef_Node, New_List);
 752       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
 753       Set_Type_Definition (Parent (Standard_Wide_Wide_String), Tdef_Node);
 754
 755       Set_Ekind            (Standard_Wide_Wide_String, E_String_Type);
 756       Set_Etype            (Standard_Wide_Wide_String,
 757                             Standard_Wide_Wide_String);
 758       Set_Component_Type   (Standard_Wide_Wide_String,
 759                             Standard_Wide_Wide_Character);
 760       Set_Component_Size   (Standard_Wide_Wide_String, Uint_32);
 761       Init_Size_Align      (Standard_Wide_Wide_String);
 762       Set_Is_Ada_2005_Only (Standard_Wide_Wide_String);
 763
 764       --  Set index type of Wide_Wide_String
 765
 766       E_Id := First
 767         (Subtype_Marks (Type_Definition (Parent (Standard_Wide_Wide_String))));
 768       Set_First_Index (Standard_Wide_Wide_String, E_Id);
 769       Set_Entity (E_Id, Standard_Positive);
 770       Set_Etype (E_Id, Standard_Positive);
 771
 772       --  Create subtype declaration for Natural
 773
 774       Decl := New_Node (N_Subtype_Declaration, Stloc);
 775       Set_Defining_Identifier (Decl, Standard_Natural);
 776       Set_Subtype_Indication (Decl,
 777         New_Occurrence_Of (Standard_Integer, Stloc));
 778       Append (Decl, Decl_S);
 779
 780       Set_Ekind          (Standard_Natural, E_Signed_Integer_Subtype);
 781       Set_Etype          (Standard_Natural, Base_Type (Standard_Integer));
 782       Init_Esize         (Standard_Natural, Standard_Integer_Size);
 783       Init_RM_Size       (Standard_Natural, Standard_Integer_Size - 1);
 784       Set_Elem_Alignment (Standard_Natural);
 785       Set_Size_Known_At_Compile_Time
 786                          (Standard_Natural);
 787       Set_Integer_Bounds (Standard_Natural,
 788         Typ => Base_Type (Standard_Integer),
 789         Lb  => Uint_0,
 790         Hb  => Intval (High_Bound (Scalar_Range (Standard_Integer))));
 791       Set_Is_Constrained (Standard_Natural);
 792       Set_Is_Frozen      (Standard_Natural);
 793       Set_Is_Public      (Standard_Natural);
 794
 795       --  Create subtype declaration for Positive
 796
 797       Decl := New_Node (N_Subtype_Declaration, Stloc);
 798       Set_Defining_Identifier (Decl, Standard_Positive);
 799       Set_Subtype_Indication (Decl,
 800         New_Occurrence_Of (Standard_Integer, Stloc));
 801       Append (Decl, Decl_S);
 802
 803       Set_Ekind          (Standard_Positive, E_Signed_Integer_Subtype);
 804       Set_Etype          (Standard_Positive, Base_Type (Standard_Integer));
 805       Init_Esize         (Standard_Positive, Standard_Integer_Size);
 806       Init_RM_Size       (Standard_Positive, Standard_Integer_Size - 1);
 807       Set_Elem_Alignment (Standard_Positive);
 808
 809       Set_Size_Known_At_Compile_Time (Standard_Positive);
 810
 811       Set_Integer_Bounds   (Standard_Positive,
 812          Typ => Base_Type (Standard_Integer),
 813          Lb  => Uint_1,
 814          Hb  => Intval (High_Bound (Scalar_Range (Standard_Integer))));
 815       Set_Is_Constrained   (Standard_Positive);
 816       Set_Is_Frozen        (Standard_Positive);
 817       Set_Is_Public        (Standard_Positive);
 818
 819       --  Create declaration for package ASCII
 820
 821       Decl := New_Node (N_Package_Declaration, Stloc);
 822       Append (Decl, Decl_S);
 823
 824       Pspec := New_Node (N_Package_Specification, Stloc);
 825       Set_Specification (Decl, Pspec);
 826
 827       Set_Defining_Unit_Name (Pspec, Standard_Entity (S_ASCII));
 828       Set_Ekind (Standard_Entity (S_ASCII), E_Package);
 829       Set_Visible_Declarations (Pspec, Decl_A);
 830
 831       --  Create control character definitions in package ASCII. Note that
 832       --  the character literal entries created here correspond to literal
 833       --  values that are impossible in the source, but can be represented
 834       --  internally with no difficulties.
 835
 836       Ccode := 16#00#;
 837
 838       for S in S_ASCII_Names loop
 839          Decl := New_Node (N_Object_Declaration, Staloc);
 840          Set_Constant_Present (Decl, True);
 841
 842          declare
 843             A_Char    : constant Entity_Id := Standard_Entity (S);
 844             Expr_Decl : Node_Id;
 845
 846          begin
 847             Set_Sloc                   (A_Char, Staloc);
 848             Set_Ekind                  (A_Char, E_Constant);
 849             Set_Never_Set_In_Source    (A_Char, True);
 850             Set_Is_True_Constant       (A_Char, True);
 851             Set_Etype                  (A_Char, Standard_Character);
 852             Set_Scope                  (A_Char, Standard_Entity (S_ASCII));
 853             Set_Is_Immediately_Visible (A_Char, False);
 854             Set_Is_Public              (A_Char, True);
 855             Set_Is_Known_Valid         (A_Char, True);
 856
 857             Append_Entity (A_Char, Standard_Entity (S_ASCII));
 858             Set_Defining_Identifier (Decl, A_Char);
 859
 860             Set_Object_Definition (Decl, Identifier_For (S_Character));
 861             Expr_Decl := New_Node (N_Character_Literal, Staloc);
 862             Set_Expression (Decl, Expr_Decl);
 863
 864             Set_Is_Static_Expression (Expr_Decl);
 865             Set_Chars                (Expr_Decl, No_Name);
 866             Set_Etype                (Expr_Decl, Standard_Character);
 867             Set_Char_Literal_Value   (Expr_Decl, UI_From_Int (Int (Ccode)));
 868          end;
 869
 870          Append (Decl, Decl_A);
 871
 872          --  Increment character code, dealing with non-contiguities
 873
 874          Ccode := Ccode + 1;
 875
 876          if Ccode = 16#20# then
 877             Ccode := 16#21#;
 878          elsif Ccode = 16#27# then
 879             Ccode := 16#3A#;
 880          elsif Ccode = 16#3C# then
 881             Ccode := 16#3F#;
 882          elsif Ccode = 16#41# then
 883             Ccode := 16#5B#;
 884          end if;
 885       end loop;
 886
 887       --  Create semantic phase entities
 888
 889       Standard_Void_Type := New_Standard_Entity;
 890       Set_Ekind       (Standard_Void_Type, E_Void);
 891       Set_Etype       (Standard_Void_Type, Standard_Void_Type);
 892       Set_Scope       (Standard_Void_Type, Standard_Standard);
 893       Make_Name       (Standard_Void_Type, "_void_type");
 894
 895       --  The type field of packages is set to void
 896
 897       Set_Etype (Standard_Standard, Standard_Void_Type);
 898       Set_Etype (Standard_ASCII, Standard_Void_Type);
 899
 900       --  Standard_A_String is actually used in generated code, so it has a
 901       --  type name that is reasonable, but does not overlap any Ada name.
 902
 903       Standard_A_String := New_Standard_Entity;
 904       Set_Ekind      (Standard_A_String, E_Access_Type);
 905       Set_Scope      (Standard_A_String, Standard_Standard);
 906       Set_Etype      (Standard_A_String, Standard_A_String);
 907
 908       if Debug_Flag_6 then
 909          Init_Size   (Standard_A_String, System_Address_Size);
 910       else
 911          Init_Size   (Standard_A_String, System_Address_Size * 2);
 912       end if;
 913
 914       Init_Alignment (Standard_A_String);
 915
 916       Set_Directly_Designated_Type
 917                      (Standard_A_String, Standard_String);
 918       Make_Name      (Standard_A_String, "access_string");
 919
 920       Standard_A_Char := New_Standard_Entity;
 921       Set_Ekind          (Standard_A_Char, E_Access_Type);
 922       Set_Scope          (Standard_A_Char, Standard_Standard);
 923       Set_Etype          (Standard_A_Char, Standard_A_String);
 924       Init_Size          (Standard_A_Char, System_Address_Size);
 925       Set_Elem_Alignment (Standard_A_Char);
 926
 927       Set_Directly_Designated_Type (Standard_A_Char, Standard_Character);
 928       Make_Name     (Standard_A_Char, "access_character");
 929
 930       --  Standard_Debug_Renaming_Type is used for the special objects created
 931       --  to encode the names occurring in renaming declarations for use by the
 932       --  debugger (see exp_dbug.adb). The type is a zero-sized subtype of
 933       --  Standard.Integer.
 934
 935       Standard_Debug_Renaming_Type := New_Standard_Entity;
 936
 937       Set_Ekind (Standard_Debug_Renaming_Type, E_Signed_Integer_Subtype);
 938       Set_Scope (Standard_Debug_Renaming_Type, Standard_Standard);
 939       Set_Etype (Standard_Debug_Renaming_Type, Base_Type (Standard_Integer));
 940       Init_Esize         (Standard_Debug_Renaming_Type, 0);
 941       Init_RM_Size       (Standard_Debug_Renaming_Type, 0);
 942       Set_Size_Known_At_Compile_Time (Standard_Debug_Renaming_Type);
 943       Set_Integer_Bounds (Standard_Debug_Renaming_Type,
 944         Typ => Base_Type (Standard_Debug_Renaming_Type),
 945         Lb  => Uint_1,
 946         Hb  => Uint_0);
 947       Set_Is_Constrained (Standard_Debug_Renaming_Type);
 948       Set_Has_Size_Clause (Standard_Debug_Renaming_Type);
 949
 950       Make_Name      (Standard_Debug_Renaming_Type, "_renaming_type");
 951
 952       --  Note on type names. The type names for the following special types
 953       --  are constructed so that they will look reasonable should they ever
 954       --  appear in error messages etc, although in practice the use of the
 955       --  special insertion character } for types results in special handling
 956       --  of these type names in any case. The blanks in these names would
 957       --  trouble in Gigi, but that's OK here, since none of these types
 958       --  should ever get through to Gigi! Attributes of these types are
 959       --  filled out to minimize problems with cascaded errors (for example,
 960       --  Any_Integer is given reasonable and consistent type and size values)
 961
 962       Any_Type := New_Standard_Entity;
 963       Decl := New_Node (N_Full_Type_Declaration, Stloc);
 964       Set_Defining_Identifier (Decl, Any_Type);
 965       Set_Scope (Any_Type, Standard_Standard);
 966       Build_Signed_Integer_Type (Any_Type, Standard_Integer_Size);
 967       Make_Name (Any_Type, "any type");
 968
 969       Any_Id := New_Standard_Entity;
 970       Set_Ekind             (Any_Id, E_Variable);
 971       Set_Scope             (Any_Id, Standard_Standard);
 972       Set_Etype             (Any_Id, Any_Type);
 973       Init_Esize            (Any_Id);
 974       Init_Alignment        (Any_Id);
 975       Make_Name             (Any_Id, "any id");
 976
 977       Any_Access := New_Standard_Entity;
 978       Set_Ekind             (Any_Access, E_Access_Type);
 979       Set_Scope             (Any_Access, Standard_Standard);
 980       Set_Etype             (Any_Access, Any_Access);
 981       Init_Size             (Any_Access, System_Address_Size);
 982       Set_Elem_Alignment    (Any_Access);
 983       Make_Name             (Any_Access, "an access type");
 984
 985       Any_Character := New_Standard_Entity;
 986       Set_Ekind             (Any_Character, E_Enumeration_Type);
 987       Set_Scope             (Any_Character, Standard_Standard);
 988       Set_Etype             (Any_Character, Any_Character);
 989       Set_Is_Unsigned_Type  (Any_Character);
 990       Set_Is_Character_Type (Any_Character);
 991       Init_Esize            (Any_Character, Standard_Character_Size);
 992       Init_RM_Size          (Any_Character, 8);
 993       Set_Elem_Alignment    (Any_Character);
 994       Set_Scalar_Range      (Any_Character, Scalar_Range (Standard_Character));
 995       Make_Name             (Any_Character, "a character type");
 996
 997       Any_Array := New_Standard_Entity;
 998       Set_Ekind             (Any_Array, E_String_Type);
 999       Set_Scope             (Any_Array, Standard_Standard);
1000       Set_Etype             (Any_Array, Any_Array);
1001       Set_Component_Type    (Any_Array, Any_Character);
1002       Init_Size_Align       (Any_Array);
1003       Make_Name             (Any_Array, "an array type");
1004
1005       Any_Boolean := New_Standard_Entity;
1006       Set_Ekind             (Any_Boolean, E_Enumeration_Type);
1007       Set_Scope             (Any_Boolean, Standard_Standard);
1008       Set_Etype             (Any_Boolean, Standard_Boolean);
1009       Init_Esize            (Any_Boolean, Standard_Character_Size);
1010       Init_RM_Size          (Any_Boolean, 1);
1011       Set_Elem_Alignment    (Any_Boolean);
1012       Set_Is_Unsigned_Type  (Any_Boolean);
1013       Set_Scalar_Range      (Any_Boolean, Scalar_Range (Standard_Boolean));
1014       Make_Name             (Any_Boolean, "a boolean type");
1015
1016       Any_Composite := New_Standard_Entity;
1017       Set_Ekind             (Any_Composite, E_Array_Type);
1018       Set_Scope             (Any_Composite, Standard_Standard);
1019       Set_Etype             (Any_Composite, Any_Composite);
1020       Set_Component_Size    (Any_Composite, Uint_0);
1021       Set_Component_Type    (Any_Composite, Standard_Integer);
1022       Init_Size_Align       (Any_Composite);
1023       Make_Name             (Any_Composite, "a composite type");
1024
1025       Any_Discrete := New_Standard_Entity;
1026       Set_Ekind             (Any_Discrete, E_Signed_Integer_Type);
1027       Set_Scope             (Any_Discrete, Standard_Standard);
1028       Set_Etype             (Any_Discrete, Any_Discrete);
1029       Init_Size             (Any_Discrete, Standard_Integer_Size);
1030       Set_Elem_Alignment    (Any_Discrete);
1031       Make_Name             (Any_Discrete, "a discrete type");
1032
1033       Any_Fixed := New_Standard_Entity;
1034       Set_Ekind             (Any_Fixed, E_Ordinary_Fixed_Point_Type);
1035       Set_Scope             (Any_Fixed, Standard_Standard);
1036       Set_Etype             (Any_Fixed, Any_Fixed);
1037       Init_Size             (Any_Fixed, Standard_Integer_Size);
1038       Set_Elem_Alignment    (Any_Fixed);
1039       Make_Name             (Any_Fixed, "a fixed-point type");
1040
1041       Any_Integer := New_Standard_Entity;
1042       Set_Ekind             (Any_Integer, E_Signed_Integer_Type);
1043       Set_Scope             (Any_Integer, Standard_Standard);
1044       Set_Etype             (Any_Integer, Standard_Long_Long_Integer);
1045       Init_Size             (Any_Integer, Standard_Long_Long_Integer_Size);
1046       Set_Elem_Alignment    (Any_Integer);
1047
1048       Set_Integer_Bounds
1049         (Any_Integer,
1050          Typ => Base_Type (Standard_Integer),
1051          Lb  => Uint_0,
1052          Hb  => Intval (High_Bound (Scalar_Range (Standard_Integer))));
1053       Make_Name (Any_Integer, "an integer type");
1054
1055       Any_Modular := New_Standard_Entity;
1056       Set_Ekind             (Any_Modular, E_Modular_Integer_Type);
1057       Set_Scope             (Any_Modular, Standard_Standard);
1058       Set_Etype             (Any_Modular, Standard_Long_Long_Integer);
1059       Init_Size             (Any_Modular, Standard_Long_Long_Integer_Size);
1060       Set_Elem_Alignment    (Any_Modular);
1061       Set_Is_Unsigned_Type  (Any_Modular);
1062       Make_Name             (Any_Modular, "a modular type");
1063
1064       Any_Numeric := New_Standard_Entity;
1065       Set_Ekind             (Any_Numeric, E_Signed_Integer_Type);
1066       Set_Scope             (Any_Numeric, Standard_Standard);
1067       Set_Etype             (Any_Numeric, Standard_Long_Long_Integer);
1068       Init_Size             (Any_Numeric, Standard_Long_Long_Integer_Size);
1069       Set_Elem_Alignment    (Any_Numeric);
1070       Make_Name             (Any_Numeric, "a numeric type");
1071
1072       Any_Real := New_Standard_Entity;
1073       Set_Ekind             (Any_Real, E_Floating_Point_Type);
1074       Set_Scope             (Any_Real, Standard_Standard);
1075       Set_Etype             (Any_Real, Standard_Long_Long_Float);
1076       Init_Size             (Any_Real, Standard_Long_Long_Float_Size);
1077       Set_Elem_Alignment    (Any_Real);
1078       Make_Name             (Any_Real, "a real type");
1079
1080       Any_Scalar := New_Standard_Entity;
1081       Set_Ekind             (Any_Scalar, E_Signed_Integer_Type);
1082       Set_Scope             (Any_Scalar, Standard_Standard);
1083       Set_Etype             (Any_Scalar, Any_Scalar);
1084       Init_Size             (Any_Scalar, Standard_Integer_Size);
1085       Set_Elem_Alignment    (Any_Scalar);
1086       Make_Name             (Any_Scalar, "a scalar type");
1087
1088       Any_String := New_Standard_Entity;
1089       Set_Ekind             (Any_String, E_String_Type);
1090       Set_Scope             (Any_String, Standard_Standard);
1091       Set_Etype             (Any_String, Any_String);
1092       Set_Component_Type    (Any_String, Any_Character);
1093       Init_Size_Align       (Any_String);
1094       Make_Name             (Any_String, "a string type");
1095
1096       declare
1097          Index   : Node_Id;
1098
1099       begin
1100          Index :=
1101            Make_Range (Stloc,
1102              Low_Bound  => Make_Integer (Uint_0),
1103              High_Bound => Make_Integer (Uint_2 ** Standard_Integer_Size));
1104          Set_Etype (Index, Standard_Integer);
1105          Set_First_Index (Any_String, Index);
1106       end;
1107
1108       Standard_Integer_8 := New_Standard_Entity;
1109       Decl := New_Node (N_Full_Type_Declaration, Stloc);
1110       Set_Defining_Identifier (Decl, Standard_Integer_8);
1111       Make_Name (Standard_Integer_8, "integer_8");
1112       Set_Scope (Standard_Integer_8, Standard_Standard);
1113       Build_Signed_Integer_Type (Standard_Integer_8, 8);
1114
1115       Standard_Integer_16 := New_Standard_Entity;
1116       Decl := New_Node (N_Full_Type_Declaration, Stloc);
1117       Set_Defining_Identifier (Decl, Standard_Integer_16);
1118       Make_Name (Standard_Integer_16, "integer_16");
1119       Set_Scope (Standard_Integer_16, Standard_Standard);
1120       Build_Signed_Integer_Type (Standard_Integer_16, 16);
1121
1122       Standard_Integer_32 := New_Standard_Entity;
1123       Decl := New_Node (N_Full_Type_Declaration, Stloc);
1124       Set_Defining_Identifier (Decl, Standard_Integer_32);
1125       Make_Name (Standard_Integer_32, "integer_32");
1126       Set_Scope (Standard_Integer_32, Standard_Standard);
1127       Build_Signed_Integer_Type (Standard_Integer_32, 32);
1128
1129       Standard_Integer_64 := New_Standard_Entity;
1130       Decl := New_Node (N_Full_Type_Declaration, Stloc);
1131       Set_Defining_Identifier (Decl, Standard_Integer_64);
1132       Make_Name (Standard_Integer_64, "integer_64");
1133       Set_Scope (Standard_Integer_64, Standard_Standard);
1134       Build_Signed_Integer_Type (Standard_Integer_64, 64);
1135
1136       Standard_Unsigned := New_Standard_Entity;
1137       Decl := New_Node (N_Full_Type_Declaration, Stloc);
1138       Set_Defining_Identifier (Decl, Standard_Unsigned);
1139       Make_Name (Standard_Unsigned, "unsigned");
1140
1141       Set_Ekind             (Standard_Unsigned, E_Modular_Integer_Type);
1142       Set_Scope             (Standard_Unsigned, Standard_Standard);
1143       Set_Etype             (Standard_Unsigned, Standard_Unsigned);
1144       Init_Size             (Standard_Unsigned, Standard_Integer_Size);
1145       Set_Elem_Alignment    (Standard_Unsigned);
1146       Set_Modulus           (Standard_Unsigned,
1147                               Uint_2 ** Standard_Integer_Size);
1148       Set_Is_Unsigned_Type  (Standard_Unsigned);
1149       Set_Size_Known_At_Compile_Time
1150                             (Standard_Unsigned);
1151
1152       R_Node := New_Node (N_Range, Stloc);
1153       Set_Low_Bound  (R_Node, Make_Integer (Uint_0));
1154       Set_High_Bound (R_Node, Make_Integer (Modulus (Standard_Unsigned) - 1));
1155       Set_Etype (Low_Bound (R_Node), Standard_Unsigned);
1156       Set_Etype (High_Bound (R_Node), Standard_Unsigned);
1157       Set_Scalar_Range (Standard_Unsigned, R_Node);
1158
1159       --  Note: universal integer and universal real are constructed as fully
1160       --  formed signed numeric types, with parameters corresponding to the
1161       --  longest runtime types (Long_Long_Integer and Long_Long_Float). This
1162       --  allows Gigi to properly process references to universal types that
1163       --  are not folded at compile time.
1164
1165       Universal_Integer := New_Standard_Entity;
1166       Decl := New_Node (N_Full_Type_Declaration, Stloc);
1167       Set_Defining_Identifier (Decl, Universal_Integer);
1168       Make_Name (Universal_Integer, "universal_integer");
1169       Set_Scope (Universal_Integer, Standard_Standard);
1170       Build_Signed_Integer_Type
1171         (Universal_Integer, Standard_Long_Long_Integer_Size);
1172
1173       Universal_Real := New_Standard_Entity;
1174       Decl := New_Node (N_Full_Type_Declaration, Stloc);
1175       Set_Defining_Identifier (Decl, Universal_Real);
1176       Make_Name (Universal_Real, "universal_real");
1177       Set_Scope (Universal_Real, Standard_Standard);
1178       Build_Float_Type
1179         (Universal_Real,
1180          Standard_Long_Long_Float_Size,
1181          Standard_Long_Long_Float_Digits);
1182
1183       --  Note: universal fixed, unlike universal integer and universal real,
1184       --  is never used at runtime, so it does not need to have bounds set.
1185
1186       Universal_Fixed := New_Standard_Entity;
1187       Decl := New_Node (N_Full_Type_Declaration, Stloc);
1188       Set_Defining_Identifier (Decl, Universal_Fixed);
1189       Make_Name            (Universal_Fixed, "universal_fixed");
1190       Set_Ekind            (Universal_Fixed, E_Ordinary_Fixed_Point_Type);
1191       Set_Etype            (Universal_Fixed, Universal_Fixed);
1192       Set_Scope            (Universal_Fixed, Standard_Standard);
1193       Init_Size            (Universal_Fixed, Standard_Long_Long_Integer_Size);
1194       Set_Elem_Alignment   (Universal_Fixed);
1195       Set_Size_Known_At_Compile_Time
1196                            (Universal_Fixed);
1197
1198       --  Create type declaration for Duration, using a 64-bit size. The
1199       --  delta and size values depend on the mode set in system.ads.
1200
1201       Build_Duration : declare
1202          Dlo       : Uint;
1203          Dhi       : Uint;
1204          Delta_Val : Ureal;
1205
1206       begin
1207          --  In 32 bit mode, the size is 32 bits, and the delta and
1208          --  small values are set to 20 milliseconds (20.0**(10.0**(-3)).
1209
1210          if Duration_32_Bits_On_Target then
1211             Dlo := Intval (Type_Low_Bound (Standard_Integer_32));
1212             Dhi := Intval (Type_High_Bound (Standard_Integer_32));
1213             Delta_Val := UR_From_Components (UI_From_Int (20), Uint_3, 10);
1214
1215          --  In standard 64-bit mode, the size is 64-bits and the delta and
1216          --  small values are set to nanoseconds (1.0**(10.0**(-9))
1217
1218          else
1219             Dlo := Intval (Type_Low_Bound (Standard_Integer_64));
1220             Dhi := Intval (Type_High_Bound (Standard_Integer_64));
1221             Delta_Val := UR_From_Components (Uint_1, Uint_9, 10);
1222          end if;
1223
1224          Tdef_Node := Make_Ordinary_Fixed_Point_Definition (Stloc,
1225                  Delta_Expression => Make_Real_Literal (Stloc, Delta_Val),
1226                  Real_Range_Specification =>
1227                    Make_Real_Range_Specification (Stloc,
1228                      Low_Bound  => Make_Real_Literal (Stloc,
1229                        Realval => Dlo * Delta_Val),
1230                      High_Bound => Make_Real_Literal (Stloc,
1231                        Realval => Dhi * Delta_Val)));
1232
1233          Set_Type_Definition (Parent (Standard_Duration), Tdef_Node);
1234
1235          Set_Ekind (Standard_Duration, E_Ordinary_Fixed_Point_Type);
1236          Set_Etype (Standard_Duration, Standard_Duration);
1237
1238          if Duration_32_Bits_On_Target then
1239             Init_Size (Standard_Duration, 32);
1240          else
1241             Init_Size (Standard_Duration, 64);
1242          end if;
1243
1244          Set_Elem_Alignment (Standard_Duration);
1245          Set_Delta_Value    (Standard_Duration, Delta_Val);
1246          Set_Small_Value    (Standard_Duration, Delta_Val);
1247          Set_Scalar_Range   (Standard_Duration,
1248                               Real_Range_Specification
1249                                (Type_Definition (Parent (Standard_Duration))));
1250
1251          --  Normally it does not matter that nodes in package Standard are
1252          --  not marked as analyzed. The Scalar_Range of the fixed-point
1253          --  type Standard_Duration is an exception, because of the special
1254          --  test made in Freeze.Freeze_Fixed_Point_Type.
1255
1256          Set_Analyzed (Scalar_Range (Standard_Duration));
1257
1258          Set_Etype (Type_High_Bound (Standard_Duration), Standard_Duration);
1259          Set_Etype (Type_Low_Bound  (Standard_Duration), Standard_Duration);
1260
1261          Set_Is_Static_Expression (Type_High_Bound (Standard_Duration));
1262          Set_Is_Static_Expression (Type_Low_Bound  (Standard_Duration));
1263
1264          Set_Corresponding_Integer_Value
1265            (Type_High_Bound (Standard_Duration), Dhi);
1266
1267          Set_Corresponding_Integer_Value
1268            (Type_Low_Bound  (Standard_Duration), Dlo);
1269
1270          Set_Size_Known_At_Compile_Time (Standard_Duration);
1271       end Build_Duration;
1272
1273       --  Build standard exception type. Note that the type name here is
1274       --  actually used in the generated code, so it must be set correctly
1275
1276       --  ??? Also note that the Import_Code component is now declared
1277       --  as a System.Standard_Library.Exception_Code to enforce run-time
1278       --  library implementation consistency. It's too early here to resort
1279       --  to rtsfind to get the proper node for that type, so we use the
1280       --  closest possible available type node at hand instead. We should
1281       --  probably be fixing this up at some point.
1282
1283       Standard_Exception_Type := New_Standard_Entity;
1284       Set_Ekind       (Standard_Exception_Type, E_Record_Type);
1285       Set_Etype       (Standard_Exception_Type, Standard_Exception_Type);
1286       Set_Scope       (Standard_Exception_Type, Standard_Standard);
1287       Set_Stored_Constraint
1288                       (Standard_Exception_Type, No_Elist);
1289       Init_Size_Align (Standard_Exception_Type);
1290       Set_Size_Known_At_Compile_Time
1291                       (Standard_Exception_Type, True);
1292       Make_Name       (Standard_Exception_Type, "exception");
1293
1294       Make_Component
1295         (Standard_Exception_Type, Standard_Boolean,   "Not_Handled_By_Others");
1296       Make_Component
1297         (Standard_Exception_Type, Standard_Character, "Lang");
1298       Make_Component
1299         (Standard_Exception_Type, Standard_Natural,   "Name_Length");
1300       Make_Component
1301         (Standard_Exception_Type, Standard_A_Char,    "Full_Name");
1302       Make_Component
1303         (Standard_Exception_Type, Standard_A_Char,    "HTable_Ptr");
1304       Make_Component
1305         (Standard_Exception_Type, Standard_Unsigned,  "Import_Code");
1306       Make_Component
1307         (Standard_Exception_Type, Standard_A_Char,    "Raise_Hook");
1308
1309       --  Build tree for record declaration, for use by the back-end
1310
1311       declare
1312          Comp_List : List_Id;
1313          Comp      : Entity_Id;
1314
1315       begin
1316          Comp      := First_Entity (Standard_Exception_Type);
1317          Comp_List := New_List;
1318
1319          while Present (Comp) loop
1320             Append (
1321               Make_Component_Declaration (Stloc,
1322                 Defining_Identifier => Comp,
1323                 Component_Definition =>
1324                   Make_Component_Definition (Stloc,
1325                     Aliased_Present    => False,
1326                     Subtype_Indication => New_Occurrence_Of (Etype (Comp),
1327                                                              Stloc))),
1328               Comp_List);
1329
1330             Next_Entity (Comp);
1331          end loop;
1332
1333          Decl := Make_Full_Type_Declaration (Stloc,
1334            Defining_Identifier => Standard_Exception_Type,
1335            Type_Definition =>
1336              Make_Record_Definition (Stloc,
1337                End_Label => Empty,
1338                Component_List =>
1339                  Make_Component_List (Stloc,
1340                    Component_Items => Comp_List)));
1341       end;
1342
1343       Append (Decl, Decl_S);
1344
1345       Layout_Type (Standard_Exception_Type);
1346
1347       --  Create declarations of standard exceptions
1348
1349       Build_Exception (S_Constraint_Error);
1350       Build_Exception (S_Program_Error);
1351       Build_Exception (S_Storage_Error);
1352       Build_Exception (S_Tasking_Error);
1353
1354       --  Numeric_Error is a normal exception in Ada 83, but in Ada 95
1355       --  it is a renaming of Constraint_Error. Is this test too early???
1356
1357       if Ada_Version = Ada_83 then
1358          Build_Exception (S_Numeric_Error);
1359
1360       else
1361          Decl := New_Node (N_Exception_Renaming_Declaration, Stloc);
1362          E_Id := Standard_Entity (S_Numeric_Error);
1363
1364          Set_Ekind          (E_Id, E_Exception);
1365          Set_Exception_Code (E_Id, Uint_0);
1366          Set_Etype          (E_Id, Standard_Exception_Type);
1367          Set_Is_Public      (E_Id);
1368          Set_Renamed_Entity (E_Id, Standard_Entity (S_Constraint_Error));
1369
1370          Set_Defining_Identifier (Decl, E_Id);
1371          Append (Decl, Decl_S);
1372
1373          Ident_Node := New_Node (N_Identifier, Stloc);
1374          Set_Chars  (Ident_Node, Chars (Standard_Entity (S_Constraint_Error)));
1375          Set_Entity (Ident_Node, Standard_Entity (S_Constraint_Error));
1376          Set_Name   (Decl, Ident_Node);
1377       end if;
1378
1379       --  Abort_Signal is an entity that does not get made visible
1380
1381       Abort_Signal := New_Standard_Entity;
1382       Set_Chars          (Abort_Signal, Name_uAbort_Signal);
1383       Set_Ekind          (Abort_Signal, E_Exception);
1384       Set_Exception_Code (Abort_Signal, Uint_0);
1385       Set_Etype          (Abort_Signal, Standard_Exception_Type);
1386       Set_Scope          (Abort_Signal, Standard_Standard);
1387       Set_Is_Public      (Abort_Signal, True);
1388       Decl :=
1389         Make_Exception_Declaration (Stloc,
1390           Defining_Identifier => Abort_Signal);
1391
1392       --  Create defining identifiers for shift operator entities. Note
1393       --  that these entities are used only for marking shift operators
1394       --  generated internally, and hence need no structure, just a name
1395       --  and a unique identity.
1396
1397       Standard_Op_Rotate_Left := New_Standard_Entity;
1398       Set_Chars (Standard_Op_Rotate_Left, Name_Rotate_Left);
1399       Set_Ekind (Standard_Op_Rotate_Left, E_Operator);
1400
1401       Standard_Op_Rotate_Right := New_Standard_Entity;
1402       Set_Chars (Standard_Op_Rotate_Right, Name_Rotate_Right);
1403       Set_Ekind (Standard_Op_Rotate_Right, E_Operator);
1404
1405       Standard_Op_Shift_Left := New_Standard_Entity;
1406       Set_Chars (Standard_Op_Shift_Left, Name_Shift_Left);
1407       Set_Ekind (Standard_Op_Shift_Left, E_Operator);
1408
1409       Standard_Op_Shift_Right := New_Standard_Entity;
1410       Set_Chars (Standard_Op_Shift_Right, Name_Shift_Right);
1411       Set_Ekind (Standard_Op_Shift_Right, E_Operator);
1412
1413       Standard_Op_Shift_Right_Arithmetic := New_Standard_Entity;
1414       Set_Chars (Standard_Op_Shift_Right_Arithmetic,
1415                                           Name_Shift_Right_Arithmetic);
1416       Set_Ekind (Standard_Op_Shift_Right_Arithmetic,
1417                                           E_Operator);
1418
1419       --  Create standard operator declarations
1420
1421       Create_Operators;
1422
1423       --  Initialize visibility table with entities in Standard
1424
1425       for E in Standard_Entity_Type loop
1426          if Ekind (Standard_Entity (E)) /= E_Operator then
1427             Set_Name_Entity_Id
1428               (Chars (Standard_Entity (E)), Standard_Entity (E));
1429             Set_Homonym (Standard_Entity (E), Empty);
1430          end if;
1431
1432          if E not in S_ASCII_Names then
1433             Set_Scope (Standard_Entity (E), Standard_Standard);
1434             Set_Is_Immediately_Visible (Standard_Entity (E));
1435          end if;
1436       end loop;
1437
1438       --  The predefined package Standard itself does not have a scope;
1439       --  it is the only entity in the system not to have one, and this
1440       --  is what identifies the package to Gigi.
1441
1442       Set_Scope (Standard_Standard, Empty);
1443
1444       --  Set global variables indicating last Id values and version
1445
1446       Last_Standard_Node_Id := Last_Node_Id;
1447       Last_Standard_List_Id := Last_List_Id;
1448
1449       --  The Error node has an Etype of Any_Type to help error recovery
1450
1451       Set_Etype (Error, Any_Type);
1452
1453       --  Print representation of standard if switch set
1454
1455       if Opt.Print_Standard then
1456          Print_Standard;
1457       end if;
1458    end Create_Standard;
1459
1460    ------------------------------------
1461    -- Create_Unconstrained_Base_Type --
1462    ------------------------------------
1463
1464    procedure Create_Unconstrained_Base_Type
1465      (E : Entity_Id;
1466       K : Entity_Kind)
1467    is
1468       New_Ent : constant Entity_Id := New_Copy (E);
1469
1470    begin
1471       Set_Ekind            (E, K);
1472       Set_Is_Constrained   (E, True);
1473       Set_Is_First_Subtype (E, True);
1474       Set_Etype            (E, New_Ent);
1475
1476       Append_Entity (New_Ent, Standard_Standard);
1477       Set_Is_Constrained (New_Ent, False);
1478       Set_Etype          (New_Ent, New_Ent);
1479       Set_Is_Known_Valid (New_Ent, True);
1480
1481       if K = E_Signed_Integer_Subtype then
1482          Set_Etype (Low_Bound  (Scalar_Range (E)), New_Ent);
1483          Set_Etype (High_Bound (Scalar_Range (E)), New_Ent);
1484       end if;
1485
1486    end Create_Unconstrained_Base_Type;
1487
1488    --------------------
1489    -- Identifier_For --
1490    --------------------
1491
1492    function Identifier_For (S : Standard_Entity_Type) return Node_Id is
1493       Ident_Node : Node_Id;
1494
1495    begin
1496       Ident_Node := New_Node (N_Identifier, Stloc);
1497       Set_Chars (Ident_Node, Chars (Standard_Entity (S)));
1498       return Ident_Node;
1499    end Identifier_For;
1500
1501    --------------------
1502    -- Make_Component --
1503    --------------------
1504
1505    procedure Make_Component
1506      (Rec : Entity_Id;
1507       Typ : Entity_Id;
1508       Nam : String)
1509    is
1510       Id : constant Entity_Id := New_Standard_Entity;
1511
1512    begin
1513       Set_Ekind                 (Id, E_Component);
1514       Set_Etype                 (Id, Typ);
1515       Set_Scope                 (Id, Rec);
1516       Init_Component_Location   (Id);
1517
1518       Set_Original_Record_Component (Id, Id);
1519       Make_Name (Id, Nam);
1520       Append_Entity (Id, Rec);
1521    end Make_Component;
1522
1523    -----------------
1524    -- Make_Formal --
1525    -----------------
1526
1527    function Make_Formal
1528      (Typ         : Entity_Id;
1529       Formal_Name : String) return Entity_Id
1530    is
1531       Formal : Entity_Id;
1532
1533    begin
1534       Formal := New_Standard_Entity;
1535
1536       Set_Ekind     (Formal, E_In_Parameter);
1537       Set_Mechanism (Formal, Default_Mechanism);
1538       Set_Scope     (Formal, Standard_Standard);
1539       Set_Etype     (Formal, Typ);
1540       Make_Name     (Formal, Formal_Name);
1541
1542       return Formal;
1543    end Make_Formal;
1544
1545    ------------------
1546    -- Make_Integer --
1547    ------------------
1548
1549    function Make_Integer (V : Uint) return Node_Id is
1550       N : constant Node_Id := Make_Integer_Literal (Stloc, V);
1551    begin
1552       Set_Is_Static_Expression (N);
1553       return N;
1554    end Make_Integer;
1555
1556    ---------------
1557    -- Make_Name --
1558    ---------------
1559
1560    procedure Make_Name (Id : Entity_Id; Nam : String) is
1561    begin
1562       for J in 1 .. Nam'Length loop
1563          Name_Buffer (J) := Fold_Lower (Nam (Nam'First + (J - 1)));
1564       end loop;
1565
1566       Name_Len := Nam'Length;
1567       Set_Chars (Id, Name_Find);
1568    end Make_Name;
1569
1570    ------------------
1571    -- New_Operator --
1572    ------------------
1573
1574    function New_Operator (Op : Name_Id; Typ : Entity_Id) return Entity_Id is
1575       Ident_Node : Entity_Id;
1576
1577    begin
1578       Ident_Node := Make_Defining_Identifier (Stloc, Op);
1579
1580       Set_Is_Pure    (Ident_Node, True);
1581       Set_Ekind      (Ident_Node, E_Operator);
1582       Set_Etype      (Ident_Node, Typ);
1583       Set_Scope      (Ident_Node, Standard_Standard);
1584       Set_Homonym    (Ident_Node, Get_Name_Entity_Id (Op));
1585       Set_Convention (Ident_Node, Convention_Intrinsic);
1586
1587       Set_Is_Immediately_Visible   (Ident_Node, True);
1588       Set_Is_Intrinsic_Subprogram  (Ident_Node, True);
1589
1590       Set_Name_Entity_Id (Op, Ident_Node);
1591       Append_Entity (Ident_Node, Standard_Standard);
1592       return Ident_Node;
1593    end New_Operator;
1594
1595    -------------------------
1596    -- New_Standard_Entity --
1597    -------------------------
1598
1599    function New_Standard_Entity
1600      (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id
1601    is
1602       E : constant Entity_Id := New_Entity (New_Node_Kind, Stloc);
1603
1604    begin
1605       --  All standard entities are Pure and Public
1606
1607       Set_Is_Pure (E);
1608       Set_Is_Public (E);
1609
1610       --  All standard entity names are analyzed manually, and are thus
1611       --  frozen as soon as they are created.
1612
1613       Set_Is_Frozen (E);
1614
1615       --  Set debug information required for all standard types
1616
1617       Set_Needs_Debug_Info (E);
1618
1619       --  All standard entities are built with fully qualified names, so
1620       --  set the flag to prevent an abortive attempt at requalification!
1621
1622       Set_Has_Qualified_Name (E);
1623
1624       --  Return newly created entity to be completed by caller
1625
1626       return E;
1627    end New_Standard_Entity;
1628
1629    --------------------
1630    -- Print_Standard --
1631    --------------------
1632
1633    procedure Print_Standard is
1634
1635       procedure P (Item : String) renames Output.Write_Line;
1636       --  Short-hand, since we do a lot of line writes here!
1637
1638       procedure P_Int_Range (Size : Pos);
1639       --  Prints the range of an integer based on its Size
1640
1641       procedure P_Float_Range (Id : Entity_Id);
1642       --  Prints the bounds range for the given float type entity
1643
1644       -------------------
1645       -- P_Float_Range --
1646       -------------------
1647
1648       procedure P_Float_Range (Id : Entity_Id) is
1649          Digs : constant Nat := UI_To_Int (Digits_Value (Id));
1650
1651       begin
1652          Write_Str ("     range ");
1653
1654          if Vax_Float (Id) then
1655             if Digs = VAXFF_Digits then
1656                Write_Str (VAXFF_First'Universal_Literal_String);
1657                Write_Str (" .. ");
1658                Write_Str (VAXFF_Last'Universal_Literal_String);
1659
1660             elsif Digs = VAXDF_Digits then
1661                Write_Str (VAXDF_First'Universal_Literal_String);
1662                Write_Str (" .. ");
1663                Write_Str (VAXDF_Last'Universal_Literal_String);
1664
1665             else
1666                pragma Assert (Digs = VAXGF_Digits);
1667
1668                Write_Str (VAXGF_First'Universal_Literal_String);
1669                Write_Str (" .. ");
1670                Write_Str (VAXGF_Last'Universal_Literal_String);
1671             end if;
1672
1673          elsif Is_AAMP_Float (Id) then
1674             if Digs = AAMPS_Digits then
1675                Write_Str (AAMPS_First'Universal_Literal_String);
1676                Write_Str (" .. ");
1677                Write_Str (AAMPS_Last'Universal_Literal_String);
1678
1679             else
1680                pragma Assert (Digs = AAMPL_Digits);
1681                Write_Str (AAMPL_First'Universal_Literal_String);
1682                Write_Str (" .. ");
1683                Write_Str (AAMPL_Last'Universal_Literal_String);
1684             end if;
1685
1686          elsif Digs = IEEES_Digits then
1687             Write_Str (IEEES_First'Universal_Literal_String);
1688             Write_Str (" .. ");
1689             Write_Str (IEEES_Last'Universal_Literal_String);
1690
1691          elsif Digs = IEEEL_Digits then
1692             Write_Str (IEEEL_First'Universal_Literal_String);
1693             Write_Str (" .. ");
1694             Write_Str (IEEEL_Last'Universal_Literal_String);
1695
1696          else
1697             pragma Assert (Digs = IEEEX_Digits);
1698
1699             Write_Str (IEEEX_First'Universal_Literal_String);
1700             Write_Str (" .. ");
1701             Write_Str (IEEEX_Last'Universal_Literal_String);
1702          end if;
1703
1704          Write_Str (";");
1705          Write_Eol;
1706       end P_Float_Range;
1707
1708       -----------------
1709       -- P_Int_Range --
1710       -----------------
1711
1712       procedure P_Int_Range (Size : Pos) is
1713       begin
1714          Write_Str (" is range -(2 **");
1715          Write_Int (Size - 1);
1716          Write_Str (")");
1717          Write_Str (" .. +(2 **");
1718          Write_Int (Size - 1);
1719          Write_Str (" - 1);");
1720          Write_Eol;
1721       end P_Int_Range;
1722
1723    --  Start of processing for Print_Standard
1724
1725    begin
1726       P ("--  Representation of package Standard");
1727       Write_Eol;
1728       P ("--  This is not accurate Ada, since new base types cannot be ");
1729       P ("--  created, but the listing shows the target dependent");
1730       P ("--  characteristics of the Standard types for this compiler");
1731       Write_Eol;
1732
1733       P ("package Standard is");
1734       P ("pragma Pure(Standard);");
1735       Write_Eol;
1736
1737       P ("   type Boolean is (False, True);");
1738       P ("   for Boolean'Size use 1;");
1739       P ("   for Boolean use (False => 0, True => 1);");
1740       Write_Eol;
1741
1742       --  Integer types
1743
1744       Write_Str ("   type Integer");
1745       P_Int_Range (Standard_Integer_Size);
1746       Write_Str ("   for Integer'Size use ");
1747       Write_Int (Standard_Integer_Size);
1748       P (";");
1749       Write_Eol;
1750
1751       P ("   subtype Natural  is Integer range 0 .. Integer'Last;");
1752       P ("   subtype Positive is Integer range 1 .. Integer'Last;");
1753       Write_Eol;
1754
1755       Write_Str ("   type Short_Short_Integer");
1756       P_Int_Range (Standard_Short_Short_Integer_Size);
1757       Write_Str ("   for Short_Short_Integer'Size use ");
1758       Write_Int (Standard_Short_Short_Integer_Size);
1759       P (";");
1760       Write_Eol;
1761
1762       Write_Str ("   type Short_Integer");
1763       P_Int_Range (Standard_Short_Integer_Size);
1764       Write_Str ("   for Short_Integer'Size use ");
1765       Write_Int (Standard_Short_Integer_Size);
1766       P (";");
1767       Write_Eol;
1768
1769       Write_Str ("   type Long_Integer");
1770       P_Int_Range (Standard_Long_Integer_Size);
1771       Write_Str ("   for Long_Integer'Size use ");
1772       Write_Int (Standard_Long_Integer_Size);
1773       P (";");
1774       Write_Eol;
1775
1776       Write_Str ("   type Long_Long_Integer");
1777       P_Int_Range (Standard_Long_Long_Integer_Size);
1778       Write_Str ("   for Long_Long_Integer'Size use ");
1779       Write_Int (Standard_Long_Long_Integer_Size);
1780       P (";");
1781       Write_Eol;
1782
1783       --  Floating point types
1784
1785       Write_Str ("   type Short_Float is digits ");
1786       Write_Int (Standard_Short_Float_Digits);
1787       Write_Eol;
1788       P_Float_Range (Standard_Short_Float);
1789       Write_Str ("   for Short_Float'Size use ");
1790       Write_Int (Standard_Short_Float_Size);
1791       P (";");
1792       Write_Eol;
1793
1794       Write_Str ("   type Float is digits ");
1795       Write_Int (Standard_Float_Digits);
1796       Write_Eol;
1797       P_Float_Range (Standard_Float);
1798       Write_Str ("   for Float'Size use ");
1799       Write_Int (Standard_Float_Size);
1800       P (";");
1801       Write_Eol;
1802
1803       Write_Str ("   type Long_Float is digits ");
1804       Write_Int (Standard_Long_Float_Digits);
1805       Write_Eol;
1806       P_Float_Range (Standard_Long_Float);
1807       Write_Str ("   for Long_Float'Size use ");
1808       Write_Int (Standard_Long_Float_Size);
1809       P (";");
1810       Write_Eol;
1811
1812       Write_Str ("   type Long_Long_Float is digits ");
1813       Write_Int (Standard_Long_Long_Float_Digits);
1814       Write_Eol;
1815       P_Float_Range (Standard_Long_Long_Float);
1816       Write_Str ("   for Long_Long_Float'Size use ");
1817       Write_Int (Standard_Long_Long_Float_Size);
1818       P (";");
1819       Write_Eol;
1820
1821       P ("   type Character is (...)");
1822       Write_Str ("   for Character'Size use ");
1823       Write_Int (Standard_Character_Size);
1824       P (";");
1825       P ("   --  See RM A.1(35) for details of this type");
1826       Write_Eol;
1827
1828       P ("   type Wide_Character is (...)");
1829       Write_Str ("   for Wide_Character'Size use ");
1830       Write_Int (Standard_Wide_Character_Size);
1831       P (";");
1832       P ("   --  See RM A.1(36) for details of this type");
1833       Write_Eol;
1834
1835       P ("   type Wide_Wide_Character is (...)");
1836       Write_Str ("   for Wide_Character'Size use ");
1837       Write_Int (Standard_Wide_Wide_Character_Size);
1838       P (";");
1839       P ("   --  See RM A.1(36) for details of this type");
1840
1841       P ("   type String is array (Positive range <>) of Character;");
1842       P ("   pragma Pack (String);");
1843       Write_Eol;
1844
1845       P ("   type Wide_String is array (Positive range <>)" &
1846          " of Wide_Character;");
1847       P ("   pragma Pack (Wide_String);");
1848       Write_Eol;
1849
1850       P ("   type Wide_Wide_String is array (Positive range <>)" &
1851          "  of Wide_Wide_Character;");
1852       P ("   pragma Pack (Wide_Wide_String);");
1853       Write_Eol;
1854
1855       --  Here it's OK to use the Duration type of the host compiler since
1856       --  the implementation of Duration in GNAT is target independent.
1857
1858       if Duration_32_Bits_On_Target then
1859          P ("   type Duration is delta 0.020");
1860          P ("     range -((2 ** 31 - 1) * 0.020) ..");
1861          P ("           +((2 ** 31 - 1) * 0.020);");
1862          P ("   for Duration'Small use 0.020;");
1863       else
1864          P ("   type Duration is delta 0.000000001");
1865          P ("     range -((2 ** 63 - 1) * 0.000000001) ..");
1866          P ("           +((2 ** 63 - 1) * 0.000000001);");
1867          P ("   for Duration'Small use 0.000000001;");
1868       end if;
1869
1870       Write_Eol;
1871
1872       P ("   Constraint_Error : exception;");
1873       P ("   Program_Error    : exception;");
1874       P ("   Storage_Error    : exception;");
1875       P ("   Tasking_Error    : exception;");
1876       P ("   Numeric_Error    : exception renames Constraint_Error;");
1877       Write_Eol;
1878
1879       P ("end Standard;");
1880    end Print_Standard;
1881
1882    ----------------------
1883    -- Set_Float_Bounds --
1884    ----------------------
1885
1886    procedure Set_Float_Bounds (Id  : Entity_Id) is
1887       L  : Node_Id;
1888       --  Low bound of literal value
1889
1890       H  : Node_Id;
1891       --  High bound of literal value
1892
1893       R  : Node_Id;
1894       --  Range specification
1895
1896       Digs  : constant Nat := UI_To_Int (Digits_Value (Id));
1897       --  Digits value, used to select bounds
1898
1899    begin
1900       --  Note: for the call from Cstand to initially create the types in
1901       --  Standard, Vax_Float will always be False. Circuitry in Sem_Vfpt
1902       --  will adjust these types appropriately in the Vax_Float case if
1903       --  a pragma Float_Representation (VAX_Float) is used.
1904
1905       if Vax_Float (Id) then
1906          if Digs = VAXFF_Digits then
1907             L := Real_Convert
1908                    (VAXFF_First'Universal_Literal_String);
1909             H := Real_Convert
1910                    (VAXFF_Last'Universal_Literal_String);
1911
1912          elsif Digs = VAXDF_Digits then
1913             L := Real_Convert
1914                    (VAXDF_First'Universal_Literal_String);
1915             H := Real_Convert
1916                    (VAXDF_Last'Universal_Literal_String);
1917
1918          else
1919             pragma Assert (Digs = VAXGF_Digits);
1920
1921             L := Real_Convert
1922                    (VAXGF_First'Universal_Literal_String);
1923             H := Real_Convert
1924                    (VAXGF_Last'Universal_Literal_String);
1925          end if;
1926
1927       elsif Is_AAMP_Float (Id) then
1928          if Digs = AAMPS_Digits then
1929             L := Real_Convert
1930                    (AAMPS_First'Universal_Literal_String);
1931             H := Real_Convert
1932                    (AAMPS_Last'Universal_Literal_String);
1933
1934          else
1935             pragma Assert (Digs = AAMPL_Digits);
1936             L := Real_Convert
1937                    (AAMPL_First'Universal_Literal_String);
1938             H := Real_Convert
1939                    (AAMPL_Last'Universal_Literal_String);
1940          end if;
1941
1942       elsif Digs = IEEES_Digits then
1943          L := Real_Convert
1944                 (IEEES_First'Universal_Literal_String);
1945          H := Real_Convert
1946                 (IEEES_Last'Universal_Literal_String);
1947
1948       elsif Digs = IEEEL_Digits then
1949          L := Real_Convert
1950                 (IEEEL_First'Universal_Literal_String);
1951          H := Real_Convert
1952                 (IEEEL_Last'Universal_Literal_String);
1953
1954       else
1955          pragma Assert (Digs = IEEEX_Digits);
1956
1957          L := Real_Convert
1958                 (IEEEX_First'Universal_Literal_String);
1959          H := Real_Convert
1960                 (IEEEX_Last'Universal_Literal_String);
1961       end if;
1962
1963       Set_Etype                (L, Id);
1964       Set_Is_Static_Expression (L);
1965
1966       Set_Etype                (H, Id);
1967       Set_Is_Static_Expression (H);
1968
1969       R := New_Node (N_Range, Stloc);
1970       Set_Low_Bound  (R, L);
1971       Set_High_Bound (R, H);
1972       Set_Includes_Infinities (R, True);
1973       Set_Scalar_Range (Id, R);
1974       Set_Etype (R, Id);
1975       Set_Parent (R, Id);
1976    end Set_Float_Bounds;
1977
1978    ------------------------
1979    -- Set_Integer_Bounds --
1980    ------------------------
1981
1982    procedure Set_Integer_Bounds
1983      (Id  : Entity_Id;
1984       Typ : Entity_Id;
1985       Lb  : Uint;
1986       Hb  : Uint)
1987    is
1988       L : Node_Id;     -- Low bound of literal value
1989       H : Node_Id;     -- High bound of literal value
1990       R : Node_Id;     -- Range specification
1991
1992    begin
1993       L := Make_Integer (Lb);
1994       H := Make_Integer (Hb);
1995
1996       Set_Etype (L, Typ);
1997       Set_Etype (H, Typ);
1998
1999       R := New_Node (N_Range, Stloc);
2000       Set_Low_Bound  (R, L);
2001       Set_High_Bound (R, H);
2002       Set_Scalar_Range (Id, R);
2003       Set_Etype (R, Typ);
2004       Set_Parent (R, Id);
2005       Set_Is_Unsigned_Type (Id, Lb >= 0);
2006    end Set_Integer_Bounds;
2007
2008 end CStand;