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