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