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       --  Create type definition nodes for predefined integer types
 406
 407       Build_Signed_Integer_Type
 408         (Standard_Short_Short_Integer, Standard_Short_Short_Integer_Size);
 409
 410       Build_Signed_Integer_Type
 411         (Standard_Short_Integer, Standard_Short_Integer_Size);
 412
 413       Build_Signed_Integer_Type
 414         (Standard_Integer, Standard_Integer_Size);
 415
 416       declare
 417          LIS : Nat;
 418       begin
 419          if Debug_Flag_M then
 420             LIS := 64;
 421          else
 422             LIS := Standard_Long_Integer_Size;
 423          end if;
 424
 425          Build_Signed_Integer_Type (Standard_Long_Integer, LIS);
 426       end;
 427
 428       Build_Signed_Integer_Type
 429         (Standard_Long_Long_Integer, Standard_Long_Long_Integer_Size);
 430
 431       Create_Unconstrained_Base_Type
 432         (Standard_Short_Short_Integer, E_Signed_Integer_Subtype);
 433
 434       Create_Unconstrained_Base_Type
 435         (Standard_Short_Integer, E_Signed_Integer_Subtype);
 436
 437       Create_Unconstrained_Base_Type
 438         (Standard_Integer, E_Signed_Integer_Subtype);
 439
 440       Create_Unconstrained_Base_Type
 441         (Standard_Long_Integer, E_Signed_Integer_Subtype);
 442
 443       Create_Unconstrained_Base_Type
 444         (Standard_Long_Long_Integer, E_Signed_Integer_Subtype);
 445
 446       --  Create type definition nodes for predefined float types
 447
 448       Build_Float_Type
 449         (Standard_Short_Float,
 450          Standard_Short_Float_Size,
 451          Standard_Short_Float_Digits);
 452
 453       Build_Float_Type
 454         (Standard_Float,
 455          Standard_Float_Size,
 456          Standard_Float_Digits);
 457
 458       Build_Float_Type
 459         (Standard_Long_Float,
 460          Standard_Long_Float_Size,
 461          Standard_Long_Float_Digits);
 462
 463       Build_Float_Type
 464         (Standard_Long_Long_Float,
 465          Standard_Long_Long_Float_Size,
 466          Standard_Long_Long_Float_Digits);
 467
 468       --  Create type definition node for type Character. Note that we do not
 469       --  set the Literals field, since type Character is handled with special
 470       --  routine that do not need a literal list.
 471
 472       Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
 473       Set_Type_Definition (Parent (Standard_Character), Tdef_Node);
 474
 475       Set_Ekind          (Standard_Character, E_Enumeration_Type);
 476       Set_Etype          (Standard_Character, Standard_Character);
 477       Init_Esize         (Standard_Character, Standard_Character_Size);
 478       Init_RM_Size       (Standard_Character, 8);
 479       Set_Prim_Alignment (Standard_Character);
 480
 481       Set_Is_Unsigned_Type           (Standard_Character);
 482       Set_Is_Character_Type          (Standard_Character);
 483       Set_Is_Known_Valid             (Standard_Character);
 484       Set_Size_Known_At_Compile_Time (Standard_Character);
 485
 486       --  Create the bounds for type Character.
 487
 488       R_Node := New_Node (N_Range, Stloc);
 489
 490       --  Low bound for type Character (Standard.Nul)
 491
 492       B_Node := New_Node (N_Character_Literal, Stloc);
 493       Set_Is_Static_Expression (B_Node);
 494       Set_Chars                (B_Node, No_Name);
 495       Set_Char_Literal_Value   (B_Node, 16#00#);
 496       Set_Entity               (B_Node,  Empty);
 497       Set_Etype                (B_Node, Standard_Character);
 498       Set_Low_Bound (R_Node, B_Node);
 499
 500       --  High bound for type Character
 501
 502       B_Node := New_Node (N_Character_Literal, Stloc);
 503       Set_Is_Static_Expression (B_Node);
 504       Set_Chars                (B_Node, No_Name);
 505       Set_Char_Literal_Value   (B_Node, 16#FF#);
 506       Set_Entity               (B_Node,  Empty);
 507       Set_Etype                (B_Node, Standard_Character);
 508       Set_High_Bound (R_Node, B_Node);
 509
 510       Set_Scalar_Range (Standard_Character, R_Node);
 511       Set_Etype (R_Node, Standard_Character);
 512       Set_Parent (R_Node, Standard_Character);
 513
 514       --  Create type definition for type Wide_Character. Note that we do not
 515       --  set the Literals field, since type Wide_Character is handled with
 516       --  special routines that do not need a literal list.
 517
 518       Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
 519       Set_Type_Definition (Parent (Standard_Wide_Character), Tdef_Node);
 520
 521       Set_Ekind      (Standard_Wide_Character, E_Enumeration_Type);
 522       Set_Etype      (Standard_Wide_Character, Standard_Wide_Character);
 523       Init_Size      (Standard_Wide_Character, Standard_Wide_Character_Size);
 524
 525       Set_Prim_Alignment             (Standard_Wide_Character);
 526       Set_Is_Unsigned_Type           (Standard_Wide_Character);
 527       Set_Is_Character_Type          (Standard_Wide_Character);
 528       Set_Is_Known_Valid             (Standard_Wide_Character);
 529       Set_Size_Known_At_Compile_Time (Standard_Wide_Character);
 530
 531       --  Create the bounds for type Wide_Character.
 532
 533       R_Node := New_Node (N_Range, Stloc);
 534
 535       --  Low bound for type Wide_Character
 536
 537       B_Node := New_Node (N_Character_Literal, Stloc);
 538       Set_Is_Static_Expression (B_Node);
 539       Set_Chars                (B_Node, No_Name);    --  ???
 540       Set_Char_Literal_Value   (B_Node, 16#0000#);
 541       Set_Entity               (B_Node,  Empty);
 542       Set_Etype                (B_Node, Standard_Wide_Character);
 543       Set_Low_Bound (R_Node, B_Node);
 544
 545       --  High bound for type Wide_Character
 546
 547       B_Node := New_Node (N_Character_Literal, Stloc);
 548       Set_Is_Static_Expression (B_Node);
 549       Set_Chars                (B_Node, No_Name);    --  ???
 550       Set_Char_Literal_Value   (B_Node, 16#FFFF#);
 551       Set_Entity               (B_Node,  Empty);
 552       Set_Etype                (B_Node, Standard_Wide_Character);
 553       Set_High_Bound           (R_Node, B_Node);
 554
 555       Set_Scalar_Range (Standard_Wide_Character, R_Node);
 556       Set_Etype (R_Node, Standard_Wide_Character);
 557       Set_Parent (R_Node, Standard_Wide_Character);
 558
 559       --  Create type definition node for type String
 560
 561       Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
 562
 563       declare
 564          CompDef_Node : Node_Id;
 565       begin
 566          CompDef_Node := New_Node (N_Component_Definition, Stloc);
 567          Set_Aliased_Present    (CompDef_Node, False);
 568          Set_Access_Definition  (CompDef_Node, Empty);
 569          Set_Subtype_Indication (CompDef_Node, Identifier_For (S_Character));
 570          Set_Component_Definition (Tdef_Node, CompDef_Node);
 571       end;
 572
 573       Set_Subtype_Marks      (Tdef_Node, New_List);
 574       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
 575       Set_Type_Definition (Parent (Standard_String), Tdef_Node);
 576
 577       Set_Ekind          (Standard_String, E_String_Type);
 578       Set_Etype          (Standard_String, Standard_String);
 579       Set_Component_Type (Standard_String, Standard_Character);
 580       Set_Component_Size (Standard_String, Uint_8);
 581       Init_Size_Align    (Standard_String);
 582
 583       --  Set index type of String
 584
 585       E_Id := First
 586         (Subtype_Marks (Type_Definition (Parent (Standard_String))));
 587       Set_First_Index (Standard_String, E_Id);
 588       Set_Entity (E_Id, Standard_Positive);
 589       Set_Etype (E_Id, Standard_Positive);
 590
 591       --  Create type definition node for type Wide_String
 592
 593       Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
 594       declare
 595          CompDef_Node : Node_Id;
 596       begin
 597          CompDef_Node := New_Node (N_Component_Definition, Stloc);
 598          Set_Aliased_Present    (CompDef_Node, False);
 599          Set_Access_Definition  (CompDef_Node, Empty);
 600          Set_Subtype_Indication (CompDef_Node,
 601                                  Identifier_For (S_Wide_Character));
 602          Set_Component_Definition (Tdef_Node, CompDef_Node);
 603       end;
 604       Set_Subtype_Marks (Tdef_Node, New_List);
 605       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
 606       Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);
 607
 608       Set_Ekind          (Standard_Wide_String, E_String_Type);
 609       Set_Etype          (Standard_Wide_String, Standard_Wide_String);
 610       Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
 611       Set_Component_Size (Standard_Wide_String, Uint_16);
 612       Init_Size_Align    (Standard_Wide_String);
 613
 614       --  Set index type of Wide_String
 615
 616       E_Id := First
 617         (Subtype_Marks (Type_Definition (Parent (Standard_Wide_String))));
 618       Set_First_Index (Standard_Wide_String, E_Id);
 619       Set_Entity (E_Id, Standard_Positive);
 620       Set_Etype (E_Id, Standard_Positive);
 621
 622       --  Create subtype declaration for Natural
 623
 624       Decl := New_Node (N_Subtype_Declaration, Stloc);
 625       Set_Defining_Identifier (Decl, Standard_Natural);
 626       Set_Subtype_Indication (Decl,
 627         New_Occurrence_Of (Standard_Integer, Stloc));
 628       Append (Decl, Decl_S);
 629
 630       Set_Ekind          (Standard_Natural, E_Signed_Integer_Subtype);
 631       Set_Etype          (Standard_Natural, Base_Type (Standard_Integer));
 632       Init_Esize         (Standard_Natural, Standard_Integer_Size);
 633       Init_RM_Size       (Standard_Natural, Standard_Integer_Size - 1);
 634       Set_Prim_Alignment (Standard_Natural);
 635       Set_Size_Known_At_Compile_Time
 636                          (Standard_Natural);
 637       Set_Integer_Bounds (Standard_Natural,
 638         Typ => Base_Type (Standard_Integer),
 639         Lb  => Uint_0,
 640         Hb  => Intval (High_Bound (Scalar_Range (Standard_Integer))));
 641       Set_Is_Constrained (Standard_Natural);
 642       Set_Is_Frozen      (Standard_Natural);
 643       Set_Is_Public      (Standard_Natural);
 644
 645       --  Create subtype declaration for Positive
 646
 647       Decl := New_Node (N_Subtype_Declaration, Stloc);
 648       Set_Defining_Identifier (Decl, Standard_Positive);
 649       Set_Subtype_Indication (Decl,
 650         New_Occurrence_Of (Standard_Integer, Stloc));
 651       Append (Decl, Decl_S);
 652
 653       Set_Ekind          (Standard_Positive, E_Signed_Integer_Subtype);
 654       Set_Etype          (Standard_Positive, Base_Type (Standard_Integer));
 655       Init_Esize         (Standard_Positive, Standard_Integer_Size);
 656       Init_RM_Size       (Standard_Positive, Standard_Integer_Size - 1);
 657       Set_Prim_Alignment (Standard_Positive);
 658
 659       Set_Size_Known_At_Compile_Time (Standard_Positive);
 660
 661       Set_Integer_Bounds   (Standard_Positive,
 662          Typ => Base_Type (Standard_Integer),
 663          Lb  => Uint_1,
 664          Hb  => Intval (High_Bound (Scalar_Range (Standard_Integer))));
 665       Set_Is_Constrained   (Standard_Positive);
 666       Set_Is_Frozen        (Standard_Positive);
 667       Set_Is_Public        (Standard_Positive);
 668
 669       --  Create declaration for package ASCII
 670
 671       Decl := New_Node (N_Package_Declaration, Stloc);
 672       Append (Decl, Decl_S);
 673
 674       Pspec := New_Node (N_Package_Specification, Stloc);
 675       Set_Specification (Decl, Pspec);
 676
 677       Set_Defining_Unit_Name (Pspec, Standard_Entity (S_ASCII));
 678       Set_Ekind (Standard_Entity (S_ASCII), E_Package);
 679       Set_Visible_Declarations (Pspec, Decl_A);
 680
 681       --  Create control character definitions in package ASCII. Note that
 682       --  the character literal entries created here correspond to literal
 683       --  values that are impossible in the source, but can be represented
 684       --  internally with no difficulties.
 685
 686       Ccode := 16#00#;
 687
 688       for S in S_ASCII_Names loop
 689          Decl := New_Node (N_Object_Declaration, Staloc);
 690          Set_Constant_Present (Decl, True);
 691
 692          declare
 693             A_Char    : constant Entity_Id := Standard_Entity (S);
 694             Expr_Decl : Node_Id;
 695
 696          begin
 697             Set_Sloc                   (A_Char, Staloc);
 698             Set_Ekind                  (A_Char, E_Constant);
 699             Set_Never_Set_In_Source    (A_Char, True);
 700             Set_Is_True_Constant       (A_Char, True);
 701             Set_Etype                  (A_Char, Standard_Character);
 702             Set_Scope                  (A_Char, Standard_Entity (S_ASCII));
 703             Set_Is_Immediately_Visible (A_Char, False);
 704             Set_Is_Public              (A_Char, True);
 705             Set_Is_Known_Valid         (A_Char, True);
 706
 707             Append_Entity (A_Char, Standard_Entity (S_ASCII));
 708             Set_Defining_Identifier (Decl, A_Char);
 709
 710             Set_Object_Definition (Decl, Identifier_For (S_Character));
 711             Expr_Decl := New_Node (N_Character_Literal, Staloc);
 712             Set_Expression (Decl, Expr_Decl);
 713
 714             Set_Is_Static_Expression (Expr_Decl);
 715             Set_Chars                (Expr_Decl, No_Name);
 716             Set_Etype                (Expr_Decl, Standard_Character);
 717             Set_Char_Literal_Value   (Expr_Decl, Ccode);
 718          end;
 719
 720          Append (Decl, Decl_A);
 721
 722          --  Increment character code, dealing with non-contiguities
 723
 724          Ccode := Ccode + 1;
 725
 726          if Ccode = 16#20# then
 727             Ccode := 16#21#;
 728          elsif Ccode = 16#27# then
 729             Ccode := 16#3A#;
 730          elsif Ccode = 16#3C# then
 731             Ccode := 16#3F#;
 732          elsif Ccode = 16#41# then
 733             Ccode := 16#5B#;
 734          end if;
 735       end loop;
 736
 737       --  Create semantic phase entities
 738
 739       Standard_Void_Type := New_Standard_Entity;
 740       Set_Ekind       (Standard_Void_Type, E_Void);
 741       Set_Etype       (Standard_Void_Type, Standard_Void_Type);
 742       Set_Scope       (Standard_Void_Type, Standard_Standard);
 743       Make_Name       (Standard_Void_Type, "_void_type");
 744
 745       --  The type field of packages is set to void
 746
 747       Set_Etype (Standard_Standard, Standard_Void_Type);
 748       Set_Etype (Standard_ASCII, Standard_Void_Type);
 749
 750       --  Standard_A_String is actually used in generated code, so it has a
 751       --  type name that is reasonable, but does not overlap any Ada name.
 752
 753       Standard_A_String := New_Standard_Entity;
 754       Set_Ekind      (Standard_A_String, E_Access_Type);
 755       Set_Scope      (Standard_A_String, Standard_Standard);
 756       Set_Etype      (Standard_A_String, Standard_A_String);
 757
 758       if Debug_Flag_6 then
 759          Init_Size   (Standard_A_String, System_Address_Size);
 760       else
 761          Init_Size   (Standard_A_String, System_Address_Size * 2);
 762       end if;
 763
 764       Init_Alignment (Standard_A_String);
 765
 766       Set_Directly_Designated_Type
 767                      (Standard_A_String, Standard_String);
 768       Make_Name      (Standard_A_String, "access_string");
 769
 770       Standard_A_Char := New_Standard_Entity;
 771       Set_Ekind          (Standard_A_Char, E_Access_Type);
 772       Set_Scope          (Standard_A_Char, Standard_Standard);
 773       Set_Etype          (Standard_A_Char, Standard_A_String);
 774       Init_Size          (Standard_A_Char, System_Address_Size);
 775       Set_Prim_Alignment (Standard_A_Char);
 776
 777       Set_Directly_Designated_Type (Standard_A_Char, Standard_Character);
 778       Make_Name     (Standard_A_Char, "access_character");
 779
 780       --  Note on type names. The type names for the following special types
 781       --  are constructed so that they will look reasonable should they ever
 782       --  appear in error messages etc, although in practice the use of the
 783       --  special insertion character } for types results in special handling
 784       --  of these type names in any case. The blanks in these names would
 785       --  trouble in Gigi, but that's OK here, since none of these types
 786       --  should ever get through to Gigi! Attributes of these types are
 787       --  filled out to minimize problems with cascaded errors (for example,
 788       --  Any_Integer is given reasonable and consistent type and size values)
 789
 790       Any_Type := New_Standard_Entity;
 791       Decl := New_Node (N_Full_Type_Declaration, Stloc);
 792       Set_Defining_Identifier (Decl, Any_Type);
 793       Set_Scope (Any_Type, Standard_Standard);
 794       Build_Signed_Integer_Type (Any_Type, Standard_Integer_Size);
 795       Make_Name (Any_Type, "any type");
 796
 797       Any_Id := New_Standard_Entity;
 798       Set_Ekind             (Any_Id, E_Variable);
 799       Set_Scope             (Any_Id, Standard_Standard);
 800       Set_Etype             (Any_Id, Any_Type);
 801       Init_Size_Align       (Any_Id);
 802       Make_Name             (Any_Id, "any id");
 803
 804       Any_Access := New_Standard_Entity;
 805       Set_Ekind             (Any_Access, E_Access_Type);
 806       Set_Scope             (Any_Access, Standard_Standard);
 807       Set_Etype             (Any_Access, Any_Access);
 808       Init_Size             (Any_Access, System_Address_Size);
 809       Set_Prim_Alignment    (Any_Access);
 810       Make_Name             (Any_Access, "an access type");
 811
 812       Any_Character := New_Standard_Entity;
 813       Set_Ekind             (Any_Character, E_Enumeration_Type);
 814       Set_Scope             (Any_Character, Standard_Standard);
 815       Set_Etype             (Any_Character, Any_Character);
 816       Set_Is_Unsigned_Type  (Any_Character);
 817       Set_Is_Character_Type (Any_Character);
 818       Init_Esize            (Any_Character, Standard_Character_Size);
 819       Init_RM_Size          (Any_Character, 8);
 820       Set_Prim_Alignment    (Any_Character);
 821       Set_Scalar_Range      (Any_Character, Scalar_Range (Standard_Character));
 822       Make_Name             (Any_Character, "a character type");
 823
 824       Any_Array := New_Standard_Entity;
 825       Set_Ekind             (Any_Array, E_String_Type);
 826       Set_Scope             (Any_Array, Standard_Standard);
 827       Set_Etype             (Any_Array, Any_Array);
 828       Set_Component_Type    (Any_Array, Any_Character);
 829       Init_Size_Align       (Any_Array);
 830       Make_Name             (Any_Array, "an array type");
 831
 832       Any_Boolean := New_Standard_Entity;
 833       Set_Ekind             (Any_Boolean, E_Enumeration_Type);
 834       Set_Scope             (Any_Boolean, Standard_Standard);
 835       Set_Etype             (Any_Boolean, Standard_Boolean);
 836       Init_Esize            (Any_Boolean, Standard_Character_Size);
 837       Init_RM_Size          (Any_Boolean, 1);
 838       Set_Prim_Alignment    (Any_Boolean);
 839       Set_Is_Unsigned_Type  (Any_Boolean);
 840       Set_Scalar_Range      (Any_Boolean, Scalar_Range (Standard_Boolean));
 841       Make_Name             (Any_Boolean, "a boolean type");
 842
 843       Any_Composite := New_Standard_Entity;
 844       Set_Ekind             (Any_Composite, E_Array_Type);
 845       Set_Scope             (Any_Composite, Standard_Standard);
 846       Set_Etype             (Any_Composite, Any_Composite);
 847       Set_Component_Size    (Any_Composite, Uint_0);
 848       Set_Component_Type    (Any_Composite, Standard_Integer);
 849       Init_Size_Align       (Any_Composite);
 850       Make_Name             (Any_Composite, "a composite type");
 851
 852       Any_Discrete := New_Standard_Entity;
 853       Set_Ekind             (Any_Discrete, E_Signed_Integer_Type);
 854       Set_Scope             (Any_Discrete, Standard_Standard);
 855       Set_Etype             (Any_Discrete, Any_Discrete);
 856       Init_Size             (Any_Discrete, Standard_Integer_Size);
 857       Set_Prim_Alignment    (Any_Discrete);
 858       Make_Name             (Any_Discrete, "a discrete type");
 859
 860       Any_Fixed := New_Standard_Entity;
 861       Set_Ekind             (Any_Fixed, E_Ordinary_Fixed_Point_Type);
 862       Set_Scope             (Any_Fixed, Standard_Standard);
 863       Set_Etype             (Any_Fixed, Any_Fixed);
 864       Init_Size             (Any_Fixed, Standard_Integer_Size);
 865       Set_Prim_Alignment    (Any_Fixed);
 866       Make_Name             (Any_Fixed, "a fixed-point type");
 867
 868       Any_Integer := New_Standard_Entity;
 869       Set_Ekind             (Any_Integer, E_Signed_Integer_Type);
 870       Set_Scope             (Any_Integer, Standard_Standard);
 871       Set_Etype             (Any_Integer, Standard_Long_Long_Integer);
 872       Init_Size             (Any_Integer, Standard_Long_Long_Integer_Size);
 873       Set_Prim_Alignment    (Any_Integer);
 874
 875       Set_Integer_Bounds
 876         (Any_Integer,
 877          Typ => Base_Type (Standard_Integer),
 878          Lb  => Uint_0,
 879          Hb  => Intval (High_Bound (Scalar_Range (Standard_Integer))));
 880       Make_Name (Any_Integer, "an integer type");
 881
 882       Any_Modular := New_Standard_Entity;
 883       Set_Ekind             (Any_Modular, E_Modular_Integer_Type);
 884       Set_Scope             (Any_Modular, Standard_Standard);
 885       Set_Etype             (Any_Modular, Standard_Long_Long_Integer);
 886       Init_Size             (Any_Modular, Standard_Long_Long_Integer_Size);
 887       Set_Prim_Alignment    (Any_Modular);
 888       Set_Is_Unsigned_Type  (Any_Modular);
 889       Make_Name             (Any_Modular, "a modular type");
 890
 891       Any_Numeric := New_Standard_Entity;
 892       Set_Ekind             (Any_Numeric, E_Signed_Integer_Type);
 893       Set_Scope             (Any_Numeric, Standard_Standard);
 894       Set_Etype             (Any_Numeric, Standard_Long_Long_Integer);
 895       Init_Size             (Any_Numeric, Standard_Long_Long_Integer_Size);
 896       Set_Prim_Alignment    (Any_Numeric);
 897       Make_Name             (Any_Numeric, "a numeric type");
 898
 899       Any_Real := New_Standard_Entity;
 900       Set_Ekind             (Any_Real, E_Floating_Point_Type);
 901       Set_Scope             (Any_Real, Standard_Standard);
 902       Set_Etype             (Any_Real, Standard_Long_Long_Float);
 903       Init_Size             (Any_Real, Standard_Long_Long_Float_Size);
 904       Set_Prim_Alignment    (Any_Real);
 905       Make_Name             (Any_Real, "a real type");
 906
 907       Any_Scalar := New_Standard_Entity;
 908       Set_Ekind             (Any_Scalar, E_Signed_Integer_Type);
 909       Set_Scope             (Any_Scalar, Standard_Standard);
 910       Set_Etype             (Any_Scalar, Any_Scalar);
 911       Init_Size             (Any_Scalar, Standard_Integer_Size);
 912       Set_Prim_Alignment    (Any_Scalar);
 913       Make_Name             (Any_Scalar, "a scalar type");
 914
 915       Any_String := New_Standard_Entity;
 916       Set_Ekind             (Any_String, E_String_Type);
 917       Set_Scope             (Any_String, Standard_Standard);
 918       Set_Etype             (Any_String, Any_String);
 919       Set_Component_Type    (Any_String, Any_Character);
 920       Init_Size_Align       (Any_String);
 921       Make_Name             (Any_String, "a string type");
 922
 923       declare
 924          Index   : Node_Id;
 925
 926       begin
 927          Index :=
 928            Make_Range (Stloc,
 929              Low_Bound  => Make_Integer (Uint_0),
 930              High_Bound => Make_Integer (Uint_2 ** Standard_Integer_Size));
 931          Set_Etype (Index, Standard_Integer);
 932          Set_First_Index (Any_String, Index);
 933       end;
 934
 935       Standard_Integer_8 := New_Standard_Entity;
 936       Decl := New_Node (N_Full_Type_Declaration, Stloc);
 937       Set_Defining_Identifier (Decl, Standard_Integer_8);
 938       Make_Name (Standard_Integer_8, "integer_8");
 939       Set_Scope (Standard_Integer_8, Standard_Standard);
 940       Build_Signed_Integer_Type (Standard_Integer_8, 8);
 941
 942       Standard_Integer_16 := New_Standard_Entity;
 943       Decl := New_Node (N_Full_Type_Declaration, Stloc);
 944       Set_Defining_Identifier (Decl, Standard_Integer_16);
 945       Make_Name (Standard_Integer_16, "integer_16");
 946       Set_Scope (Standard_Integer_16, Standard_Standard);
 947       Build_Signed_Integer_Type (Standard_Integer_16, 16);
 948
 949       Standard_Integer_32 := New_Standard_Entity;
 950       Decl := New_Node (N_Full_Type_Declaration, Stloc);
 951       Set_Defining_Identifier (Decl, Standard_Integer_32);
 952       Make_Name (Standard_Integer_32, "integer_32");
 953       Set_Scope (Standard_Integer_32, Standard_Standard);
 954       Build_Signed_Integer_Type (Standard_Integer_32, 32);
 955
 956       Standard_Integer_64 := New_Standard_Entity;
 957       Decl := New_Node (N_Full_Type_Declaration, Stloc);
 958       Set_Defining_Identifier (Decl, Standard_Integer_64);
 959       Make_Name (Standard_Integer_64, "integer_64");
 960       Set_Scope (Standard_Integer_64, Standard_Standard);
 961       Build_Signed_Integer_Type (Standard_Integer_64, 64);
 962
 963       Standard_Unsigned := New_Standard_Entity;
 964       Decl := New_Node (N_Full_Type_Declaration, Stloc);
 965       Set_Defining_Identifier (Decl, Standard_Unsigned);
 966       Make_Name (Standard_Unsigned, "unsigned");
 967
 968       Set_Ekind             (Standard_Unsigned, E_Modular_Integer_Type);
 969       Set_Scope             (Standard_Unsigned, Standard_Standard);
 970       Set_Etype             (Standard_Unsigned, Standard_Unsigned);
 971       Init_Size             (Standard_Unsigned, Standard_Integer_Size);
 972       Set_Prim_Alignment    (Standard_Unsigned);
 973       Set_Modulus           (Standard_Unsigned,
 974                               Uint_2 ** Standard_Integer_Size);
 975       Set_Is_Unsigned_Type  (Standard_Unsigned);
 976       Set_Size_Known_At_Compile_Time
 977                             (Standard_Unsigned);
 978
 979       R_Node := New_Node (N_Range, Stloc);
 980       Set_Low_Bound  (R_Node, Make_Integer (Uint_0));
 981       Set_High_Bound (R_Node, Make_Integer (Modulus (Standard_Unsigned) - 1));
 982       Set_Etype (Low_Bound (R_Node), Standard_Unsigned);
 983       Set_Etype (High_Bound (R_Node), Standard_Unsigned);
 984       Set_Scalar_Range (Standard_Unsigned, R_Node);
 985
 986       --  Note: universal integer and universal real are constructed as fully
 987       --  formed signed numeric types, with parameters corresponding to the
 988       --  longest runtime types (Long_Long_Integer and Long_Long_Float). This
 989       --  allows Gigi to properly process references to universal types that
 990       --  are not folded at compile time.
 991
 992       Universal_Integer := New_Standard_Entity;
 993       Decl := New_Node (N_Full_Type_Declaration, Stloc);
 994       Set_Defining_Identifier (Decl, Universal_Integer);
 995       Make_Name (Universal_Integer, "universal_integer");
 996       Set_Scope (Universal_Integer, Standard_Standard);
 997       Build_Signed_Integer_Type
 998         (Universal_Integer, Standard_Long_Long_Integer_Size);
 999
1000       Universal_Real := New_Standard_Entity;
1001       Decl := New_Node (N_Full_Type_Declaration, Stloc);
1002       Set_Defining_Identifier (Decl, Universal_Real);
1003       Make_Name (Universal_Real, "universal_real");
1004       Set_Scope (Universal_Real, Standard_Standard);
1005       Build_Float_Type
1006         (Universal_Real,
1007          Standard_Long_Long_Float_Size,
1008          Standard_Long_Long_Float_Digits);
1009
1010       --  Note: universal fixed, unlike universal integer and universal real,
1011       --  is never used at runtime, so it does not need to have bounds set.
1012
1013       Universal_Fixed := New_Standard_Entity;
1014       Decl := New_Node (N_Full_Type_Declaration, Stloc);
1015       Set_Defining_Identifier (Decl, Universal_Fixed);
1016       Make_Name            (Universal_Fixed, "universal_fixed");
1017       Set_Ekind            (Universal_Fixed, E_Ordinary_Fixed_Point_Type);
1018       Set_Etype            (Universal_Fixed, Universal_Fixed);
1019       Set_Scope            (Universal_Fixed, Standard_Standard);
1020       Init_Size            (Universal_Fixed, Standard_Long_Long_Integer_Size);
1021       Set_Prim_Alignment   (Universal_Fixed);
1022       Set_Size_Known_At_Compile_Time
1023                            (Universal_Fixed);
1024
1025       --  Create type declaration for Duration, using a 64-bit size. The
1026       --  delta and size values depend on the mode set in system.ads.
1027
1028       Build_Duration : declare
1029          Dlo       : Uint;
1030          Dhi       : Uint;
1031          Delta_Val : Ureal;
1032
1033       begin
1034          --  In 32 bit mode, the size is 32 bits, and the delta and
1035          --  small values are set to 20 milliseconds (20.0**(10.0**(-3)).
1036
1037          if Duration_32_Bits_On_Target then
1038             Dlo := Intval (Type_Low_Bound (Standard_Integer_32));
1039             Dhi := Intval (Type_High_Bound (Standard_Integer_32));
1040             Delta_Val := UR_From_Components (UI_From_Int (20), Uint_3, 10);
1041
1042          --  In standard 64-bit mode, the size is 64-bits and the delta and
1043          --  amll values are set to nanoseconds (1.0**(10.0**(-9))
1044
1045          else
1046             Dlo := Intval (Type_Low_Bound (Standard_Integer_64));
1047             Dhi := Intval (Type_High_Bound (Standard_Integer_64));
1048             Delta_Val := UR_From_Components (Uint_1, Uint_9, 10);
1049          end if;
1050
1051          Tdef_Node := Make_Ordinary_Fixed_Point_Definition (Stloc,
1052                  Delta_Expression => Make_Real_Literal (Stloc, Delta_Val),
1053                  Real_Range_Specification =>
1054                    Make_Real_Range_Specification (Stloc,
1055                      Low_Bound  => Make_Real_Literal (Stloc,
1056                        Realval => Dlo * Delta_Val),
1057                      High_Bound => Make_Real_Literal (Stloc,
1058                        Realval => Dhi * Delta_Val)));
1059
1060          Set_Type_Definition (Parent (Standard_Duration), Tdef_Node);
1061
1062          Set_Ekind (Standard_Duration, E_Ordinary_Fixed_Point_Type);
1063          Set_Etype (Standard_Duration, Standard_Duration);
1064
1065          if Duration_32_Bits_On_Target then
1066             Init_Size (Standard_Duration, 32);
1067          else
1068             Init_Size (Standard_Duration, 64);
1069          end if;
1070
1071          Set_Prim_Alignment (Standard_Duration);
1072          Set_Delta_Value    (Standard_Duration, Delta_Val);
1073          Set_Small_Value    (Standard_Duration, Delta_Val);
1074          Set_Scalar_Range   (Standard_Duration,
1075                               Real_Range_Specification
1076                                (Type_Definition (Parent (Standard_Duration))));
1077
1078          --  Normally it does not matter that nodes in package Standard are
1079          --  not marked as analyzed. The Scalar_Range of the fixed-point
1080          --  type Standard_Duration is an exception, because of the special
1081          --  test made in Freeze.Freeze_Fixed_Point_Type.
1082
1083          Set_Analyzed (Scalar_Range (Standard_Duration));
1084
1085          Set_Etype (Type_High_Bound (Standard_Duration), Standard_Duration);
1086          Set_Etype (Type_Low_Bound  (Standard_Duration), Standard_Duration);
1087
1088          Set_Is_Static_Expression (Type_High_Bound (Standard_Duration));
1089          Set_Is_Static_Expression (Type_Low_Bound  (Standard_Duration));
1090
1091          Set_Corresponding_Integer_Value
1092            (Type_High_Bound (Standard_Duration), Dhi);
1093
1094          Set_Corresponding_Integer_Value
1095            (Type_Low_Bound  (Standard_Duration), Dlo);
1096
1097          Set_Size_Known_At_Compile_Time (Standard_Duration);
1098       end Build_Duration;
1099
1100       --  Build standard exception type. Note that the type name here is
1101       --  actually used in the generated code, so it must be set correctly
1102
1103       --  ??? Also note that the Import_Code component is now declared
1104       --  as a System.Standard_Library.Exception_Code to enforce run-time
1105       --  library implementation consistency. It's too early here to resort
1106       --  to rtsfind to get the proper node for that type, so we use the
1107       --  closest possible available type node at hand instead. We should
1108       --  probably be fixing this up at some point.
1109
1110       Standard_Exception_Type := New_Standard_Entity;
1111       Set_Ekind       (Standard_Exception_Type, E_Record_Type);
1112       Set_Etype       (Standard_Exception_Type, Standard_Exception_Type);
1113       Set_Scope       (Standard_Exception_Type, Standard_Standard);
1114       Set_Stored_Constraint
1115                       (Standard_Exception_Type, No_Elist);
1116       Init_Size_Align (Standard_Exception_Type);
1117       Set_Size_Known_At_Compile_Time
1118                       (Standard_Exception_Type, True);
1119       Make_Name       (Standard_Exception_Type, "exception");
1120
1121       Make_Component  (Standard_Exception_Type, Standard_Boolean,
1122                                                  "Not_Handled_By_Others");
1123       Make_Component  (Standard_Exception_Type, Standard_Character, "Lang");
1124       Make_Component  (Standard_Exception_Type, Standard_Natural,
1125                                                            "Name_Length");
1126       Make_Component  (Standard_Exception_Type, Standard_A_Char,
1127                                                              "Full_Name");
1128       Make_Component  (Standard_Exception_Type, Standard_A_Char,
1129                                                             "HTable_Ptr");
1130       Make_Component  (Standard_Exception_Type, Standard_Unsigned,
1131                                                           "Import_Code");
1132       Make_Component  (Standard_Exception_Type, Standard_A_Char,
1133                                                             "Raise_Hook");
1134       --  Build tree for record declaration, for use by the back-end.
1135
1136       declare
1137          Comp_List : List_Id;
1138          Comp      : Entity_Id;
1139
1140       begin
1141          Comp      := First_Entity (Standard_Exception_Type);
1142          Comp_List := New_List;
1143
1144          while Present (Comp) loop
1145             Append (
1146               Make_Component_Declaration (Stloc,
1147                 Defining_Identifier => Comp,
1148                 Component_Definition =>
1149                   Make_Component_Definition (Stloc,
1150                     Aliased_Present    => False,
1151                     Subtype_Indication => New_Occurrence_Of (Etype (Comp),
1152                                                              Stloc))),
1153               Comp_List);
1154
1155             Next_Entity (Comp);
1156          end loop;
1157
1158          Decl := Make_Full_Type_Declaration (Stloc,
1159            Defining_Identifier => Standard_Exception_Type,
1160            Type_Definition =>
1161              Make_Record_Definition (Stloc,
1162                End_Label => Empty,
1163                Component_List =>
1164                  Make_Component_List (Stloc,
1165                    Component_Items => Comp_List)));
1166       end;
1167
1168       Append (Decl, Decl_S);
1169
1170       Layout_Type (Standard_Exception_Type);
1171
1172       --  Create declarations of standard exceptions
1173
1174       Build_Exception (S_Constraint_Error);
1175       Build_Exception (S_Program_Error);
1176       Build_Exception (S_Storage_Error);
1177       Build_Exception (S_Tasking_Error);
1178
1179       --  Numeric_Error is a normal exception in Ada 83, but in Ada 95
1180       --  it is a renaming of Constraint_Error
1181
1182       if Ada_83 then
1183          Build_Exception (S_Numeric_Error);
1184
1185       else
1186          Decl := New_Node (N_Exception_Renaming_Declaration, Stloc);
1187          E_Id := Standard_Entity (S_Numeric_Error);
1188
1189          Set_Ekind          (E_Id, E_Exception);
1190          Set_Exception_Code (E_Id, Uint_0);
1191          Set_Etype          (E_Id, Standard_Exception_Type);
1192          Set_Is_Public      (E_Id);
1193          Set_Renamed_Entity (E_Id, Standard_Entity (S_Constraint_Error));
1194
1195          Set_Defining_Identifier (Decl, E_Id);
1196          Append (Decl, Decl_S);
1197
1198          Ident_Node := New_Node (N_Identifier, Stloc);
1199          Set_Chars  (Ident_Node, Chars (Standard_Entity (S_Constraint_Error)));
1200          Set_Entity (Ident_Node, Standard_Entity (S_Constraint_Error));
1201          Set_Name   (Decl, Ident_Node);
1202       end if;
1203
1204       --  Abort_Signal is an entity that does not get made visible
1205
1206       Abort_Signal := New_Standard_Entity;
1207       Set_Chars          (Abort_Signal, Name_uAbort_Signal);
1208       Set_Ekind          (Abort_Signal, E_Exception);
1209       Set_Exception_Code (Abort_Signal, Uint_0);
1210       Set_Etype          (Abort_Signal, Standard_Exception_Type);
1211       Set_Scope          (Abort_Signal, Standard_Standard);
1212       Set_Is_Public      (Abort_Signal, True);
1213       Decl :=
1214         Make_Exception_Declaration (Stloc,
1215           Defining_Identifier => Abort_Signal);
1216
1217       --  Create defining identifiers for shift operator entities. Note
1218       --  that these entities are used only for marking shift operators
1219       --  generated internally, and hence need no structure, just a name
1220       --  and a unique identity.
1221
1222       Standard_Op_Rotate_Left := New_Standard_Entity;
1223       Set_Chars (Standard_Op_Rotate_Left, Name_Rotate_Left);
1224       Set_Ekind (Standard_Op_Rotate_Left, E_Operator);
1225
1226       Standard_Op_Rotate_Right := New_Standard_Entity;
1227       Set_Chars (Standard_Op_Rotate_Right, Name_Rotate_Right);
1228       Set_Ekind (Standard_Op_Rotate_Right, E_Operator);
1229
1230       Standard_Op_Shift_Left := New_Standard_Entity;
1231       Set_Chars (Standard_Op_Shift_Left, Name_Shift_Left);
1232       Set_Ekind (Standard_Op_Shift_Left, E_Operator);
1233
1234       Standard_Op_Shift_Right := New_Standard_Entity;
1235       Set_Chars (Standard_Op_Shift_Right, Name_Shift_Right);
1236       Set_Ekind (Standard_Op_Shift_Right, E_Operator);
1237
1238       Standard_Op_Shift_Right_Arithmetic := New_Standard_Entity;
1239       Set_Chars (Standard_Op_Shift_Right_Arithmetic,
1240                                           Name_Shift_Right_Arithmetic);
1241       Set_Ekind (Standard_Op_Shift_Right_Arithmetic,
1242                                           E_Operator);
1243
1244       --  Create standard operator declarations
1245
1246       Create_Operators;
1247
1248       --  Initialize visibility table with entities in Standard
1249
1250       for E in Standard_Entity_Type loop
1251          if Ekind (Standard_Entity (E)) /= E_Operator then
1252             Set_Name_Entity_Id
1253               (Chars (Standard_Entity (E)), Standard_Entity (E));
1254             Set_Homonym (Standard_Entity (E), Empty);
1255          end if;
1256
1257          if E not in S_ASCII_Names then
1258             Set_Scope (Standard_Entity (E), Standard_Standard);
1259             Set_Is_Immediately_Visible (Standard_Entity (E));
1260          end if;
1261       end loop;
1262
1263       --  The predefined package Standard itself does not have a scope;
1264       --  it is the only entity in the system not to have one, and this
1265       --  is what identifies the package to Gigi.
1266
1267       Set_Scope (Standard_Standard, Empty);
1268
1269       --  Set global variables indicating last Id values and version
1270
1271       Last_Standard_Node_Id := Last_Node_Id;
1272       Last_Standard_List_Id := Last_List_Id;
1273
1274       --  The Error node has an Etype of Any_Type to help error recovery
1275
1276       Set_Etype (Error, Any_Type);
1277
1278       --  Print representation of standard if switch set
1279
1280       if Opt.Print_Standard then
1281          Print_Standard;
1282       end if;
1283    end Create_Standard;
1284
1285    ------------------------------------
1286    -- Create_Unconstrained_Base_Type --
1287    ------------------------------------
1288
1289    procedure Create_Unconstrained_Base_Type
1290      (E : Entity_Id;
1291       K : Entity_Kind)
1292    is
1293       New_Ent : constant Entity_Id := New_Copy (E);
1294
1295    begin
1296       Set_Ekind            (E, K);
1297       Set_Is_Constrained   (E, True);
1298       Set_Is_First_Subtype (E, True);
1299       Set_Etype            (E, New_Ent);
1300
1301       Append_Entity (New_Ent, Standard_Standard);
1302       Set_Is_Constrained (New_Ent, False);
1303       Set_Etype          (New_Ent, New_Ent);
1304       Set_Is_Known_Valid (New_Ent, True);
1305
1306       if K = E_Signed_Integer_Subtype then
1307          Set_Etype (Low_Bound  (Scalar_Range (E)), New_Ent);
1308          Set_Etype (High_Bound (Scalar_Range (E)), New_Ent);
1309       end if;
1310
1311    end Create_Unconstrained_Base_Type;
1312
1313    --------------------
1314    -- Identifier_For --
1315    --------------------
1316
1317    function Identifier_For (S : Standard_Entity_Type) return Node_Id is
1318       Ident_Node : Node_Id;
1319
1320    begin
1321       Ident_Node := New_Node (N_Identifier, Stloc);
1322       Set_Chars (Ident_Node, Chars (Standard_Entity (S)));
1323       return Ident_Node;
1324    end Identifier_For;
1325
1326    --------------------
1327    -- Make_Component --
1328    --------------------
1329
1330    procedure Make_Component
1331      (Rec : Entity_Id;
1332       Typ : Entity_Id;
1333       Nam : String)
1334    is
1335       Id : constant Entity_Id := New_Standard_Entity;
1336
1337    begin
1338       Set_Ekind                 (Id, E_Component);
1339       Set_Etype                 (Id, Typ);
1340       Set_Scope                 (Id, Rec);
1341       Init_Component_Location   (Id);
1342
1343       Set_Original_Record_Component (Id, Id);
1344       Make_Name (Id, Nam);
1345       Append_Entity (Id, Rec);
1346    end Make_Component;
1347
1348    -----------------
1349    -- Make_Formal --
1350    -----------------
1351
1352    function Make_Formal
1353      (Typ         : Entity_Id;
1354       Formal_Name : String) return Entity_Id
1355    is
1356       Formal : Entity_Id;
1357
1358    begin
1359       Formal := New_Standard_Entity;
1360
1361       Set_Ekind     (Formal, E_In_Parameter);
1362       Set_Mechanism (Formal, Default_Mechanism);
1363       Set_Scope     (Formal, Standard_Standard);
1364       Set_Etype     (Formal, Typ);
1365       Make_Name     (Formal, Formal_Name);
1366
1367       return Formal;
1368    end Make_Formal;
1369
1370    ------------------
1371    -- Make_Integer --
1372    ------------------
1373
1374    function Make_Integer (V : Uint) return Node_Id is
1375       N : constant Node_Id := Make_Integer_Literal (Stloc, V);
1376    begin
1377       Set_Is_Static_Expression (N);
1378       return N;
1379    end Make_Integer;
1380
1381    ---------------
1382    -- Make_Name --
1383    ---------------
1384
1385    procedure Make_Name (Id : Entity_Id; Nam : String) is
1386    begin
1387       for J in 1 .. Nam'Length loop
1388          Name_Buffer (J) := Fold_Lower (Nam (Nam'First + (J - 1)));
1389       end loop;
1390
1391       Name_Len := Nam'Length;
1392       Set_Chars (Id, Name_Find);
1393    end Make_Name;
1394
1395    ------------------
1396    -- New_Operator --
1397    ------------------
1398
1399    function New_Operator (Op : Name_Id; Typ : Entity_Id) return Entity_Id is
1400       Ident_Node : Entity_Id;
1401
1402    begin
1403       Ident_Node := Make_Defining_Identifier (Stloc, Op);
1404
1405       Set_Is_Pure    (Ident_Node, True);
1406       Set_Ekind      (Ident_Node, E_Operator);
1407       Set_Etype      (Ident_Node, Typ);
1408       Set_Scope      (Ident_Node, Standard_Standard);
1409       Set_Homonym    (Ident_Node, Get_Name_Entity_Id (Op));
1410       Set_Convention (Ident_Node, Convention_Intrinsic);
1411
1412       Set_Is_Immediately_Visible   (Ident_Node, True);
1413       Set_Is_Intrinsic_Subprogram  (Ident_Node, True);
1414
1415       Set_Name_Entity_Id (Op, Ident_Node);
1416       Append_Entity (Ident_Node, Standard_Standard);
1417       return Ident_Node;
1418    end New_Operator;
1419
1420    -------------------------
1421    -- New_Standard_Entity --
1422    -------------------------
1423
1424    function New_Standard_Entity
1425      (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id
1426    is
1427       E : constant Entity_Id := New_Entity (New_Node_Kind, Stloc);
1428
1429    begin
1430       --  All standard entities are Pure and Public
1431
1432       Set_Is_Pure (E);
1433       Set_Is_Public (E);
1434
1435       --  All standard entity names are analyzed manually, and are thus
1436       --  frozen as soon as they are created.
1437
1438       Set_Is_Frozen (E);
1439
1440       --  Set debug information required for all standard types
1441
1442       Set_Needs_Debug_Info (E);
1443
1444       --  All standard entities are built with fully qualified names, so
1445       --  set the flag to prevent an abortive attempt at requalification!
1446
1447       Set_Has_Qualified_Name (E);
1448
1449       --  Return newly created entity to be completed by caller
1450
1451       return E;
1452    end New_Standard_Entity;
1453
1454    --------------------
1455    -- Print_Standard --
1456    --------------------
1457
1458    procedure Print_Standard is
1459
1460       procedure P (Item : String) renames Output.Write_Line;
1461       --  Short-hand, since we do a lot of line writes here!
1462
1463       procedure P_Int_Range (Size : Pos);
1464       --  Prints the range of an integer based on its Size
1465
1466       procedure P_Float_Range (Id : Entity_Id);
1467       --  Prints the bounds range for the given float type entity
1468
1469       -------------------
1470       -- P_Float_Range --
1471       -------------------
1472
1473       procedure P_Float_Range (Id : Entity_Id) is
1474          Digs : constant Nat := UI_To_Int (Digits_Value (Id));
1475
1476       begin
1477          Write_Str ("     range ");
1478
1479          if Vax_Float (Id) then
1480             if Digs = VAXFF_Digits then
1481                Write_Str (VAXFF_First'Universal_Literal_String);
1482                Write_Str (" .. ");
1483                Write_Str (VAXFF_Last'Universal_Literal_String);
1484
1485             elsif Digs = VAXDF_Digits then
1486                Write_Str (VAXDF_First'Universal_Literal_String);
1487                Write_Str (" .. ");
1488                Write_Str (VAXDF_Last'Universal_Literal_String);
1489
1490             else
1491                pragma Assert (Digs = VAXGF_Digits);
1492
1493                Write_Str (VAXGF_First'Universal_Literal_String);
1494                Write_Str (" .. ");
1495                Write_Str (VAXGF_Last'Universal_Literal_String);
1496             end if;
1497
1498          elsif Is_AAMP_Float (Id) then
1499             if Digs = AAMPS_Digits then
1500                Write_Str (AAMPS_First'Universal_Literal_String);
1501                Write_Str (" .. ");
1502                Write_Str (AAMPS_Last'Universal_Literal_String);
1503
1504             else
1505                pragma Assert (Digs = AAMPL_Digits);
1506                Write_Str (AAMPL_First'Universal_Literal_String);
1507                Write_Str (" .. ");
1508                Write_Str (AAMPL_Last'Universal_Literal_String);
1509             end if;
1510
1511          elsif Digs = IEEES_Digits then
1512             Write_Str (IEEES_First'Universal_Literal_String);
1513             Write_Str (" .. ");
1514             Write_Str (IEEES_Last'Universal_Literal_String);
1515
1516          elsif Digs = IEEEL_Digits then
1517             Write_Str (IEEEL_First'Universal_Literal_String);
1518             Write_Str (" .. ");
1519             Write_Str (IEEEL_Last'Universal_Literal_String);
1520
1521          else
1522             pragma Assert (Digs = IEEEX_Digits);
1523
1524             Write_Str (IEEEX_First'Universal_Literal_String);
1525             Write_Str (" .. ");
1526             Write_Str (IEEEX_Last'Universal_Literal_String);
1527          end if;
1528
1529          Write_Str (";");
1530          Write_Eol;
1531       end P_Float_Range;
1532
1533       -----------------
1534       -- P_Int_Range --
1535       -----------------
1536
1537       procedure P_Int_Range (Size : Pos) is
1538       begin
1539          Write_Str (" is range -(2 **");
1540          Write_Int (Size - 1);
1541          Write_Str (")");
1542          Write_Str (" .. +(2 **");
1543          Write_Int (Size - 1);
1544          Write_Str (" - 1);");
1545          Write_Eol;
1546       end P_Int_Range;
1547
1548    --  Start of processing for Print_Standard
1549
1550    begin
1551       P ("--  Representation of package Standard");
1552       Write_Eol;
1553       P ("--  This is not accurate Ada, since new base types cannot be ");
1554       P ("--  created, but the listing shows the target dependent");
1555       P ("--  characteristics of the Standard types for this compiler");
1556       Write_Eol;
1557
1558       P ("package Standard is");
1559       P ("pragma Pure(Standard);");
1560       Write_Eol;
1561
1562       P ("   type Boolean is (False, True);");
1563       P ("   for Boolean'Size use 1;");
1564       P ("   for Boolean use (False => 0, True => 1);");
1565       Write_Eol;
1566
1567       --  Integer types
1568
1569       Write_Str ("   type Integer");
1570       P_Int_Range (Standard_Integer_Size);
1571       Write_Str ("   for Integer'Size use ");
1572       Write_Int (Standard_Integer_Size);
1573       P (";");
1574       Write_Eol;
1575
1576       P ("   subtype Natural  is Integer range 0 .. Integer'Last;");
1577       P ("   subtype Positive is Integer range 1 .. Integer'Last;");
1578       Write_Eol;
1579
1580       Write_Str ("   type Short_Short_Integer");
1581       P_Int_Range (Standard_Short_Short_Integer_Size);
1582       Write_Str ("   for Short_Short_Integer'Size use ");
1583       Write_Int (Standard_Short_Short_Integer_Size);
1584       P (";");
1585       Write_Eol;
1586
1587       Write_Str ("   type Short_Integer");
1588       P_Int_Range (Standard_Short_Integer_Size);
1589       Write_Str ("   for Short_Integer'Size use ");
1590       Write_Int (Standard_Short_Integer_Size);
1591       P (";");
1592       Write_Eol;
1593
1594       Write_Str ("   type Long_Integer");
1595       P_Int_Range (Standard_Long_Integer_Size);
1596       Write_Str ("   for Long_Integer'Size use ");
1597       Write_Int (Standard_Long_Integer_Size);
1598       P (";");
1599       Write_Eol;
1600
1601       Write_Str ("   type Long_Long_Integer");
1602       P_Int_Range (Standard_Long_Long_Integer_Size);
1603       Write_Str ("   for Long_Long_Integer'Size use ");
1604       Write_Int (Standard_Long_Long_Integer_Size);
1605       P (";");
1606       Write_Eol;
1607
1608       --  Floating point types
1609
1610       Write_Str ("   type Short_Float is digits ");
1611       Write_Int (Standard_Short_Float_Digits);
1612       Write_Eol;
1613       P_Float_Range (Standard_Short_Float);
1614       Write_Str ("   for Short_Float'Size use ");
1615       Write_Int (Standard_Short_Float_Size);
1616       P (";");
1617       Write_Eol;
1618
1619       Write_Str ("   type Float is digits ");
1620       Write_Int (Standard_Float_Digits);
1621       Write_Eol;
1622       P_Float_Range (Standard_Float);
1623       Write_Str ("   for Float'Size use ");
1624       Write_Int (Standard_Float_Size);
1625       P (";");
1626       Write_Eol;
1627
1628       Write_Str ("   type Long_Float is digits ");
1629       Write_Int (Standard_Long_Float_Digits);
1630       Write_Eol;
1631       P_Float_Range (Standard_Long_Float);
1632       Write_Str ("   for Long_Float'Size use ");
1633       Write_Int (Standard_Long_Float_Size);
1634       P (";");
1635       Write_Eol;
1636
1637       Write_Str ("   type Long_Long_Float is digits ");
1638       Write_Int (Standard_Long_Long_Float_Digits);
1639       Write_Eol;
1640       P_Float_Range (Standard_Long_Long_Float);
1641       Write_Str ("   for Long_Long_Float'Size use ");
1642       Write_Int (Standard_Long_Long_Float_Size);
1643       P (";");
1644       Write_Eol;
1645
1646       P ("   type Character is (...)");
1647       Write_Str ("   for Character'Size use ");
1648       Write_Int (Standard_Character_Size);
1649       P (";");
1650       P ("   --  See RM A.1(35) for details of this type");
1651       Write_Eol;
1652
1653       P ("   type Wide_Character is (...)");
1654       Write_Str ("   for Wide_Character'Size use ");
1655       Write_Int (Standard_Wide_Character_Size);
1656       P (";");
1657       P ("   --  See RM A.1(36) for details of this type");
1658       Write_Eol;
1659
1660       P ("   type String is array (Positive range <>) of Character;");
1661       P ("   pragma Pack (String);");
1662       Write_Eol;
1663
1664       P ("   type Wide_String is array (Positive range <>)" &
1665          " of Wide_Character;");
1666       P ("   pragma Pack (Wide_String);");
1667       Write_Eol;
1668
1669       --  Here it's OK to use the Duration type of the host compiler since
1670       --  the implementation of Duration in GNAT is target independent.
1671
1672       if Duration_32_Bits_On_Target then
1673          P ("   type Duration is delta 0.020");
1674          P ("     range -((2 ** 31 - 1) * 0.020) ..");
1675          P ("           +((2 ** 31 - 1) * 0.020);");
1676          P ("   for Duration'Small use 0.020;");
1677       else
1678          P ("   type Duration is delta 0.000000001");
1679          P ("     range -((2 ** 63 - 1) * 0.000000001) ..");
1680          P ("           +((2 ** 63 - 1) * 0.000000001);");
1681          P ("   for Duration'Small use 0.000000001;");
1682       end if;
1683
1684       Write_Eol;
1685
1686       P ("   Constraint_Error : exception;");
1687       P ("   Program_Error    : exception;");
1688       P ("   Storage_Error    : exception;");
1689       P ("   Tasking_Error    : exception;");
1690       P ("   Numeric_Error    : exception renames Constraint_Error;");
1691       Write_Eol;
1692
1693       P ("end Standard;");
1694    end Print_Standard;
1695
1696    ----------------------
1697    -- Set_Float_Bounds --
1698    ----------------------
1699
1700    procedure Set_Float_Bounds (Id  : Entity_Id) is
1701       L  : Node_Id;
1702       --  Low bound of literal value
1703
1704       H  : Node_Id;
1705       --  High bound of literal value
1706
1707       R  : Node_Id;
1708       --  Range specification
1709
1710       Digs  : constant Nat := UI_To_Int (Digits_Value (Id));
1711       --  Digits value, used to select bounds
1712
1713    begin
1714       --  Note: for the call from Cstand to initially create the types in
1715       --  Standard, Vax_Float will always be False. Circuitry in Sem_Vfpt
1716       --  will adjust these types appropriately in the Vax_Float case if
1717       --  a pragma Float_Representation (VAX_Float) is used.
1718
1719       if Vax_Float (Id) then
1720          if Digs = VAXFF_Digits then
1721             L := Real_Convert
1722                    (VAXFF_First'Universal_Literal_String);
1723             H := Real_Convert
1724                    (VAXFF_Last'Universal_Literal_String);
1725
1726          elsif Digs = VAXDF_Digits then
1727             L := Real_Convert
1728                    (VAXDF_First'Universal_Literal_String);
1729             H := Real_Convert
1730                    (VAXDF_Last'Universal_Literal_String);
1731
1732          else
1733             pragma Assert (Digs = VAXGF_Digits);
1734
1735             L := Real_Convert
1736                    (VAXGF_First'Universal_Literal_String);
1737             H := Real_Convert
1738                    (VAXGF_Last'Universal_Literal_String);
1739          end if;
1740
1741       elsif Is_AAMP_Float (Id) then
1742          if Digs = AAMPS_Digits then
1743             L := Real_Convert
1744                    (AAMPS_First'Universal_Literal_String);
1745             H := Real_Convert
1746                    (AAMPS_Last'Universal_Literal_String);
1747
1748          else
1749             pragma Assert (Digs = AAMPL_Digits);
1750             L := Real_Convert
1751                    (AAMPL_First'Universal_Literal_String);
1752             H := Real_Convert
1753                    (AAMPL_Last'Universal_Literal_String);
1754          end if;
1755
1756       elsif Digs = IEEES_Digits then
1757          L := Real_Convert
1758                 (IEEES_First'Universal_Literal_String);
1759          H := Real_Convert
1760                 (IEEES_Last'Universal_Literal_String);
1761
1762       elsif Digs = IEEEL_Digits then
1763          L := Real_Convert
1764                 (IEEEL_First'Universal_Literal_String);
1765          H := Real_Convert
1766                 (IEEEL_Last'Universal_Literal_String);
1767
1768       else
1769          pragma Assert (Digs = IEEEX_Digits);
1770
1771          L := Real_Convert
1772                 (IEEEX_First'Universal_Literal_String);
1773          H := Real_Convert
1774                 (IEEEX_Last'Universal_Literal_String);
1775       end if;
1776
1777       Set_Etype                (L, Id);
1778       Set_Is_Static_Expression (L);
1779
1780       Set_Etype                (H, Id);
1781       Set_Is_Static_Expression (H);
1782
1783       R := New_Node (N_Range, Stloc);
1784       Set_Low_Bound  (R, L);
1785       Set_High_Bound (R, H);
1786       Set_Includes_Infinities (R, True);
1787       Set_Scalar_Range (Id, R);
1788       Set_Etype (R, Id);
1789       Set_Parent (R, Id);
1790    end Set_Float_Bounds;
1791
1792    ------------------------
1793    -- Set_Integer_Bounds --
1794    ------------------------
1795
1796    procedure Set_Integer_Bounds
1797      (Id  : Entity_Id;
1798       Typ : Entity_Id;
1799       Lb  : Uint;
1800       Hb  : Uint)
1801    is
1802       L : Node_Id;     -- Low bound of literal value
1803       H : Node_Id;     -- High bound of literal value
1804       R : Node_Id;     -- Range specification
1805
1806    begin
1807       L := Make_Integer (Lb);
1808       H := Make_Integer (Hb);
1809
1810       Set_Etype (L, Typ);
1811       Set_Etype (H, Typ);
1812
1813       R := New_Node (N_Range, Stloc);
1814       Set_Low_Bound  (R, L);
1815       Set_High_Bound (R, H);
1816       Set_Scalar_Range (Id, R);
1817       Set_Etype (R, Typ);
1818       Set_Parent (R, Id);
1819       Set_Is_Unsigned_Type (Id, Lb >= 0);
1820    end Set_Integer_Bounds;
1821
1822 end CStand;