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