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