1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Atree
; use Atree
;
28 with Csets
; use Csets
;
29 with Debug
; use Debug
;
30 with Einfo
; use Einfo
;
31 with Layout
; use Layout
;
32 with Namet
; use Namet
;
33 with Nlists
; use Nlists
;
34 with Nmake
; use Nmake
;
36 with Tbuild
; use Tbuild
;
37 with Ttypes
; use Ttypes
;
38 with Ttypef
; use Ttypef
;
39 with Sem_Mech
; use Sem_Mech
;
40 with Sem_Util
; use Sem_Util
;
41 with Sinfo
; use Sinfo
;
42 with Snames
; use Snames
;
43 with Stand
; use Stand
;
44 with Uintp
; use Uintp
;
45 with Urealp
; use Urealp
;
47 package body CStand
is
49 Stloc
: constant Source_Ptr
:= Standard_Location
;
50 Staloc
: constant Source_Ptr
:= Standard_ASCII_Location
;
51 -- Standard abbreviations used throughout this package
53 -----------------------
54 -- Local Subprograms --
55 -----------------------
57 procedure Build_Float_Type
(E
: Entity_Id
; Siz
: Int
; Digs
: Int
);
58 -- Procedure to build standard predefined float base type. The first
59 -- parameter is the entity for the type, and the second parameter
60 -- is the size in bits. The third parameter is the digits value.
62 procedure Build_Signed_Integer_Type
(E
: Entity_Id
; Siz
: Int
);
63 -- Procedure to build standard predefined signed integer subtype. The
64 -- first parameter is the entity for the subtype. The second parameter
65 -- is the size in bits. The corresponding base type is not built by
66 -- this routine but instead must be built by the caller where needed.
68 procedure Create_Operators
;
69 -- Make entries for each of the predefined operators in Standard
71 procedure Create_Unconstrained_Base_Type
74 -- The predefined signed integer types are constrained subtypes which
75 -- must have a corresponding unconstrained base type. This type is almost
76 -- useless. The only place it has semantics is Subtypes_Statically_Match.
77 -- Consequently, we arrange for it to be identical apart from the setting
78 -- of the constrained bit. This routine takes an entity E for the Type,
79 -- copies it to estabish the base type, then resets the Ekind of the
80 -- original entity to K (the Ekind for the subtype). The Etype field of
81 -- E is set by the call (to point to the created base type entity), and
82 -- also the Is_Constrained flag of E is set.
84 -- To understand the exact requirement for this, see RM 3.5.4(11) which
85 -- makes it clear that Integer, for example, is constrained, with the
86 -- constraint bounds matching the bounds of the (unconstrained) base
87 -- type. The point is that Integer and Integer'Base have identical
88 -- bounds, but do not statically match, since a subtype with constraints
89 -- never matches a subtype with no constraints.
91 function Identifier_For
(S
: Standard_Entity_Type
) return Node_Id
;
92 -- Returns an identifier node with the same name as the defining
93 -- identifier corresponding to the given Standard_Entity_Type value
95 procedure Make_Component
99 -- Build a record component with the given type and name, and append to
100 -- the list of components of Rec.
104 Formal_Name
: String)
106 -- Construct entity for subprogram formal with given name and type
108 function Make_Integer
(V
: Uint
) return Node_Id
;
109 -- Builds integer literal with given value
111 procedure Make_Name
(Id
: Entity_Id
; Nam
: String);
112 -- Make an entry in the names table for Nam, and set as Chars field of Id
114 function New_Operator
(Op
: Name_Id
; Typ
: Entity_Id
) return Entity_Id
;
115 -- Build entity for standard operator with given name and type.
117 function New_Standard_Entity
118 (New_Node_Kind
: Node_Kind
:= N_Defining_Identifier
)
120 -- Builds a new entity for Standard
122 procedure Set_Integer_Bounds
127 -- Procedure to set bounds for integer type or subtype. Id is the entity
128 -- whose bounds and type are to be set. The Typ parameter is the Etype
129 -- value for the entity (which will be the same as Id for all predefined
130 -- integer base types. The third and fourth parameters are the bounds.
132 ----------------------
133 -- Build_Float_Type --
134 ----------------------
136 procedure Build_Float_Type
(E
: Entity_Id
; Siz
: Int
; Digs
: Int
) is
138 Set_Type_Definition
(Parent
(E
),
139 Make_Floating_Point_Definition
(Stloc
,
140 Digits_Expression
=> Make_Integer
(UI_From_Int
(Digs
))));
141 Set_Ekind
(E
, E_Floating_Point_Type
);
144 Set_Prim_Alignment
(E
);
145 Init_Digits_Value
(E
, Digs
);
146 Set_Float_Bounds
(E
);
149 Set_Size_Known_At_Compile_Time
(E
);
150 end Build_Float_Type
;
152 -------------------------------
153 -- Build_Signed_Integer_Type --
154 -------------------------------
156 procedure Build_Signed_Integer_Type
(E
: Entity_Id
; Siz
: Int
) is
157 U2Siz1
: constant Uint
:= 2 ** (Siz
- 1);
158 Lbound
: constant Uint
:= -U2Siz1
;
159 Ubound
: constant Uint
:= U2Siz1
- 1;
162 Set_Type_Definition
(Parent
(E
),
163 Make_Signed_Integer_Type_Definition
(Stloc
,
164 Low_Bound
=> Make_Integer
(Lbound
),
165 High_Bound
=> Make_Integer
(Ubound
)));
167 Set_Ekind
(E
, E_Signed_Integer_Type
);
170 Set_Prim_Alignment
(E
);
171 Set_Integer_Bounds
(E
, E
, Lbound
, Ubound
);
174 Set_Is_Known_Valid
(E
);
175 Set_Size_Known_At_Compile_Time
(E
);
176 end Build_Signed_Integer_Type
;
178 ----------------------
179 -- Create_Operators --
180 ----------------------
182 -- Each operator has an abbreviated signature. The formals have the names
183 -- LEFT and RIGHT. Their types are not actually used for resolution.
185 procedure Create_Operators
is
188 -- Following list has two entries for concatenation, to include
189 -- explicitly the operation on wide strings.
191 Binary_Ops
: constant array (S_Binary_Ops
) of Name_Id
:=
192 (Name_Op_Add
, Name_Op_And
, Name_Op_Concat
, Name_Op_Concat
,
193 Name_Op_Divide
, Name_Op_Eq
, Name_Op_Expon
, Name_Op_Ge
,
194 Name_Op_Gt
, Name_Op_Le
, Name_Op_Lt
, Name_Op_Mod
,
195 Name_Op_Multiply
, Name_Op_Ne
, Name_Op_Or
, Name_Op_Rem
,
196 Name_Op_Subtract
, Name_Op_Xor
);
198 Bin_Op_Types
: constant array (S_Binary_Ops
) of Entity_Id
:=
199 (Universal_Integer
, Standard_Boolean
,
200 Standard_String
, Standard_Wide_String
,
201 Universal_Integer
, Standard_Boolean
,
202 Universal_Integer
, Standard_Boolean
,
203 Standard_Boolean
, Standard_Boolean
,
204 Standard_Boolean
, Universal_Integer
,
205 Universal_Integer
, Standard_Boolean
,
206 Standard_Boolean
, Universal_Integer
,
207 Universal_Integer
, Standard_Boolean
);
209 Unary_Ops
: constant array (S_Unary_Ops
) of Name_Id
:=
210 (Name_Op_Abs
, Name_Op_Subtract
, Name_Op_Not
, Name_Op_Add
);
212 Unary_Op_Types
: constant array (S_Unary_Ops
) of Entity_Id
:=
213 (Universal_Integer
, Universal_Integer
,
214 Standard_Boolean
, Universal_Integer
);
216 -- Corresponding to Abs, Minus, Not, and Plus.
219 for J
in S_Binary_Ops
loop
220 Op_Node
:= New_Operator
(Binary_Ops
(J
), Bin_Op_Types
(J
));
222 Append_Entity
(Make_Formal
(Any_Type
, "LEFT"), Op_Node
);
223 Append_Entity
(Make_Formal
(Any_Type
, "RIGHT"), Op_Node
);
226 for J
in S_Unary_Ops
loop
227 Op_Node
:= New_Operator
(Unary_Ops
(J
), Unary_Op_Types
(J
));
229 Append_Entity
(Make_Formal
(Any_Type
, "RIGHT"), Op_Node
);
232 -- For concatenation, we create a separate operator for each
233 -- array type. This simplifies the resolution of the component-
234 -- component concatenation operation. In Standard, we set the types
235 -- of the formals for string and wide string concatenation.
237 Set_Etype
(First_Entity
(Standard_Op_Concat
), Standard_String
);
238 Set_Etype
(Last_Entity
(Standard_Op_Concat
), Standard_String
);
240 Set_Etype
(First_Entity
(Standard_Op_Concatw
), Standard_Wide_String
);
241 Set_Etype
(Last_Entity
(Standard_Op_Concatw
), Standard_Wide_String
);
243 end Create_Operators
;
245 ---------------------
246 -- Create_Standard --
247 ---------------------
249 -- The tree for the package Standard is prefixed to all compilations.
250 -- Several entities required by semantic analysis are denoted by global
251 -- variables that are initialized to point to the corresponding
252 -- occurrences in STANDARD. The visible entities of STANDARD are
253 -- created here. The private entities defined in STANDARD are created
254 -- by Initialize_Standard in the semantics module.
256 procedure Create_Standard
is
258 -- List of declarations in Standard
261 -- List of declarations in ASCII
266 Ident_Node
: Node_Id
;
272 procedure Build_Exception
(S
: Standard_Entity_Type
);
273 -- Procedure to declare given entity as an exception
275 ---------------------
276 -- Build_Exception --
277 ---------------------
279 procedure Build_Exception
(S
: Standard_Entity_Type
) is
281 Set_Ekind
(Standard_Entity
(S
), E_Exception
);
282 Set_Etype
(Standard_Entity
(S
), Standard_Exception_Type
);
283 Set_Exception_Code
(Standard_Entity
(S
), Uint_0
);
284 Set_Is_Public
(Standard_Entity
(S
), True);
287 Make_Exception_Declaration
(Stloc
,
288 Defining_Identifier
=> Standard_Entity
(S
));
289 Append
(Decl
, Decl_S
);
292 -- Start of processing for Create_Standard
297 -- First step is to create defining identifiers for each entity
299 for S
in Standard_Entity_Type
loop
301 S_Name
: constant String := Standard_Entity_Type
'Image (S
);
302 -- Name of entity (note we skip S_ at the start)
304 Ident_Node
: Node_Id
;
305 -- Defining identifier node
308 Ident_Node
:= New_Standard_Entity
;
309 Make_Name
(Ident_Node
, S_Name
(3 .. S_Name
'Length));
310 Standard_Entity
(S
) := Ident_Node
;
314 -- Create package declaration node for package Standard
316 Standard_Package_Node
:= New_Node
(N_Package_Declaration
, Stloc
);
318 Pspec
:= New_Node
(N_Package_Specification
, Stloc
);
319 Set_Specification
(Standard_Package_Node
, Pspec
);
321 Set_Defining_Unit_Name
(Pspec
, Standard_Standard
);
322 Set_Visible_Declarations
(Pspec
, Decl_S
);
324 Set_Ekind
(Standard_Standard
, E_Package
);
325 Set_Is_Pure
(Standard_Standard
);
326 Set_Is_Compilation_Unit
(Standard_Standard
);
328 -- Create type declaration nodes for standard types
330 for S
in S_Types
loop
331 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
332 Set_Defining_Identifier
(Decl
, Standard_Entity
(S
));
333 Set_Is_Frozen
(Standard_Entity
(S
));
334 Set_Is_Public
(Standard_Entity
(S
));
335 Append
(Decl
, Decl_S
);
338 -- Create type definition node for type Boolean. The Size is set to
339 -- 1 as required by Ada 95 and current ARG interpretations for Ada/83.
341 -- Note: Object_Size of Boolean is 8. This means that we do NOT in
342 -- general know that Boolean variables have valid values, so we do
343 -- not set the Is_Known_Valid flag.
345 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
346 Set_Literals
(Tdef_Node
, New_List
);
347 Append
(Standard_False
, Literals
(Tdef_Node
));
348 Append
(Standard_True
, Literals
(Tdef_Node
));
349 Set_Type_Definition
(Parent
(Standard_Boolean
), Tdef_Node
);
351 Set_Ekind
(Standard_Boolean
, E_Enumeration_Type
);
352 Set_First_Literal
(Standard_Boolean
, Standard_False
);
353 Set_Etype
(Standard_Boolean
, Standard_Boolean
);
354 Init_Esize
(Standard_Boolean
, Standard_Character_Size
);
355 Init_RM_Size
(Standard_Boolean
, 1);
356 Set_Prim_Alignment
(Standard_Boolean
);
358 Set_Is_Unsigned_Type
(Standard_Boolean
);
359 Set_Size_Known_At_Compile_Time
(Standard_Boolean
);
361 Set_Ekind
(Standard_True
, E_Enumeration_Literal
);
362 Set_Etype
(Standard_True
, Standard_Boolean
);
363 Set_Enumeration_Pos
(Standard_True
, Uint_1
);
364 Set_Enumeration_Rep
(Standard_True
, Uint_1
);
365 Set_Is_Known_Valid
(Standard_True
, True);
367 Set_Ekind
(Standard_False
, E_Enumeration_Literal
);
368 Set_Etype
(Standard_False
, Standard_Boolean
);
369 Set_Enumeration_Pos
(Standard_False
, Uint_0
);
370 Set_Enumeration_Rep
(Standard_False
, Uint_0
);
371 Set_Is_Known_Valid
(Standard_False
, True);
373 -- For the bounds of Boolean, we create a range node corresponding to
375 -- range False .. True
377 -- where the occurrences of the literals must point to the
378 -- corresponding definition.
380 R_Node
:= New_Node
(N_Range
, Stloc
);
381 B_Node
:= New_Node
(N_Identifier
, Stloc
);
382 Set_Chars
(B_Node
, Chars
(Standard_False
));
383 Set_Entity
(B_Node
, Standard_False
);
384 Set_Etype
(B_Node
, Standard_Boolean
);
385 Set_Is_Static_Expression
(B_Node
);
386 Set_Low_Bound
(R_Node
, B_Node
);
388 B_Node
:= New_Node
(N_Identifier
, Stloc
);
389 Set_Chars
(B_Node
, Chars
(Standard_True
));
390 Set_Entity
(B_Node
, Standard_True
);
391 Set_Etype
(B_Node
, Standard_Boolean
);
392 Set_Is_Static_Expression
(B_Node
);
393 Set_High_Bound
(R_Node
, B_Node
);
395 Set_Scalar_Range
(Standard_Boolean
, R_Node
);
396 Set_Etype
(R_Node
, Standard_Boolean
);
397 Set_Parent
(R_Node
, Standard_Boolean
);
399 -- Create type definition nodes for predefined integer types
401 Build_Signed_Integer_Type
402 (Standard_Short_Short_Integer
, Standard_Short_Short_Integer_Size
);
404 Build_Signed_Integer_Type
405 (Standard_Short_Integer
, Standard_Short_Integer_Size
);
407 Build_Signed_Integer_Type
408 (Standard_Integer
, Standard_Integer_Size
);
417 LIS
:= Standard_Long_Integer_Size
;
420 Build_Signed_Integer_Type
(Standard_Long_Integer
, LIS
);
423 Build_Signed_Integer_Type
424 (Standard_Long_Long_Integer
, Standard_Long_Long_Integer_Size
);
426 Create_Unconstrained_Base_Type
427 (Standard_Short_Short_Integer
, E_Signed_Integer_Subtype
);
429 Create_Unconstrained_Base_Type
430 (Standard_Short_Integer
, E_Signed_Integer_Subtype
);
432 Create_Unconstrained_Base_Type
433 (Standard_Integer
, E_Signed_Integer_Subtype
);
435 Create_Unconstrained_Base_Type
436 (Standard_Long_Integer
, E_Signed_Integer_Subtype
);
438 Create_Unconstrained_Base_Type
439 (Standard_Long_Long_Integer
, E_Signed_Integer_Subtype
);
441 -- Create type definition nodes for predefined float types
444 (Standard_Short_Float
,
445 Standard_Short_Float_Size
,
446 Standard_Short_Float_Digits
);
451 Standard_Float_Digits
);
454 (Standard_Long_Float
,
455 Standard_Long_Float_Size
,
456 Standard_Long_Float_Digits
);
459 (Standard_Long_Long_Float
,
460 Standard_Long_Long_Float_Size
,
461 Standard_Long_Long_Float_Digits
);
463 -- Create type definition node for type Character. Note that we do not
464 -- set the Literals field, since type Character is handled with special
465 -- routine that do not need a literal list.
467 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
468 Set_Type_Definition
(Parent
(Standard_Character
), Tdef_Node
);
470 Set_Ekind
(Standard_Character
, E_Enumeration_Type
);
471 Set_Etype
(Standard_Character
, Standard_Character
);
472 Init_Esize
(Standard_Character
, Standard_Character_Size
);
473 Init_RM_Size
(Standard_Character
, 8);
474 Set_Prim_Alignment
(Standard_Character
);
476 Set_Is_Unsigned_Type
(Standard_Character
);
477 Set_Is_Character_Type
(Standard_Character
);
478 Set_Is_Known_Valid
(Standard_Character
);
479 Set_Size_Known_At_Compile_Time
(Standard_Character
);
481 -- Create the bounds for type Character.
483 R_Node
:= New_Node
(N_Range
, Stloc
);
485 -- Low bound for type Character (Standard.Nul)
487 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
488 Set_Is_Static_Expression
(B_Node
);
489 Set_Chars
(B_Node
, No_Name
);
490 Set_Char_Literal_Value
(B_Node
, 16#
00#
);
491 Set_Entity
(B_Node
, Empty
);
492 Set_Etype
(B_Node
, Standard_Character
);
493 Set_Low_Bound
(R_Node
, B_Node
);
495 -- High bound for type Character
497 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
498 Set_Is_Static_Expression
(B_Node
);
499 Set_Chars
(B_Node
, No_Name
);
500 Set_Char_Literal_Value
(B_Node
, 16#FF#
);
501 Set_Entity
(B_Node
, Empty
);
502 Set_Etype
(B_Node
, Standard_Character
);
503 Set_High_Bound
(R_Node
, B_Node
);
505 Set_Scalar_Range
(Standard_Character
, R_Node
);
506 Set_Etype
(R_Node
, Standard_Character
);
507 Set_Parent
(R_Node
, Standard_Character
);
509 -- Create type definition for type Wide_Character. Note that we do not
510 -- set the Literals field, since type Wide_Character is handled with
511 -- special routines that do not need a literal list.
513 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
514 Set_Type_Definition
(Parent
(Standard_Wide_Character
), Tdef_Node
);
516 Set_Ekind
(Standard_Wide_Character
, E_Enumeration_Type
);
517 Set_Etype
(Standard_Wide_Character
, Standard_Wide_Character
);
518 Init_Size
(Standard_Wide_Character
, Standard_Wide_Character_Size
);
520 Set_Prim_Alignment
(Standard_Wide_Character
);
521 Set_Is_Unsigned_Type
(Standard_Wide_Character
);
522 Set_Is_Character_Type
(Standard_Wide_Character
);
523 Set_Is_Known_Valid
(Standard_Wide_Character
);
524 Set_Size_Known_At_Compile_Time
(Standard_Wide_Character
);
526 -- Create the bounds for type Wide_Character.
528 R_Node
:= New_Node
(N_Range
, Stloc
);
530 -- Low bound for type Wide_Character
532 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
533 Set_Is_Static_Expression
(B_Node
);
534 Set_Chars
(B_Node
, No_Name
); -- ???
535 Set_Char_Literal_Value
(B_Node
, 16#
0000#
);
536 Set_Entity
(B_Node
, Empty
);
537 Set_Etype
(B_Node
, Standard_Wide_Character
);
538 Set_Low_Bound
(R_Node
, B_Node
);
540 -- High bound for type Wide_Character
542 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
543 Set_Is_Static_Expression
(B_Node
);
544 Set_Chars
(B_Node
, No_Name
); -- ???
545 Set_Char_Literal_Value
(B_Node
, 16#FFFF#
);
546 Set_Entity
(B_Node
, Empty
);
547 Set_Etype
(B_Node
, Standard_Wide_Character
);
548 Set_High_Bound
(R_Node
, B_Node
);
550 Set_Scalar_Range
(Standard_Wide_Character
, R_Node
);
551 Set_Etype
(R_Node
, Standard_Wide_Character
);
552 Set_Parent
(R_Node
, Standard_Wide_Character
);
554 -- Create type definition node for type String
556 Tdef_Node
:= New_Node
(N_Unconstrained_Array_Definition
, Stloc
);
557 Set_Subtype_Indication
(Tdef_Node
, Identifier_For
(S_Character
));
558 Set_Subtype_Marks
(Tdef_Node
, New_List
);
559 Append
(Identifier_For
(S_Positive
), Subtype_Marks
(Tdef_Node
));
560 Set_Type_Definition
(Parent
(Standard_String
), Tdef_Node
);
562 Set_Ekind
(Standard_String
, E_String_Type
);
563 Set_Etype
(Standard_String
, Standard_String
);
564 Set_Component_Type
(Standard_String
, Standard_Character
);
565 Set_Component_Size
(Standard_String
, Uint_8
);
566 Init_Size_Align
(Standard_String
);
568 -- Set index type of String
571 (Subtype_Marks
(Type_Definition
(Parent
(Standard_String
))));
572 Set_First_Index
(Standard_String
, E_Id
);
573 Set_Entity
(E_Id
, Standard_Positive
);
574 Set_Etype
(E_Id
, Standard_Positive
);
576 -- Create type definition node for type Wide_String
578 Tdef_Node
:= New_Node
(N_Unconstrained_Array_Definition
, Stloc
);
579 Set_Subtype_Indication
(Tdef_Node
, Identifier_For
(S_Wide_Character
));
580 Set_Subtype_Marks
(Tdef_Node
, New_List
);
581 Append
(Identifier_For
(S_Positive
), Subtype_Marks
(Tdef_Node
));
582 Set_Type_Definition
(Parent
(Standard_Wide_String
), Tdef_Node
);
584 Set_Ekind
(Standard_Wide_String
, E_String_Type
);
585 Set_Etype
(Standard_Wide_String
, Standard_Wide_String
);
586 Set_Component_Type
(Standard_Wide_String
, Standard_Wide_Character
);
587 Set_Component_Size
(Standard_Wide_String
, Uint_16
);
588 Init_Size_Align
(Standard_Wide_String
);
590 -- Set index type of Wide_String
593 (Subtype_Marks
(Type_Definition
(Parent
(Standard_Wide_String
))));
594 Set_First_Index
(Standard_Wide_String
, E_Id
);
595 Set_Entity
(E_Id
, Standard_Positive
);
596 Set_Etype
(E_Id
, Standard_Positive
);
598 -- Create subtype declaration for Natural
600 Decl
:= New_Node
(N_Subtype_Declaration
, Stloc
);
601 Set_Defining_Identifier
(Decl
, Standard_Natural
);
602 Set_Subtype_Indication
(Decl
,
603 New_Occurrence_Of
(Standard_Integer
, Stloc
));
604 Append
(Decl
, Decl_S
);
606 Set_Ekind
(Standard_Natural
, E_Signed_Integer_Subtype
);
607 Set_Etype
(Standard_Natural
, Base_Type
(Standard_Integer
));
608 Init_Esize
(Standard_Natural
, Standard_Integer_Size
);
609 Init_RM_Size
(Standard_Natural
, Standard_Integer_Size
- 1);
610 Set_Prim_Alignment
(Standard_Natural
);
611 Set_Size_Known_At_Compile_Time
613 Set_Integer_Bounds
(Standard_Natural
,
614 Typ
=> Base_Type
(Standard_Integer
),
616 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
617 Set_Is_Constrained
(Standard_Natural
);
618 Set_Is_Frozen
(Standard_Natural
);
619 Set_Is_Public
(Standard_Natural
);
621 -- Create subtype declaration for Positive
623 Decl
:= New_Node
(N_Subtype_Declaration
, Stloc
);
624 Set_Defining_Identifier
(Decl
, Standard_Positive
);
625 Set_Subtype_Indication
(Decl
,
626 New_Occurrence_Of
(Standard_Integer
, Stloc
));
627 Append
(Decl
, Decl_S
);
629 Set_Ekind
(Standard_Positive
, E_Signed_Integer_Subtype
);
630 Set_Etype
(Standard_Positive
, Base_Type
(Standard_Integer
));
631 Init_Esize
(Standard_Positive
, Standard_Integer_Size
);
632 Init_RM_Size
(Standard_Positive
, Standard_Integer_Size
- 1);
633 Set_Prim_Alignment
(Standard_Positive
);
635 Set_Size_Known_At_Compile_Time
(Standard_Positive
);
637 Set_Integer_Bounds
(Standard_Positive
,
638 Typ
=> Base_Type
(Standard_Integer
),
640 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
641 Set_Is_Constrained
(Standard_Positive
);
642 Set_Is_Frozen
(Standard_Positive
);
643 Set_Is_Public
(Standard_Positive
);
645 -- Create declaration for package ASCII
647 Decl
:= New_Node
(N_Package_Declaration
, Stloc
);
648 Append
(Decl
, Decl_S
);
650 Pspec
:= New_Node
(N_Package_Specification
, Stloc
);
651 Set_Specification
(Decl
, Pspec
);
653 Set_Defining_Unit_Name
(Pspec
, Standard_Entity
(S_ASCII
));
654 Set_Ekind
(Standard_Entity
(S_ASCII
), E_Package
);
655 Decl_A
:= New_List
; -- for ASCII declarations
656 Set_Visible_Declarations
(Pspec
, Decl_A
);
658 -- Create control character definitions in package ASCII. Note that
659 -- the character literal entries created here correspond to literal
660 -- values that are impossible in the source, but can be represented
661 -- internally with no difficulties.
665 for S
in S_ASCII_Names
loop
666 Decl
:= New_Node
(N_Object_Declaration
, Staloc
);
667 Set_Constant_Present
(Decl
, True);
670 A_Char
: Entity_Id
:= Standard_Entity
(S
);
674 Set_Sloc
(A_Char
, Staloc
);
675 Set_Ekind
(A_Char
, E_Constant
);
676 Set_Not_Source_Assigned
(A_Char
, True);
677 Set_Is_True_Constant
(A_Char
, True);
678 Set_Etype
(A_Char
, Standard_Character
);
679 Set_Scope
(A_Char
, Standard_Entity
(S_ASCII
));
680 Set_Is_Immediately_Visible
(A_Char
, False);
681 Set_Is_Public
(A_Char
, True);
682 Set_Is_Known_Valid
(A_Char
, True);
684 Append_Entity
(A_Char
, Standard_Entity
(S_ASCII
));
685 Set_Defining_Identifier
(Decl
, A_Char
);
687 Set_Object_Definition
(Decl
, Identifier_For
(S_Character
));
688 Expr_Decl
:= New_Node
(N_Character_Literal
, Staloc
);
689 Set_Expression
(Decl
, Expr_Decl
);
691 Set_Is_Static_Expression
(Expr_Decl
);
692 Set_Chars
(Expr_Decl
, No_Name
);
693 Set_Etype
(Expr_Decl
, Standard_Character
);
694 Set_Char_Literal_Value
(Expr_Decl
, Ccode
);
697 Append
(Decl
, Decl_A
);
699 -- Increment character code, dealing with non-contiguities
703 if Ccode
= 16#
20#
then
705 elsif Ccode
= 16#
27#
then
707 elsif Ccode
= 16#
3C#
then
709 elsif Ccode
= 16#
41#
then
714 -- Create semantic phase entities
716 Standard_Void_Type
:= New_Standard_Entity
;
717 Set_Ekind
(Standard_Void_Type
, E_Void
);
718 Set_Etype
(Standard_Void_Type
, Standard_Void_Type
);
719 Init_Size_Align
(Standard_Void_Type
);
720 Set_Scope
(Standard_Void_Type
, Standard_Standard
);
721 Make_Name
(Standard_Void_Type
, "_void_type");
723 -- The type field of packages is set to void
725 Set_Etype
(Standard_Standard
, Standard_Void_Type
);
726 Set_Etype
(Standard_ASCII
, Standard_Void_Type
);
728 -- Standard_A_String is actually used in generated code, so it has a
729 -- type name that is reasonable, but does not overlap any Ada name.
731 Standard_A_String
:= New_Standard_Entity
;
732 Set_Ekind
(Standard_A_String
, E_Access_Type
);
733 Set_Scope
(Standard_A_String
, Standard_Standard
);
734 Set_Etype
(Standard_A_String
, Standard_A_String
);
737 Init_Size
(Standard_A_String
, System_Address_Size
);
739 Init_Size
(Standard_A_String
, System_Address_Size
* 2);
742 Init_Alignment
(Standard_A_String
);
744 Set_Directly_Designated_Type
745 (Standard_A_String
, Standard_String
);
746 Make_Name
(Standard_A_String
, "access_string");
748 Standard_A_Char
:= New_Standard_Entity
;
749 Set_Ekind
(Standard_A_Char
, E_Access_Type
);
750 Set_Scope
(Standard_A_Char
, Standard_Standard
);
751 Set_Etype
(Standard_A_Char
, Standard_A_String
);
752 Init_Size
(Standard_A_Char
, System_Address_Size
);
753 Set_Prim_Alignment
(Standard_A_Char
);
755 Set_Directly_Designated_Type
(Standard_A_Char
, Standard_Character
);
756 Make_Name
(Standard_A_Char
, "access_character");
758 -- Note on type names. The type names for the following special types
759 -- are constructed so that they will look reasonable should they ever
760 -- appear in error messages etc, although in practice the use of the
761 -- special insertion character } for types results in special handling
762 -- of these type names in any case. The blanks in these names would
763 -- trouble in Gigi, but that's OK here, since none of these types
764 -- should ever get through to Gigi! Attributes of these types are
765 -- filled out to minimize problems with cascaded errors (for example,
766 -- Any_Integer is given reasonable and consistent type and size values)
768 Any_Type
:= New_Standard_Entity
;
769 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
770 Set_Defining_Identifier
(Decl
, Any_Type
);
771 Set_Scope
(Any_Type
, Standard_Standard
);
772 Build_Signed_Integer_Type
(Any_Type
, Standard_Integer_Size
);
773 Make_Name
(Any_Type
, "any type");
775 Any_Id
:= New_Standard_Entity
;
776 Set_Ekind
(Any_Id
, E_Variable
);
777 Set_Scope
(Any_Id
, Standard_Standard
);
778 Set_Etype
(Any_Id
, Any_Type
);
779 Init_Size_Align
(Any_Id
);
780 Make_Name
(Any_Id
, "any id");
782 Any_Access
:= New_Standard_Entity
;
783 Set_Ekind
(Any_Access
, E_Access_Type
);
784 Set_Scope
(Any_Access
, Standard_Standard
);
785 Set_Etype
(Any_Access
, Any_Access
);
786 Init_Size
(Any_Access
, System_Address_Size
);
787 Set_Prim_Alignment
(Any_Access
);
788 Make_Name
(Any_Access
, "an access type");
790 Any_Array
:= New_Standard_Entity
;
791 Set_Ekind
(Any_Array
, E_String_Type
);
792 Set_Scope
(Any_Array
, Standard_Standard
);
793 Set_Etype
(Any_Array
, Any_Array
);
794 Set_Component_Type
(Any_Array
, Any_Character
);
795 Init_Size_Align
(Any_Array
);
796 Make_Name
(Any_Array
, "an array type");
798 Any_Boolean
:= New_Standard_Entity
;
799 Set_Ekind
(Any_Boolean
, E_Enumeration_Type
);
800 Set_Scope
(Any_Boolean
, Standard_Standard
);
801 Set_Etype
(Any_Boolean
, Standard_Boolean
);
802 Init_Esize
(Any_Boolean
, Standard_Character_Size
);
803 Init_RM_Size
(Any_Boolean
, 1);
804 Set_Prim_Alignment
(Any_Boolean
);
805 Set_Is_Unsigned_Type
(Any_Boolean
);
806 Set_Scalar_Range
(Any_Boolean
, Scalar_Range
(Standard_Boolean
));
807 Make_Name
(Any_Boolean
, "a boolean type");
809 Any_Character
:= New_Standard_Entity
;
810 Set_Ekind
(Any_Character
, E_Enumeration_Type
);
811 Set_Scope
(Any_Character
, Standard_Standard
);
812 Set_Etype
(Any_Character
, Any_Character
);
813 Set_Is_Unsigned_Type
(Any_Character
);
814 Set_Is_Character_Type
(Any_Character
);
815 Init_Esize
(Any_Character
, Standard_Character_Size
);
816 Init_RM_Size
(Any_Character
, 8);
817 Set_Prim_Alignment
(Any_Character
);
818 Set_Scalar_Range
(Any_Character
, Scalar_Range
(Standard_Character
));
819 Make_Name
(Any_Character
, "a character type");
821 Any_Composite
:= New_Standard_Entity
;
822 Set_Ekind
(Any_Composite
, E_Array_Type
);
823 Set_Scope
(Any_Composite
, Standard_Standard
);
824 Set_Etype
(Any_Composite
, Any_Composite
);
825 Set_Component_Size
(Any_Composite
, Uint_0
);
826 Set_Component_Type
(Any_Composite
, Standard_Integer
);
827 Init_Size_Align
(Any_Composite
);
828 Make_Name
(Any_Composite
, "a composite type");
830 Any_Discrete
:= New_Standard_Entity
;
831 Set_Ekind
(Any_Discrete
, E_Signed_Integer_Type
);
832 Set_Scope
(Any_Discrete
, Standard_Standard
);
833 Set_Etype
(Any_Discrete
, Any_Discrete
);
834 Init_Size
(Any_Discrete
, Standard_Integer_Size
);
835 Set_Prim_Alignment
(Any_Discrete
);
836 Make_Name
(Any_Discrete
, "a discrete type");
838 Any_Fixed
:= New_Standard_Entity
;
839 Set_Ekind
(Any_Fixed
, E_Ordinary_Fixed_Point_Type
);
840 Set_Scope
(Any_Fixed
, Standard_Standard
);
841 Set_Etype
(Any_Fixed
, Any_Fixed
);
842 Init_Size
(Any_Fixed
, Standard_Integer_Size
);
843 Set_Prim_Alignment
(Any_Fixed
);
844 Make_Name
(Any_Fixed
, "a fixed-point type");
846 Any_Integer
:= New_Standard_Entity
;
847 Set_Ekind
(Any_Integer
, E_Signed_Integer_Type
);
848 Set_Scope
(Any_Integer
, Standard_Standard
);
849 Set_Etype
(Any_Integer
, Standard_Long_Long_Integer
);
850 Init_Size
(Any_Integer
, Standard_Long_Long_Integer_Size
);
851 Set_Prim_Alignment
(Any_Integer
);
855 Typ
=> Base_Type
(Standard_Integer
),
857 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
858 Make_Name
(Any_Integer
, "an integer type");
860 Any_Modular
:= New_Standard_Entity
;
861 Set_Ekind
(Any_Modular
, E_Modular_Integer_Type
);
862 Set_Scope
(Any_Modular
, Standard_Standard
);
863 Set_Etype
(Any_Modular
, Standard_Long_Long_Integer
);
864 Init_Size
(Any_Modular
, Standard_Long_Long_Integer_Size
);
865 Set_Prim_Alignment
(Any_Modular
);
866 Set_Is_Unsigned_Type
(Any_Modular
);
867 Make_Name
(Any_Modular
, "a modular type");
869 Any_Numeric
:= New_Standard_Entity
;
870 Set_Ekind
(Any_Numeric
, E_Signed_Integer_Type
);
871 Set_Scope
(Any_Numeric
, Standard_Standard
);
872 Set_Etype
(Any_Numeric
, Standard_Long_Long_Integer
);
873 Init_Size
(Any_Numeric
, Standard_Long_Long_Integer_Size
);
874 Set_Prim_Alignment
(Any_Numeric
);
875 Make_Name
(Any_Numeric
, "a numeric type");
877 Any_Real
:= New_Standard_Entity
;
878 Set_Ekind
(Any_Real
, E_Floating_Point_Type
);
879 Set_Scope
(Any_Real
, Standard_Standard
);
880 Set_Etype
(Any_Real
, Standard_Long_Long_Float
);
881 Init_Size
(Any_Real
, Standard_Long_Long_Float_Size
);
882 Set_Prim_Alignment
(Any_Real
);
883 Make_Name
(Any_Real
, "a real type");
885 Any_Scalar
:= New_Standard_Entity
;
886 Set_Ekind
(Any_Scalar
, E_Signed_Integer_Type
);
887 Set_Scope
(Any_Scalar
, Standard_Standard
);
888 Set_Etype
(Any_Scalar
, Any_Scalar
);
889 Init_Size
(Any_Scalar
, Standard_Integer_Size
);
890 Set_Prim_Alignment
(Any_Scalar
);
891 Make_Name
(Any_Scalar
, "a scalar type");
893 Any_String
:= New_Standard_Entity
;
894 Set_Ekind
(Any_String
, E_String_Type
);
895 Set_Scope
(Any_String
, Standard_Standard
);
896 Set_Etype
(Any_String
, Any_String
);
897 Set_Component_Type
(Any_String
, Any_Character
);
898 Init_Size_Align
(Any_String
);
899 Make_Name
(Any_String
, "a string type");
908 Low_Bound
=> Make_Integer
(Uint_0
),
909 High_Bound
=> Make_Integer
(Uint_2
** Standard_Integer_Size
));
910 Indexes
:= New_List
(Index
);
911 Set_Etype
(Index
, Standard_Integer
);
912 Set_First_Index
(Any_String
, Index
);
915 Standard_Integer_8
:= New_Standard_Entity
;
916 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
917 Set_Defining_Identifier
(Decl
, Standard_Integer_8
);
918 Make_Name
(Standard_Integer_8
, "integer_8");
919 Set_Scope
(Standard_Integer_8
, Standard_Standard
);
920 Build_Signed_Integer_Type
(Standard_Integer_8
, 8);
922 Standard_Integer_16
:= New_Standard_Entity
;
923 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
924 Set_Defining_Identifier
(Decl
, Standard_Integer_16
);
925 Make_Name
(Standard_Integer_16
, "integer_16");
926 Set_Scope
(Standard_Integer_16
, Standard_Standard
);
927 Build_Signed_Integer_Type
(Standard_Integer_16
, 16);
929 Standard_Integer_32
:= New_Standard_Entity
;
930 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
931 Set_Defining_Identifier
(Decl
, Standard_Integer_32
);
932 Make_Name
(Standard_Integer_32
, "integer_32");
933 Set_Scope
(Standard_Integer_32
, Standard_Standard
);
934 Build_Signed_Integer_Type
(Standard_Integer_32
, 32);
936 Standard_Integer_64
:= New_Standard_Entity
;
937 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
938 Set_Defining_Identifier
(Decl
, Standard_Integer_64
);
939 Make_Name
(Standard_Integer_64
, "integer_64");
940 Set_Scope
(Standard_Integer_64
, Standard_Standard
);
941 Build_Signed_Integer_Type
(Standard_Integer_64
, 64);
943 Standard_Unsigned
:= New_Standard_Entity
;
944 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
945 Set_Defining_Identifier
(Decl
, Standard_Unsigned
);
946 Make_Name
(Standard_Unsigned
, "unsigned");
948 Set_Ekind
(Standard_Unsigned
, E_Modular_Integer_Type
);
949 Set_Scope
(Standard_Unsigned
, Standard_Standard
);
950 Set_Etype
(Standard_Unsigned
, Standard_Unsigned
);
951 Init_Size
(Standard_Unsigned
, Standard_Integer_Size
);
952 Set_Prim_Alignment
(Standard_Unsigned
);
953 Set_Modulus
(Standard_Unsigned
,
954 Uint_2
** Standard_Integer_Size
);
956 Set_Is_Unsigned_Type
(Standard_Unsigned
);
958 R_Node
:= New_Node
(N_Range
, Stloc
);
959 Set_Low_Bound
(R_Node
,
960 Make_Integer_Literal
(Stloc
, 0));
961 Set_High_Bound
(R_Node
,
962 Make_Integer_Literal
(Stloc
, Modulus
(Standard_Unsigned
)));
963 Set_Scalar_Range
(Standard_Unsigned
, R_Node
);
965 -- Note: universal integer and universal real are constructed as fully
966 -- formed signed numeric types, with parameters corresponding to the
967 -- longest runtime types (Long_Long_Integer and Long_Long_Float). This
968 -- allows Gigi to properly process references to universal types that
969 -- are not folded at compile time.
971 Universal_Integer
:= New_Standard_Entity
;
972 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
973 Set_Defining_Identifier
(Decl
, Universal_Integer
);
974 Make_Name
(Universal_Integer
, "universal_integer");
975 Set_Scope
(Universal_Integer
, Standard_Standard
);
976 Build_Signed_Integer_Type
977 (Universal_Integer
, Standard_Long_Long_Integer_Size
);
979 Universal_Real
:= New_Standard_Entity
;
980 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
981 Set_Defining_Identifier
(Decl
, Universal_Real
);
982 Make_Name
(Universal_Real
, "universal_real");
983 Set_Scope
(Universal_Real
, Standard_Standard
);
986 Standard_Long_Long_Float_Size
,
987 Standard_Long_Long_Float_Digits
);
989 -- Note: universal fixed, unlike universal integer and universal real,
990 -- is never used at runtime, so it does not need to have bounds set.
992 Universal_Fixed
:= New_Standard_Entity
;
993 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
994 Set_Defining_Identifier
(Decl
, Universal_Fixed
);
995 Make_Name
(Universal_Fixed
, "universal_fixed");
996 Set_Ekind
(Universal_Fixed
, E_Ordinary_Fixed_Point_Type
);
997 Set_Etype
(Universal_Fixed
, Universal_Fixed
);
998 Set_Scope
(Universal_Fixed
, Standard_Standard
);
999 Init_Size
(Universal_Fixed
, Standard_Long_Long_Integer_Size
);
1000 Set_Prim_Alignment
(Universal_Fixed
);
1001 Set_Size_Known_At_Compile_Time
1004 -- Create type declaration for Duration, using a 64-bit size. The
1005 -- delta value depends on the mode we are running in:
1007 -- Normal mode or No_Run_Time mode when word size is 64 bits:
1008 -- 10**(-9) seconds, size is 64 bits
1010 -- No_Run_Time mode when word size is 32 bits:
1011 -- 10**(-4) seconds, oize is 32 bits
1013 Build_Duration
: declare
1017 Use_32_Bits
: constant Boolean :=
1018 No_Run_Time
and then System_Word_Size
= 32;
1022 Dlo
:= Intval
(Type_Low_Bound
(Standard_Integer_32
));
1023 Dhi
:= Intval
(Type_High_Bound
(Standard_Integer_32
));
1024 Delta_Val
:= UR_From_Components
(Uint_1
, Uint_4
, 10);
1027 Dlo
:= Intval
(Type_Low_Bound
(Standard_Integer_64
));
1028 Dhi
:= Intval
(Type_High_Bound
(Standard_Integer_64
));
1029 Delta_Val
:= UR_From_Components
(Uint_1
, Uint_9
, 10);
1033 Make_Full_Type_Declaration
(Stloc
,
1034 Defining_Identifier
=> Standard_Duration
,
1036 Make_Ordinary_Fixed_Point_Definition
(Stloc
,
1037 Delta_Expression
=> Make_Real_Literal
(Stloc
, Delta_Val
),
1038 Real_Range_Specification
=>
1039 Make_Real_Range_Specification
(Stloc
,
1040 Low_Bound
=> Make_Real_Literal
(Stloc
,
1041 Realval
=> Dlo
* Delta_Val
),
1042 High_Bound
=> Make_Real_Literal
(Stloc
,
1043 Realval
=> Dhi
* Delta_Val
))));
1045 Set_Ekind
(Standard_Duration
, E_Ordinary_Fixed_Point_Type
);
1046 Set_Etype
(Standard_Duration
, Standard_Duration
);
1049 Init_Size
(Standard_Duration
, 32);
1051 Init_Size
(Standard_Duration
, 64);
1054 Set_Prim_Alignment
(Standard_Duration
);
1055 Set_Delta_Value
(Standard_Duration
, Delta_Val
);
1056 Set_Small_Value
(Standard_Duration
, Delta_Val
);
1057 Set_Scalar_Range
(Standard_Duration
,
1058 Real_Range_Specification
1059 (Type_Definition
(Decl
)));
1061 -- Normally it does not matter that nodes in package Standard are
1062 -- not marked as analyzed. The Scalar_Range of the fixed-point
1063 -- type Standard_Duration is an exception, because of the special
1064 -- test made in Freeze.Freeze_Fixed_Point_Type.
1066 Set_Analyzed
(Scalar_Range
(Standard_Duration
));
1068 Set_Etype
(Type_High_Bound
(Standard_Duration
), Standard_Duration
);
1069 Set_Etype
(Type_Low_Bound
(Standard_Duration
), Standard_Duration
);
1071 Set_Is_Static_Expression
(Type_High_Bound
(Standard_Duration
));
1072 Set_Is_Static_Expression
(Type_Low_Bound
(Standard_Duration
));
1074 Set_Corresponding_Integer_Value
1075 (Type_High_Bound
(Standard_Duration
), Dhi
);
1077 Set_Corresponding_Integer_Value
1078 (Type_Low_Bound
(Standard_Duration
), Dlo
);
1080 Set_Size_Known_At_Compile_Time
(Standard_Duration
);
1083 -- Build standard exception type. Note that the type name here is
1084 -- actually used in the generated code, so it must be set correctly
1086 Standard_Exception_Type
:= New_Standard_Entity
;
1087 Set_Ekind
(Standard_Exception_Type
, E_Record_Type
);
1088 Set_Etype
(Standard_Exception_Type
, Standard_Exception_Type
);
1089 Set_Scope
(Standard_Exception_Type
, Standard_Standard
);
1090 Set_Girder_Constraint
1091 (Standard_Exception_Type
, No_Elist
);
1092 Init_Size_Align
(Standard_Exception_Type
);
1093 Set_Size_Known_At_Compile_Time
1094 (Standard_Exception_Type
, True);
1095 Make_Name
(Standard_Exception_Type
, "exception");
1097 Make_Component
(Standard_Exception_Type
, Standard_Boolean
,
1098 "Not_Handled_By_Others");
1099 Make_Component
(Standard_Exception_Type
, Standard_Character
, "Lang");
1100 Make_Component
(Standard_Exception_Type
, Standard_Natural
,
1102 Make_Component
(Standard_Exception_Type
, Standard_A_Char
,
1104 Make_Component
(Standard_Exception_Type
, Standard_A_Char
,
1106 Make_Component
(Standard_Exception_Type
, Standard_Integer
,
1109 -- Build tree for record declaration, for use by the back-end.
1112 Comp_List
: List_Id
;
1116 Comp
:= First_Entity
(Standard_Exception_Type
);
1117 Comp_List
:= New_List
;
1119 while Present
(Comp
) loop
1121 Make_Component_Declaration
(Stloc
,
1122 Defining_Identifier
=> Comp
,
1123 Subtype_Indication
=> New_Occurrence_Of
(Etype
(Comp
), Stloc
)),
1129 Decl
:= Make_Full_Type_Declaration
(Stloc
,
1130 Defining_Identifier
=> Standard_Exception_Type
,
1132 Make_Record_Definition
(Stloc
,
1135 Make_Component_List
(Stloc
,
1136 Component_Items
=> Comp_List
)));
1139 Append
(Decl
, Decl_S
);
1141 -- Create declarations of standard exceptions
1143 Build_Exception
(S_Constraint_Error
);
1144 Build_Exception
(S_Program_Error
);
1145 Build_Exception
(S_Storage_Error
);
1146 Build_Exception
(S_Tasking_Error
);
1148 -- Numeric_Error is a normal exception in Ada 83, but in Ada 95
1149 -- it is a renaming of Constraint_Error
1152 Build_Exception
(S_Numeric_Error
);
1155 Decl
:= New_Node
(N_Exception_Renaming_Declaration
, Stloc
);
1156 E_Id
:= Standard_Entity
(S_Numeric_Error
);
1158 Set_Ekind
(E_Id
, E_Exception
);
1159 Set_Exception_Code
(E_Id
, Uint_0
);
1160 Set_Etype
(E_Id
, Standard_Exception_Type
);
1161 Set_Is_Public
(E_Id
);
1162 Set_Renamed_Entity
(E_Id
, Standard_Entity
(S_Constraint_Error
));
1164 Set_Defining_Identifier
(Decl
, E_Id
);
1165 Append
(Decl
, Decl_S
);
1167 Ident_Node
:= New_Node
(N_Identifier
, Stloc
);
1168 Set_Chars
(Ident_Node
, Chars
(Standard_Entity
(S_Constraint_Error
)));
1169 Set_Entity
(Ident_Node
, Standard_Entity
(S_Constraint_Error
));
1170 Set_Name
(Decl
, Ident_Node
);
1173 -- Abort_Signal is an entity that does not get made visible
1175 Abort_Signal
:= New_Standard_Entity
;
1176 Set_Chars
(Abort_Signal
, Name_uAbort_Signal
);
1177 Set_Ekind
(Abort_Signal
, E_Exception
);
1178 Set_Exception_Code
(Abort_Signal
, Uint_0
);
1179 Set_Etype
(Abort_Signal
, Standard_Exception_Type
);
1180 Set_Scope
(Abort_Signal
, Standard_Standard
);
1181 Set_Is_Public
(Abort_Signal
, True);
1183 Make_Exception_Declaration
(Stloc
,
1184 Defining_Identifier
=> Abort_Signal
);
1186 -- Create defining identifiers for shift operator entities. Note
1187 -- that these entities are used only for marking shift operators
1188 -- generated internally, and hence need no structure, just a name
1189 -- and a unique identity.
1191 Standard_Op_Rotate_Left
:= New_Standard_Entity
;
1192 Set_Chars
(Standard_Op_Rotate_Left
, Name_Rotate_Left
);
1193 Set_Ekind
(Standard_Op_Rotate_Left
, E_Operator
);
1195 Standard_Op_Rotate_Right
:= New_Standard_Entity
;
1196 Set_Chars
(Standard_Op_Rotate_Right
, Name_Rotate_Right
);
1197 Set_Ekind
(Standard_Op_Rotate_Right
, E_Operator
);
1199 Standard_Op_Shift_Left
:= New_Standard_Entity
;
1200 Set_Chars
(Standard_Op_Shift_Left
, Name_Shift_Left
);
1201 Set_Ekind
(Standard_Op_Shift_Left
, E_Operator
);
1203 Standard_Op_Shift_Right
:= New_Standard_Entity
;
1204 Set_Chars
(Standard_Op_Shift_Right
, Name_Shift_Right
);
1205 Set_Ekind
(Standard_Op_Shift_Right
, E_Operator
);
1207 Standard_Op_Shift_Right_Arithmetic
:= New_Standard_Entity
;
1208 Set_Chars
(Standard_Op_Shift_Right_Arithmetic
,
1209 Name_Shift_Right_Arithmetic
);
1210 Set_Ekind
(Standard_Op_Shift_Right_Arithmetic
,
1213 -- Create standard operator declarations
1217 -- Initialize visibility table with entities in Standard
1219 for E
in Standard_Entity_Type
loop
1220 if Ekind
(Standard_Entity
(E
)) /= E_Operator
then
1222 (Chars
(Standard_Entity
(E
)), Standard_Entity
(E
));
1223 Set_Homonym
(Standard_Entity
(E
), Empty
);
1226 if E
not in S_ASCII_Names
then
1227 Set_Scope
(Standard_Entity
(E
), Standard_Standard
);
1228 Set_Is_Immediately_Visible
(Standard_Entity
(E
));
1232 -- The predefined package Standard itself does not have a scope;
1233 -- it is the only entity in the system not to have one, and this
1234 -- is what identifies the package to Gigi.
1236 Set_Scope
(Standard_Standard
, Empty
);
1238 -- Set global variables indicating last Id values and version
1240 Last_Standard_Node_Id
:= Last_Node_Id
;
1241 Last_Standard_List_Id
:= Last_List_Id
;
1243 -- The Error node has an Etype of Any_Type to help error recovery
1245 Set_Etype
(Error
, Any_Type
);
1246 end Create_Standard
;
1248 ------------------------------------
1249 -- Create_Unconstrained_Base_Type --
1250 ------------------------------------
1252 procedure Create_Unconstrained_Base_Type
1256 New_Ent
: constant Entity_Id
:= New_Copy
(E
);
1260 Set_Is_Constrained
(E
, True);
1261 Set_Etype
(E
, New_Ent
);
1263 Append_Entity
(New_Ent
, Standard_Standard
);
1264 Set_Is_Constrained
(New_Ent
, False);
1265 Set_Etype
(New_Ent
, New_Ent
);
1266 Set_Is_Known_Valid
(New_Ent
, True);
1268 if K
= E_Signed_Integer_Subtype
then
1269 Set_Etype
(Low_Bound
(Scalar_Range
(E
)), New_Ent
);
1270 Set_Etype
(High_Bound
(Scalar_Range
(E
)), New_Ent
);
1273 end Create_Unconstrained_Base_Type
;
1275 --------------------
1276 -- Identifier_For --
1277 --------------------
1279 function Identifier_For
(S
: Standard_Entity_Type
) return Node_Id
is
1280 Ident_Node
: Node_Id
;
1283 Ident_Node
:= New_Node
(N_Identifier
, Stloc
);
1284 Set_Chars
(Ident_Node
, Chars
(Standard_Entity
(S
)));
1288 --------------------
1289 -- Make_Component --
1290 --------------------
1292 procedure Make_Component
1297 Id
: Entity_Id
:= New_Standard_Entity
;
1300 Set_Ekind
(Id
, E_Component
);
1301 Set_Etype
(Id
, Typ
);
1302 Set_Scope
(Id
, Rec
);
1303 Init_Component_Location
(Id
);
1305 Set_Original_Record_Component
(Id
, Id
);
1306 Make_Name
(Id
, Nam
);
1307 Append_Entity
(Id
, Rec
);
1314 function Make_Formal
1316 Formal_Name
: String)
1322 Formal
:= New_Standard_Entity
;
1324 Set_Ekind
(Formal
, E_In_Parameter
);
1325 Set_Mechanism
(Formal
, Default_Mechanism
);
1326 Set_Scope
(Formal
, Standard_Standard
);
1327 Set_Etype
(Formal
, Typ
);
1328 Make_Name
(Formal
, Formal_Name
);
1337 function Make_Integer
(V
: Uint
) return Node_Id
is
1338 N
: constant Node_Id
:= Make_Integer_Literal
(Stloc
, V
);
1341 Set_Is_Static_Expression
(N
);
1349 procedure Make_Name
(Id
: Entity_Id
; Nam
: String) is
1351 for J
in 1 .. Nam
'Length loop
1352 Name_Buffer
(J
) := Fold_Lower
(Nam
(Nam
'First + (J
- 1)));
1355 Name_Len
:= Nam
'Length;
1356 Set_Chars
(Id
, Name_Find
);
1363 function New_Operator
(Op
: Name_Id
; Typ
: Entity_Id
) return Entity_Id
is
1364 Ident_Node
: Entity_Id
;
1367 Ident_Node
:= Make_Defining_Identifier
(Stloc
, Op
);
1369 Set_Is_Pure
(Ident_Node
, True);
1370 Set_Ekind
(Ident_Node
, E_Operator
);
1371 Set_Etype
(Ident_Node
, Typ
);
1372 Set_Scope
(Ident_Node
, Standard_Standard
);
1373 Set_Homonym
(Ident_Node
, Get_Name_Entity_Id
(Op
));
1374 Set_Convention
(Ident_Node
, Convention_Intrinsic
);
1376 Set_Is_Immediately_Visible
(Ident_Node
, True);
1377 Set_Is_Intrinsic_Subprogram
(Ident_Node
, True);
1379 Set_Name_Entity_Id
(Op
, Ident_Node
);
1380 Append_Entity
(Ident_Node
, Standard_Standard
);
1384 -------------------------
1385 -- New_Standard_Entity --
1386 -------------------------
1388 function New_Standard_Entity
1389 (New_Node_Kind
: Node_Kind
:= N_Defining_Identifier
)
1392 E
: constant Entity_Id
:= New_Entity
(New_Node_Kind
, Stloc
);
1395 -- All standard entities are Pure and Public
1400 -- All standard entity names are analyzed manually, and are thus
1401 -- frozen as soon as they are created.
1405 -- Set debug information required for all standard types
1407 Set_Needs_Debug_Info
(E
);
1409 -- All standard entities are built with fully qualified names, so
1410 -- set the flag to prevent an abortive attempt at requalification!
1412 Set_Has_Qualified_Name
(E
);
1414 -- Return newly created entity to be completed by caller
1417 end New_Standard_Entity
;
1419 ----------------------
1420 -- Set_Float_Bounds --
1421 ----------------------
1423 procedure Set_Float_Bounds
(Id
: Entity_Id
) is
1425 -- Low bound of literal value
1428 -- High bound of literal value
1431 -- Range specification
1433 Digs
: constant Nat
:= UI_To_Int
(Digits_Value
(Id
));
1434 -- Digits value, used to select bounds
1437 -- Note: for the call from Cstand to initially create the types in
1438 -- Standard, Vax_Float will always be False. Circuitry in Sem_Vfpt
1439 -- will adjust these types appropriately in the Vax_Float case if
1440 -- a pragma Float_Representation (VAX_Float) is used.
1442 if Vax_Float
(Id
) then
1443 if Digs
= VAXFF_Digits
then
1445 (VAXFF_First
'Universal_Literal_String);
1447 (VAXFF_Last
'Universal_Literal_String);
1449 elsif Digs
= VAXDF_Digits
then
1451 (VAXDF_First
'Universal_Literal_String);
1453 (VAXDF_Last
'Universal_Literal_String);
1456 pragma Assert
(Digs
= VAXGF_Digits
);
1459 (VAXGF_First
'Universal_Literal_String);
1461 (VAXGF_Last
'Universal_Literal_String);
1464 elsif Is_AAMP_Float
(Id
) then
1465 if Digs
= AAMPS_Digits
then
1467 (AAMPS_First
'Universal_Literal_String);
1469 (AAMPS_Last
'Universal_Literal_String);
1472 pragma Assert
(Digs
= AAMPL_Digits
);
1474 (AAMPL_First
'Universal_Literal_String);
1476 (AAMPL_Last
'Universal_Literal_String);
1479 elsif Digs
= IEEES_Digits
then
1481 (IEEES_First
'Universal_Literal_String);
1483 (IEEES_Last
'Universal_Literal_String);
1485 elsif Digs
= IEEEL_Digits
then
1487 (IEEEL_First
'Universal_Literal_String);
1489 (IEEEL_Last
'Universal_Literal_String);
1492 pragma Assert
(Digs
= IEEEX_Digits
);
1495 (IEEEX_First
'Universal_Literal_String);
1497 (IEEEX_Last
'Universal_Literal_String);
1501 Set_Is_Static_Expression
(L
);
1504 Set_Is_Static_Expression
(H
);
1506 R
:= New_Node
(N_Range
, Stloc
);
1507 Set_Low_Bound
(R
, L
);
1508 Set_High_Bound
(R
, H
);
1509 Set_Includes_Infinities
(R
, True);
1510 Set_Scalar_Range
(Id
, R
);
1513 end Set_Float_Bounds
;
1515 ------------------------
1516 -- Set_Integer_Bounds --
1517 ------------------------
1519 procedure Set_Integer_Bounds
1525 L
: Node_Id
; -- Low bound of literal value
1526 H
: Node_Id
; -- High bound of literal value
1527 R
: Node_Id
; -- Range specification
1530 L
:= Make_Integer
(Lb
);
1531 H
:= Make_Integer
(Hb
);
1536 R
:= New_Node
(N_Range
, Stloc
);
1537 Set_Low_Bound
(R
, L
);
1538 Set_High_Bound
(R
, H
);
1539 Set_Scalar_Range
(Id
, R
);
1542 Set_Is_Unsigned_Type
(Id
, Lb
>= 0);
1543 end Set_Integer_Bounds
;