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