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