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