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