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