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