OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [cstand.adb] - Blame information for rev 859

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.