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