1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 with Atree
; use Atree
;
29 with Csets
; use Csets
;
30 with Debug
; use Debug
;
31 with Einfo
; use Einfo
;
32 with Layout
; use Layout
;
33 with Namet
; use Namet
;
34 with Nlists
; use Nlists
;
35 with Nmake
; use Nmake
;
37 with Tbuild
; use Tbuild
;
38 with Ttypes
; use Ttypes
;
39 with Ttypef
; use Ttypef
;
40 with Sem_Mech
; use Sem_Mech
;
41 with Sem_Util
; use Sem_Util
;
42 with Sinfo
; use Sinfo
;
43 with Snames
; use Snames
;
44 with Stand
; use Stand
;
45 with Uintp
; use Uintp
;
46 with Urealp
; use Urealp
;
48 package body CStand
is
50 Stloc
: constant Source_Ptr
:= Standard_Location
;
51 Staloc
: constant Source_Ptr
:= Standard_ASCII_Location
;
52 -- Standard abbreviations used throughout this package
54 -----------------------
55 -- Local Subprograms --
56 -----------------------
58 procedure Build_Float_Type
(E
: Entity_Id
; Siz
: Int
; Digs
: Int
);
59 -- Procedure to build standard predefined float base type. The first
60 -- parameter is the entity for the type, and the second parameter
61 -- is the size in bits. The third parameter is the digits value.
63 procedure Build_Signed_Integer_Type
(E
: Entity_Id
; Siz
: Int
);
64 -- Procedure to build standard predefined signed integer subtype. The
65 -- first parameter is the entity for the subtype. The second parameter
66 -- is the size in bits. The corresponding base type is not built by
67 -- this routine but instead must be built by the caller where needed.
69 procedure Create_Operators
;
70 -- Make entries for each of the predefined operators in Standard
72 procedure Create_Unconstrained_Base_Type
75 -- The predefined signed integer types are constrained subtypes which
76 -- must have a corresponding unconstrained base type. This type is almost
77 -- useless. The only place it has semantics is Subtypes_Statically_Match.
78 -- Consequently, we arrange for it to be identical apart from the setting
79 -- of the constrained bit. This routine takes an entity E for the Type,
80 -- copies it to estabish the base type, then resets the Ekind of the
81 -- original entity to K (the Ekind for the subtype). The Etype field of
82 -- E is set by the call (to point to the created base type entity), and
83 -- also the Is_Constrained flag of E is set.
85 -- To understand the exact requirement for this, see RM 3.5.4(11) which
86 -- makes it clear that Integer, for example, is constrained, with the
87 -- constraint bounds matching the bounds of the (unconstrained) base
88 -- type. The point is that Integer and Integer'Base have identical
89 -- bounds, but do not statically match, since a subtype with constraints
90 -- never matches a subtype with no constraints.
92 function Identifier_For
(S
: Standard_Entity_Type
) return Node_Id
;
93 -- Returns an identifier node with the same name as the defining
94 -- identifier corresponding to the given Standard_Entity_Type value
96 procedure Make_Component
100 -- Build a record component with the given type and name, and append to
101 -- the list of components of Rec.
105 Formal_Name
: String)
107 -- Construct entity for subprogram formal with given name and type
109 function Make_Integer
(V
: Uint
) return Node_Id
;
110 -- Builds integer literal with given value
112 procedure Make_Name
(Id
: Entity_Id
; Nam
: String);
113 -- Make an entry in the names table for Nam, and set as Chars field of Id
115 function New_Operator
(Op
: Name_Id
; Typ
: Entity_Id
) return Entity_Id
;
116 -- Build entity for standard operator with given name and type.
118 function New_Standard_Entity
119 (New_Node_Kind
: Node_Kind
:= N_Defining_Identifier
)
121 -- Builds a new entity for Standard
123 procedure Set_Integer_Bounds
128 -- Procedure to set bounds for integer type or subtype. Id is the entity
129 -- whose bounds and type are to be set. The Typ parameter is the Etype
130 -- value for the entity (which will be the same as Id for all predefined
131 -- integer base types. The third and fourth parameters are the bounds.
133 ----------------------
134 -- Build_Float_Type --
135 ----------------------
137 procedure Build_Float_Type
(E
: Entity_Id
; Siz
: Int
; Digs
: Int
) is
139 Set_Type_Definition
(Parent
(E
),
140 Make_Floating_Point_Definition
(Stloc
,
141 Digits_Expression
=> Make_Integer
(UI_From_Int
(Digs
))));
142 Set_Ekind
(E
, E_Floating_Point_Type
);
145 Set_Prim_Alignment
(E
);
146 Init_Digits_Value
(E
, Digs
);
147 Set_Float_Bounds
(E
);
150 Set_Size_Known_At_Compile_Time
(E
);
151 end Build_Float_Type
;
153 -------------------------------
154 -- Build_Signed_Integer_Type --
155 -------------------------------
157 procedure Build_Signed_Integer_Type
(E
: Entity_Id
; Siz
: Int
) is
158 U2Siz1
: constant Uint
:= 2 ** (Siz
- 1);
159 Lbound
: constant Uint
:= -U2Siz1
;
160 Ubound
: constant Uint
:= U2Siz1
- 1;
163 Set_Type_Definition
(Parent
(E
),
164 Make_Signed_Integer_Type_Definition
(Stloc
,
165 Low_Bound
=> Make_Integer
(Lbound
),
166 High_Bound
=> Make_Integer
(Ubound
)));
168 Set_Ekind
(E
, E_Signed_Integer_Type
);
171 Set_Prim_Alignment
(E
);
172 Set_Integer_Bounds
(E
, E
, Lbound
, Ubound
);
175 Set_Is_Known_Valid
(E
);
176 Set_Size_Known_At_Compile_Time
(E
);
177 end Build_Signed_Integer_Type
;
179 ----------------------
180 -- Create_Operators --
181 ----------------------
183 -- Each operator has an abbreviated signature. The formals have the names
184 -- LEFT and RIGHT. Their types are not actually used for resolution.
186 procedure Create_Operators
is
189 -- Following list has two entries for concatenation, to include
190 -- explicitly the operation on wide strings.
192 Binary_Ops
: constant array (S_Binary_Ops
) of Name_Id
:=
193 (Name_Op_Add
, Name_Op_And
, Name_Op_Concat
, Name_Op_Concat
,
194 Name_Op_Divide
, Name_Op_Eq
, Name_Op_Expon
, Name_Op_Ge
,
195 Name_Op_Gt
, Name_Op_Le
, Name_Op_Lt
, Name_Op_Mod
,
196 Name_Op_Multiply
, Name_Op_Ne
, Name_Op_Or
, Name_Op_Rem
,
197 Name_Op_Subtract
, Name_Op_Xor
);
199 Bin_Op_Types
: constant array (S_Binary_Ops
) of Entity_Id
:=
200 (Universal_Integer
, Standard_Boolean
,
201 Standard_String
, Standard_Wide_String
,
202 Universal_Integer
, Standard_Boolean
,
203 Universal_Integer
, Standard_Boolean
,
204 Standard_Boolean
, Standard_Boolean
,
205 Standard_Boolean
, Universal_Integer
,
206 Universal_Integer
, Standard_Boolean
,
207 Standard_Boolean
, Universal_Integer
,
208 Universal_Integer
, Standard_Boolean
);
210 Unary_Ops
: constant array (S_Unary_Ops
) of Name_Id
:=
211 (Name_Op_Abs
, Name_Op_Subtract
, Name_Op_Not
, Name_Op_Add
);
213 Unary_Op_Types
: constant array (S_Unary_Ops
) of Entity_Id
:=
214 (Universal_Integer
, Universal_Integer
,
215 Standard_Boolean
, Universal_Integer
);
217 -- Corresponding to Abs, Minus, Not, and Plus.
220 for J
in S_Binary_Ops
loop
221 Op_Node
:= New_Operator
(Binary_Ops
(J
), Bin_Op_Types
(J
));
223 Append_Entity
(Make_Formal
(Any_Type
, "LEFT"), Op_Node
);
224 Append_Entity
(Make_Formal
(Any_Type
, "RIGHT"), Op_Node
);
227 for J
in S_Unary_Ops
loop
228 Op_Node
:= New_Operator
(Unary_Ops
(J
), Unary_Op_Types
(J
));
230 Append_Entity
(Make_Formal
(Any_Type
, "RIGHT"), Op_Node
);
233 -- For concatenation, we create a separate operator for each
234 -- array type. This simplifies the resolution of the component-
235 -- component concatenation operation. In Standard, we set the types
236 -- of the formals for string and wide string concatenation.
238 Set_Etype
(First_Entity
(Standard_Op_Concat
), Standard_String
);
239 Set_Etype
(Last_Entity
(Standard_Op_Concat
), Standard_String
);
241 Set_Etype
(First_Entity
(Standard_Op_Concatw
), Standard_Wide_String
);
242 Set_Etype
(Last_Entity
(Standard_Op_Concatw
), Standard_Wide_String
);
244 end Create_Operators
;
246 ---------------------
247 -- Create_Standard --
248 ---------------------
250 -- The tree for the package Standard is prefixed to all compilations.
251 -- Several entities required by semantic analysis are denoted by global
252 -- variables that are initialized to point to the corresponding
253 -- occurrences in STANDARD. The visible entities of STANDARD are
254 -- created here. The private entities defined in STANDARD are created
255 -- by Initialize_Standard in the semantics module.
257 procedure Create_Standard
is
259 -- List of declarations in Standard
262 -- List of declarations in ASCII
267 Ident_Node
: Node_Id
;
273 procedure Build_Exception
(S
: Standard_Entity_Type
);
274 -- Procedure to declare given entity as an exception
276 ---------------------
277 -- Build_Exception --
278 ---------------------
280 procedure Build_Exception
(S
: Standard_Entity_Type
) is
282 Set_Ekind
(Standard_Entity
(S
), E_Exception
);
283 Set_Etype
(Standard_Entity
(S
), Standard_Exception_Type
);
284 Set_Exception_Code
(Standard_Entity
(S
), Uint_0
);
285 Set_Is_Public
(Standard_Entity
(S
), True);
288 Make_Exception_Declaration
(Stloc
,
289 Defining_Identifier
=> Standard_Entity
(S
));
290 Append
(Decl
, Decl_S
);
293 -- Start of processing for Create_Standard
298 -- First step is to create defining identifiers for each entity
300 for S
in Standard_Entity_Type
loop
302 S_Name
: constant String := Standard_Entity_Type
'Image (S
);
303 -- Name of entity (note we skip S_ at the start)
305 Ident_Node
: Node_Id
;
306 -- Defining identifier node
309 Ident_Node
:= New_Standard_Entity
;
310 Make_Name
(Ident_Node
, S_Name
(3 .. S_Name
'Length));
311 Standard_Entity
(S
) := Ident_Node
;
315 -- Create package declaration node for package Standard
317 Standard_Package_Node
:= New_Node
(N_Package_Declaration
, Stloc
);
319 Pspec
:= New_Node
(N_Package_Specification
, Stloc
);
320 Set_Specification
(Standard_Package_Node
, Pspec
);
322 Set_Defining_Unit_Name
(Pspec
, Standard_Standard
);
323 Set_Visible_Declarations
(Pspec
, Decl_S
);
325 Set_Ekind
(Standard_Standard
, E_Package
);
326 Set_Is_Pure
(Standard_Standard
);
327 Set_Is_Compilation_Unit
(Standard_Standard
);
329 -- Create type declaration nodes for standard types
331 for S
in S_Types
loop
332 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
333 Set_Defining_Identifier
(Decl
, Standard_Entity
(S
));
334 Set_Is_Frozen
(Standard_Entity
(S
));
335 Set_Is_Public
(Standard_Entity
(S
));
336 Append
(Decl
, Decl_S
);
339 -- Create type definition node for type Boolean. The Size is set to
340 -- 1 as required by Ada 95 and current ARG interpretations for Ada/83.
342 -- Note: Object_Size of Boolean is 8. This means that we do NOT in
343 -- general know that Boolean variables have valid values, so we do
344 -- not set the Is_Known_Valid flag.
346 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
347 Set_Literals
(Tdef_Node
, New_List
);
348 Append
(Standard_False
, Literals
(Tdef_Node
));
349 Append
(Standard_True
, Literals
(Tdef_Node
));
350 Set_Type_Definition
(Parent
(Standard_Boolean
), Tdef_Node
);
352 Set_Ekind
(Standard_Boolean
, E_Enumeration_Type
);
353 Set_First_Literal
(Standard_Boolean
, Standard_False
);
354 Set_Etype
(Standard_Boolean
, Standard_Boolean
);
355 Init_Esize
(Standard_Boolean
, Standard_Character_Size
);
356 Init_RM_Size
(Standard_Boolean
, 1);
357 Set_Prim_Alignment
(Standard_Boolean
);
359 Set_Is_Unsigned_Type
(Standard_Boolean
);
360 Set_Size_Known_At_Compile_Time
(Standard_Boolean
);
362 Set_Ekind
(Standard_True
, E_Enumeration_Literal
);
363 Set_Etype
(Standard_True
, Standard_Boolean
);
364 Set_Enumeration_Pos
(Standard_True
, Uint_1
);
365 Set_Enumeration_Rep
(Standard_True
, Uint_1
);
366 Set_Is_Known_Valid
(Standard_True
, True);
368 Set_Ekind
(Standard_False
, E_Enumeration_Literal
);
369 Set_Etype
(Standard_False
, Standard_Boolean
);
370 Set_Enumeration_Pos
(Standard_False
, Uint_0
);
371 Set_Enumeration_Rep
(Standard_False
, Uint_0
);
372 Set_Is_Known_Valid
(Standard_False
, True);
374 -- For the bounds of Boolean, we create a range node corresponding to
376 -- range False .. True
378 -- where the occurrences of the literals must point to the
379 -- corresponding definition.
381 R_Node
:= New_Node
(N_Range
, Stloc
);
382 B_Node
:= New_Node
(N_Identifier
, Stloc
);
383 Set_Chars
(B_Node
, Chars
(Standard_False
));
384 Set_Entity
(B_Node
, Standard_False
);
385 Set_Etype
(B_Node
, Standard_Boolean
);
386 Set_Is_Static_Expression
(B_Node
);
387 Set_Low_Bound
(R_Node
, B_Node
);
389 B_Node
:= New_Node
(N_Identifier
, Stloc
);
390 Set_Chars
(B_Node
, Chars
(Standard_True
));
391 Set_Entity
(B_Node
, Standard_True
);
392 Set_Etype
(B_Node
, Standard_Boolean
);
393 Set_Is_Static_Expression
(B_Node
);
394 Set_High_Bound
(R_Node
, B_Node
);
396 Set_Scalar_Range
(Standard_Boolean
, R_Node
);
397 Set_Etype
(R_Node
, Standard_Boolean
);
398 Set_Parent
(R_Node
, Standard_Boolean
);
400 -- Create type definition nodes for predefined integer types
402 Build_Signed_Integer_Type
403 (Standard_Short_Short_Integer
, Standard_Short_Short_Integer_Size
);
405 Build_Signed_Integer_Type
406 (Standard_Short_Integer
, Standard_Short_Integer_Size
);
408 Build_Signed_Integer_Type
409 (Standard_Integer
, Standard_Integer_Size
);
418 LIS
:= Standard_Long_Integer_Size
;
421 Build_Signed_Integer_Type
(Standard_Long_Integer
, LIS
);
424 Build_Signed_Integer_Type
425 (Standard_Long_Long_Integer
, Standard_Long_Long_Integer_Size
);
427 Create_Unconstrained_Base_Type
428 (Standard_Short_Short_Integer
, E_Signed_Integer_Subtype
);
430 Create_Unconstrained_Base_Type
431 (Standard_Short_Integer
, E_Signed_Integer_Subtype
);
433 Create_Unconstrained_Base_Type
434 (Standard_Integer
, E_Signed_Integer_Subtype
);
436 Create_Unconstrained_Base_Type
437 (Standard_Long_Integer
, E_Signed_Integer_Subtype
);
439 Create_Unconstrained_Base_Type
440 (Standard_Long_Long_Integer
, E_Signed_Integer_Subtype
);
442 -- Create type definition nodes for predefined float types
445 (Standard_Short_Float
,
446 Standard_Short_Float_Size
,
447 Standard_Short_Float_Digits
);
452 Standard_Float_Digits
);
455 (Standard_Long_Float
,
456 Standard_Long_Float_Size
,
457 Standard_Long_Float_Digits
);
460 (Standard_Long_Long_Float
,
461 Standard_Long_Long_Float_Size
,
462 Standard_Long_Long_Float_Digits
);
464 -- Create type definition node for type Character. Note that we do not
465 -- set the Literals field, since type Character is handled with special
466 -- routine that do not need a literal list.
468 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
469 Set_Type_Definition
(Parent
(Standard_Character
), Tdef_Node
);
471 Set_Ekind
(Standard_Character
, E_Enumeration_Type
);
472 Set_Etype
(Standard_Character
, Standard_Character
);
473 Init_Esize
(Standard_Character
, Standard_Character_Size
);
474 Init_RM_Size
(Standard_Character
, 8);
475 Set_Prim_Alignment
(Standard_Character
);
477 Set_Is_Unsigned_Type
(Standard_Character
);
478 Set_Is_Character_Type
(Standard_Character
);
479 Set_Is_Known_Valid
(Standard_Character
);
480 Set_Size_Known_At_Compile_Time
(Standard_Character
);
482 -- Create the bounds for type Character.
484 R_Node
:= New_Node
(N_Range
, Stloc
);
486 -- Low bound for type Character (Standard.Nul)
488 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
489 Set_Is_Static_Expression
(B_Node
);
490 Set_Chars
(B_Node
, No_Name
);
491 Set_Char_Literal_Value
(B_Node
, 16#
00#
);
492 Set_Entity
(B_Node
, Empty
);
493 Set_Etype
(B_Node
, Standard_Character
);
494 Set_Low_Bound
(R_Node
, B_Node
);
496 -- High bound for type Character
498 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
499 Set_Is_Static_Expression
(B_Node
);
500 Set_Chars
(B_Node
, No_Name
);
501 Set_Char_Literal_Value
(B_Node
, 16#FF#
);
502 Set_Entity
(B_Node
, Empty
);
503 Set_Etype
(B_Node
, Standard_Character
);
504 Set_High_Bound
(R_Node
, B_Node
);
506 Set_Scalar_Range
(Standard_Character
, R_Node
);
507 Set_Etype
(R_Node
, Standard_Character
);
508 Set_Parent
(R_Node
, Standard_Character
);
510 -- Create type definition for type Wide_Character. Note that we do not
511 -- set the Literals field, since type Wide_Character is handled with
512 -- special routines that do not need a literal list.
514 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
515 Set_Type_Definition
(Parent
(Standard_Wide_Character
), Tdef_Node
);
517 Set_Ekind
(Standard_Wide_Character
, E_Enumeration_Type
);
518 Set_Etype
(Standard_Wide_Character
, Standard_Wide_Character
);
519 Init_Size
(Standard_Wide_Character
, Standard_Wide_Character_Size
);
521 Set_Prim_Alignment
(Standard_Wide_Character
);
522 Set_Is_Unsigned_Type
(Standard_Wide_Character
);
523 Set_Is_Character_Type
(Standard_Wide_Character
);
524 Set_Is_Known_Valid
(Standard_Wide_Character
);
525 Set_Size_Known_At_Compile_Time
(Standard_Wide_Character
);
527 -- Create the bounds for type Wide_Character.
529 R_Node
:= New_Node
(N_Range
, Stloc
);
531 -- Low bound for type Wide_Character
533 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
534 Set_Is_Static_Expression
(B_Node
);
535 Set_Chars
(B_Node
, No_Name
); -- ???
536 Set_Char_Literal_Value
(B_Node
, 16#
0000#
);
537 Set_Entity
(B_Node
, Empty
);
538 Set_Etype
(B_Node
, Standard_Wide_Character
);
539 Set_Low_Bound
(R_Node
, B_Node
);
541 -- High bound for type Wide_Character
543 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
544 Set_Is_Static_Expression
(B_Node
);
545 Set_Chars
(B_Node
, No_Name
); -- ???
546 Set_Char_Literal_Value
(B_Node
, 16#FFFF#
);
547 Set_Entity
(B_Node
, Empty
);
548 Set_Etype
(B_Node
, Standard_Wide_Character
);
549 Set_High_Bound
(R_Node
, B_Node
);
551 Set_Scalar_Range
(Standard_Wide_Character
, R_Node
);
552 Set_Etype
(R_Node
, Standard_Wide_Character
);
553 Set_Parent
(R_Node
, Standard_Wide_Character
);
555 -- Create type definition node for type String
557 Tdef_Node
:= New_Node
(N_Unconstrained_Array_Definition
, Stloc
);
558 Set_Subtype_Indication
(Tdef_Node
, Identifier_For
(S_Character
));
559 Set_Subtype_Marks
(Tdef_Node
, New_List
);
560 Append
(Identifier_For
(S_Positive
), Subtype_Marks
(Tdef_Node
));
561 Set_Type_Definition
(Parent
(Standard_String
), Tdef_Node
);
563 Set_Ekind
(Standard_String
, E_String_Type
);
564 Set_Etype
(Standard_String
, Standard_String
);
565 Set_Component_Type
(Standard_String
, Standard_Character
);
566 Set_Component_Size
(Standard_String
, Uint_8
);
567 Init_Size_Align
(Standard_String
);
569 -- Set index type of String
572 (Subtype_Marks
(Type_Definition
(Parent
(Standard_String
))));
573 Set_First_Index
(Standard_String
, E_Id
);
574 Set_Entity
(E_Id
, Standard_Positive
);
575 Set_Etype
(E_Id
, Standard_Positive
);
577 -- Create type definition node for type Wide_String
579 Tdef_Node
:= New_Node
(N_Unconstrained_Array_Definition
, Stloc
);
580 Set_Subtype_Indication
(Tdef_Node
, Identifier_For
(S_Wide_Character
));
581 Set_Subtype_Marks
(Tdef_Node
, New_List
);
582 Append
(Identifier_For
(S_Positive
), Subtype_Marks
(Tdef_Node
));
583 Set_Type_Definition
(Parent
(Standard_Wide_String
), Tdef_Node
);
585 Set_Ekind
(Standard_Wide_String
, E_String_Type
);
586 Set_Etype
(Standard_Wide_String
, Standard_Wide_String
);
587 Set_Component_Type
(Standard_Wide_String
, Standard_Wide_Character
);
588 Set_Component_Size
(Standard_Wide_String
, Uint_16
);
589 Init_Size_Align
(Standard_Wide_String
);
591 -- Set index type of Wide_String
594 (Subtype_Marks
(Type_Definition
(Parent
(Standard_Wide_String
))));
595 Set_First_Index
(Standard_Wide_String
, E_Id
);
596 Set_Entity
(E_Id
, Standard_Positive
);
597 Set_Etype
(E_Id
, Standard_Positive
);
599 -- Create subtype declaration for Natural
601 Decl
:= New_Node
(N_Subtype_Declaration
, Stloc
);
602 Set_Defining_Identifier
(Decl
, Standard_Natural
);
603 Set_Subtype_Indication
(Decl
,
604 New_Occurrence_Of
(Standard_Integer
, Stloc
));
605 Append
(Decl
, Decl_S
);
607 Set_Ekind
(Standard_Natural
, E_Signed_Integer_Subtype
);
608 Set_Etype
(Standard_Natural
, Base_Type
(Standard_Integer
));
609 Init_Esize
(Standard_Natural
, Standard_Integer_Size
);
610 Init_RM_Size
(Standard_Natural
, Standard_Integer_Size
- 1);
611 Set_Prim_Alignment
(Standard_Natural
);
612 Set_Size_Known_At_Compile_Time
614 Set_Integer_Bounds
(Standard_Natural
,
615 Typ
=> Base_Type
(Standard_Integer
),
617 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
618 Set_Is_Constrained
(Standard_Natural
);
619 Set_Is_Frozen
(Standard_Natural
);
620 Set_Is_Public
(Standard_Natural
);
622 -- Create subtype declaration for Positive
624 Decl
:= New_Node
(N_Subtype_Declaration
, Stloc
);
625 Set_Defining_Identifier
(Decl
, Standard_Positive
);
626 Set_Subtype_Indication
(Decl
,
627 New_Occurrence_Of
(Standard_Integer
, Stloc
));
628 Append
(Decl
, Decl_S
);
630 Set_Ekind
(Standard_Positive
, E_Signed_Integer_Subtype
);
631 Set_Etype
(Standard_Positive
, Base_Type
(Standard_Integer
));
632 Init_Esize
(Standard_Positive
, Standard_Integer_Size
);
633 Init_RM_Size
(Standard_Positive
, Standard_Integer_Size
- 1);
634 Set_Prim_Alignment
(Standard_Positive
);
636 Set_Size_Known_At_Compile_Time
(Standard_Positive
);
638 Set_Integer_Bounds
(Standard_Positive
,
639 Typ
=> Base_Type
(Standard_Integer
),
641 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
642 Set_Is_Constrained
(Standard_Positive
);
643 Set_Is_Frozen
(Standard_Positive
);
644 Set_Is_Public
(Standard_Positive
);
646 -- Create declaration for package ASCII
648 Decl
:= New_Node
(N_Package_Declaration
, Stloc
);
649 Append
(Decl
, Decl_S
);
651 Pspec
:= New_Node
(N_Package_Specification
, Stloc
);
652 Set_Specification
(Decl
, Pspec
);
654 Set_Defining_Unit_Name
(Pspec
, Standard_Entity
(S_ASCII
));
655 Set_Ekind
(Standard_Entity
(S_ASCII
), E_Package
);
656 Decl_A
:= New_List
; -- for ASCII declarations
657 Set_Visible_Declarations
(Pspec
, Decl_A
);
659 -- Create control character definitions in package ASCII. Note that
660 -- the character literal entries created here correspond to literal
661 -- values that are impossible in the source, but can be represented
662 -- internally with no difficulties.
666 for S
in S_ASCII_Names
loop
667 Decl
:= New_Node
(N_Object_Declaration
, Staloc
);
668 Set_Constant_Present
(Decl
, True);
671 A_Char
: Entity_Id
:= Standard_Entity
(S
);
675 Set_Sloc
(A_Char
, Staloc
);
676 Set_Ekind
(A_Char
, E_Constant
);
677 Set_Not_Source_Assigned
(A_Char
, True);
678 Set_Is_True_Constant
(A_Char
, True);
679 Set_Etype
(A_Char
, Standard_Character
);
680 Set_Scope
(A_Char
, Standard_Entity
(S_ASCII
));
681 Set_Is_Immediately_Visible
(A_Char
, False);
682 Set_Is_Public
(A_Char
, True);
683 Set_Is_Known_Valid
(A_Char
, True);
685 Append_Entity
(A_Char
, Standard_Entity
(S_ASCII
));
686 Set_Defining_Identifier
(Decl
, A_Char
);
688 Set_Object_Definition
(Decl
, Identifier_For
(S_Character
));
689 Expr_Decl
:= New_Node
(N_Character_Literal
, Staloc
);
690 Set_Expression
(Decl
, Expr_Decl
);
692 Set_Is_Static_Expression
(Expr_Decl
);
693 Set_Chars
(Expr_Decl
, No_Name
);
694 Set_Etype
(Expr_Decl
, Standard_Character
);
695 Set_Char_Literal_Value
(Expr_Decl
, Ccode
);
698 Append
(Decl
, Decl_A
);
700 -- Increment character code, dealing with non-contiguities
704 if Ccode
= 16#
20#
then
706 elsif Ccode
= 16#
27#
then
708 elsif Ccode
= 16#
3C#
then
710 elsif Ccode
= 16#
41#
then
715 -- Create semantic phase entities
717 Standard_Void_Type
:= New_Standard_Entity
;
718 Set_Ekind
(Standard_Void_Type
, E_Void
);
719 Set_Etype
(Standard_Void_Type
, Standard_Void_Type
);
720 Init_Size_Align
(Standard_Void_Type
);
721 Set_Scope
(Standard_Void_Type
, Standard_Standard
);
722 Make_Name
(Standard_Void_Type
, "_void_type");
724 -- The type field of packages is set to void
726 Set_Etype
(Standard_Standard
, Standard_Void_Type
);
727 Set_Etype
(Standard_ASCII
, Standard_Void_Type
);
729 -- Standard_A_String is actually used in generated code, so it has a
730 -- type name that is reasonable, but does not overlap any Ada name.
732 Standard_A_String
:= New_Standard_Entity
;
733 Set_Ekind
(Standard_A_String
, E_Access_Type
);
734 Set_Scope
(Standard_A_String
, Standard_Standard
);
735 Set_Etype
(Standard_A_String
, Standard_A_String
);
738 Init_Size
(Standard_A_String
, System_Address_Size
);
740 Init_Size
(Standard_A_String
, System_Address_Size
* 2);
743 Init_Alignment
(Standard_A_String
);
745 Set_Directly_Designated_Type
746 (Standard_A_String
, Standard_String
);
747 Make_Name
(Standard_A_String
, "access_string");
749 Standard_A_Char
:= New_Standard_Entity
;
750 Set_Ekind
(Standard_A_Char
, E_Access_Type
);
751 Set_Scope
(Standard_A_Char
, Standard_Standard
);
752 Set_Etype
(Standard_A_Char
, Standard_A_String
);
753 Init_Size
(Standard_A_Char
, System_Address_Size
);
754 Set_Prim_Alignment
(Standard_A_Char
);
756 Set_Directly_Designated_Type
(Standard_A_Char
, Standard_Character
);
757 Make_Name
(Standard_A_Char
, "access_character");
759 -- Note on type names. The type names for the following special types
760 -- are constructed so that they will look reasonable should they ever
761 -- appear in error messages etc, although in practice the use of the
762 -- special insertion character } for types results in special handling
763 -- of these type names in any case. The blanks in these names would
764 -- trouble in Gigi, but that's OK here, since none of these types
765 -- should ever get through to Gigi! Attributes of these types are
766 -- filled out to minimize problems with cascaded errors (for example,
767 -- Any_Integer is given reasonable and consistent type and size values)
769 Any_Type
:= New_Standard_Entity
;
770 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
771 Set_Defining_Identifier
(Decl
, Any_Type
);
772 Set_Scope
(Any_Type
, Standard_Standard
);
773 Build_Signed_Integer_Type
(Any_Type
, Standard_Integer_Size
);
774 Make_Name
(Any_Type
, "any type");
776 Any_Id
:= New_Standard_Entity
;
777 Set_Ekind
(Any_Id
, E_Variable
);
778 Set_Scope
(Any_Id
, Standard_Standard
);
779 Set_Etype
(Any_Id
, Any_Type
);
780 Init_Size_Align
(Any_Id
);
781 Make_Name
(Any_Id
, "any id");
783 Any_Access
:= New_Standard_Entity
;
784 Set_Ekind
(Any_Access
, E_Access_Type
);
785 Set_Scope
(Any_Access
, Standard_Standard
);
786 Set_Etype
(Any_Access
, Any_Access
);
787 Init_Size
(Any_Access
, System_Address_Size
);
788 Set_Prim_Alignment
(Any_Access
);
789 Make_Name
(Any_Access
, "an access type");
791 Any_Array
:= New_Standard_Entity
;
792 Set_Ekind
(Any_Array
, E_String_Type
);
793 Set_Scope
(Any_Array
, Standard_Standard
);
794 Set_Etype
(Any_Array
, Any_Array
);
795 Set_Component_Type
(Any_Array
, Any_Character
);
796 Init_Size_Align
(Any_Array
);
797 Make_Name
(Any_Array
, "an array type");
799 Any_Boolean
:= New_Standard_Entity
;
800 Set_Ekind
(Any_Boolean
, E_Enumeration_Type
);
801 Set_Scope
(Any_Boolean
, Standard_Standard
);
802 Set_Etype
(Any_Boolean
, Standard_Boolean
);
803 Init_Esize
(Any_Boolean
, Standard_Character_Size
);
804 Init_RM_Size
(Any_Boolean
, 1);
805 Set_Prim_Alignment
(Any_Boolean
);
806 Set_Is_Unsigned_Type
(Any_Boolean
);
807 Set_Scalar_Range
(Any_Boolean
, Scalar_Range
(Standard_Boolean
));
808 Make_Name
(Any_Boolean
, "a boolean type");
810 Any_Character
:= New_Standard_Entity
;
811 Set_Ekind
(Any_Character
, E_Enumeration_Type
);
812 Set_Scope
(Any_Character
, Standard_Standard
);
813 Set_Etype
(Any_Character
, Any_Character
);
814 Set_Is_Unsigned_Type
(Any_Character
);
815 Set_Is_Character_Type
(Any_Character
);
816 Init_Esize
(Any_Character
, Standard_Character_Size
);
817 Init_RM_Size
(Any_Character
, 8);
818 Set_Prim_Alignment
(Any_Character
);
819 Set_Scalar_Range
(Any_Character
, Scalar_Range
(Standard_Character
));
820 Make_Name
(Any_Character
, "a character type");
822 Any_Composite
:= New_Standard_Entity
;
823 Set_Ekind
(Any_Composite
, E_Array_Type
);
824 Set_Scope
(Any_Composite
, Standard_Standard
);
825 Set_Etype
(Any_Composite
, Any_Composite
);
826 Set_Component_Size
(Any_Composite
, Uint_0
);
827 Set_Component_Type
(Any_Composite
, Standard_Integer
);
828 Init_Size_Align
(Any_Composite
);
829 Make_Name
(Any_Composite
, "a composite type");
831 Any_Discrete
:= New_Standard_Entity
;
832 Set_Ekind
(Any_Discrete
, E_Signed_Integer_Type
);
833 Set_Scope
(Any_Discrete
, Standard_Standard
);
834 Set_Etype
(Any_Discrete
, Any_Discrete
);
835 Init_Size
(Any_Discrete
, Standard_Integer_Size
);
836 Set_Prim_Alignment
(Any_Discrete
);
837 Make_Name
(Any_Discrete
, "a discrete type");
839 Any_Fixed
:= New_Standard_Entity
;
840 Set_Ekind
(Any_Fixed
, E_Ordinary_Fixed_Point_Type
);
841 Set_Scope
(Any_Fixed
, Standard_Standard
);
842 Set_Etype
(Any_Fixed
, Any_Fixed
);
843 Init_Size
(Any_Fixed
, Standard_Integer_Size
);
844 Set_Prim_Alignment
(Any_Fixed
);
845 Make_Name
(Any_Fixed
, "a fixed-point type");
847 Any_Integer
:= New_Standard_Entity
;
848 Set_Ekind
(Any_Integer
, E_Signed_Integer_Type
);
849 Set_Scope
(Any_Integer
, Standard_Standard
);
850 Set_Etype
(Any_Integer
, Standard_Long_Long_Integer
);
851 Init_Size
(Any_Integer
, Standard_Long_Long_Integer_Size
);
852 Set_Prim_Alignment
(Any_Integer
);
856 Typ
=> Base_Type
(Standard_Integer
),
858 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
859 Make_Name
(Any_Integer
, "an integer type");
861 Any_Modular
:= New_Standard_Entity
;
862 Set_Ekind
(Any_Modular
, E_Modular_Integer_Type
);
863 Set_Scope
(Any_Modular
, Standard_Standard
);
864 Set_Etype
(Any_Modular
, Standard_Long_Long_Integer
);
865 Init_Size
(Any_Modular
, Standard_Long_Long_Integer_Size
);
866 Set_Prim_Alignment
(Any_Modular
);
867 Set_Is_Unsigned_Type
(Any_Modular
);
868 Make_Name
(Any_Modular
, "a modular type");
870 Any_Numeric
:= New_Standard_Entity
;
871 Set_Ekind
(Any_Numeric
, E_Signed_Integer_Type
);
872 Set_Scope
(Any_Numeric
, Standard_Standard
);
873 Set_Etype
(Any_Numeric
, Standard_Long_Long_Integer
);
874 Init_Size
(Any_Numeric
, Standard_Long_Long_Integer_Size
);
875 Set_Prim_Alignment
(Any_Numeric
);
876 Make_Name
(Any_Numeric
, "a numeric type");
878 Any_Real
:= New_Standard_Entity
;
879 Set_Ekind
(Any_Real
, E_Floating_Point_Type
);
880 Set_Scope
(Any_Real
, Standard_Standard
);
881 Set_Etype
(Any_Real
, Standard_Long_Long_Float
);
882 Init_Size
(Any_Real
, Standard_Long_Long_Float_Size
);
883 Set_Prim_Alignment
(Any_Real
);
884 Make_Name
(Any_Real
, "a real type");
886 Any_Scalar
:= New_Standard_Entity
;
887 Set_Ekind
(Any_Scalar
, E_Signed_Integer_Type
);
888 Set_Scope
(Any_Scalar
, Standard_Standard
);
889 Set_Etype
(Any_Scalar
, Any_Scalar
);
890 Init_Size
(Any_Scalar
, Standard_Integer_Size
);
891 Set_Prim_Alignment
(Any_Scalar
);
892 Make_Name
(Any_Scalar
, "a scalar type");
894 Any_String
:= New_Standard_Entity
;
895 Set_Ekind
(Any_String
, E_String_Type
);
896 Set_Scope
(Any_String
, Standard_Standard
);
897 Set_Etype
(Any_String
, Any_String
);
898 Set_Component_Type
(Any_String
, Any_Character
);
899 Init_Size_Align
(Any_String
);
900 Make_Name
(Any_String
, "a string type");
909 Low_Bound
=> Make_Integer
(Uint_0
),
910 High_Bound
=> Make_Integer
(Uint_2
** Standard_Integer_Size
));
911 Indexes
:= New_List
(Index
);
912 Set_Etype
(Index
, Standard_Integer
);
913 Set_First_Index
(Any_String
, Index
);
916 Standard_Integer_8
:= New_Standard_Entity
;
917 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
918 Set_Defining_Identifier
(Decl
, Standard_Integer_8
);
919 Make_Name
(Standard_Integer_8
, "integer_8");
920 Set_Scope
(Standard_Integer_8
, Standard_Standard
);
921 Build_Signed_Integer_Type
(Standard_Integer_8
, 8);
923 Standard_Integer_16
:= New_Standard_Entity
;
924 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
925 Set_Defining_Identifier
(Decl
, Standard_Integer_16
);
926 Make_Name
(Standard_Integer_16
, "integer_16");
927 Set_Scope
(Standard_Integer_16
, Standard_Standard
);
928 Build_Signed_Integer_Type
(Standard_Integer_16
, 16);
930 Standard_Integer_32
:= New_Standard_Entity
;
931 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
932 Set_Defining_Identifier
(Decl
, Standard_Integer_32
);
933 Make_Name
(Standard_Integer_32
, "integer_32");
934 Set_Scope
(Standard_Integer_32
, Standard_Standard
);
935 Build_Signed_Integer_Type
(Standard_Integer_32
, 32);
937 Standard_Integer_64
:= New_Standard_Entity
;
938 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
939 Set_Defining_Identifier
(Decl
, Standard_Integer_64
);
940 Make_Name
(Standard_Integer_64
, "integer_64");
941 Set_Scope
(Standard_Integer_64
, Standard_Standard
);
942 Build_Signed_Integer_Type
(Standard_Integer_64
, 64);
944 Standard_Unsigned
:= New_Standard_Entity
;
945 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
946 Set_Defining_Identifier
(Decl
, Standard_Unsigned
);
947 Make_Name
(Standard_Unsigned
, "unsigned");
949 Set_Ekind
(Standard_Unsigned
, E_Modular_Integer_Type
);
950 Set_Scope
(Standard_Unsigned
, Standard_Standard
);
951 Set_Etype
(Standard_Unsigned
, Standard_Unsigned
);
952 Init_Size
(Standard_Unsigned
, Standard_Integer_Size
);
953 Set_Prim_Alignment
(Standard_Unsigned
);
954 Set_Modulus
(Standard_Unsigned
,
955 Uint_2
** Standard_Integer_Size
);
957 Set_Is_Unsigned_Type
(Standard_Unsigned
);
959 R_Node
:= New_Node
(N_Range
, Stloc
);
960 Set_Low_Bound
(R_Node
,
961 Make_Integer_Literal
(Stloc
, 0));
962 Set_High_Bound
(R_Node
,
963 Make_Integer_Literal
(Stloc
, Modulus
(Standard_Unsigned
)));
964 Set_Scalar_Range
(Standard_Unsigned
, R_Node
);
966 -- Note: universal integer and universal real are constructed as fully
967 -- formed signed numeric types, with parameters corresponding to the
968 -- longest runtime types (Long_Long_Integer and Long_Long_Float). This
969 -- allows Gigi to properly process references to universal types that
970 -- are not folded at compile time.
972 Universal_Integer
:= New_Standard_Entity
;
973 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
974 Set_Defining_Identifier
(Decl
, Universal_Integer
);
975 Make_Name
(Universal_Integer
, "universal_integer");
976 Set_Scope
(Universal_Integer
, Standard_Standard
);
977 Build_Signed_Integer_Type
978 (Universal_Integer
, Standard_Long_Long_Integer_Size
);
980 Universal_Real
:= New_Standard_Entity
;
981 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
982 Set_Defining_Identifier
(Decl
, Universal_Real
);
983 Make_Name
(Universal_Real
, "universal_real");
984 Set_Scope
(Universal_Real
, Standard_Standard
);
987 Standard_Long_Long_Float_Size
,
988 Standard_Long_Long_Float_Digits
);
990 -- Note: universal fixed, unlike universal integer and universal real,
991 -- is never used at runtime, so it does not need to have bounds set.
993 Universal_Fixed
:= New_Standard_Entity
;
994 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
995 Set_Defining_Identifier
(Decl
, Universal_Fixed
);
996 Make_Name
(Universal_Fixed
, "universal_fixed");
997 Set_Ekind
(Universal_Fixed
, E_Ordinary_Fixed_Point_Type
);
998 Set_Etype
(Universal_Fixed
, Universal_Fixed
);
999 Set_Scope
(Universal_Fixed
, Standard_Standard
);
1000 Init_Size
(Universal_Fixed
, Standard_Long_Long_Integer_Size
);
1001 Set_Prim_Alignment
(Universal_Fixed
);
1002 Set_Size_Known_At_Compile_Time
1005 -- Create type declaration for Duration, using a 64-bit size. The
1006 -- delta value depends on the mode we are running in:
1008 -- Normal mode or No_Run_Time mode when word size is 64 bits:
1009 -- 10**(-9) seconds, size is 64 bits
1011 -- No_Run_Time mode when word size is 32 bits:
1012 -- 10**(-4) seconds, oize is 32 bits
1014 Build_Duration
: declare
1018 Use_32_Bits
: constant Boolean :=
1019 No_Run_Time
and then System_Word_Size
= 32;
1023 Dlo
:= Intval
(Type_Low_Bound
(Standard_Integer_32
));
1024 Dhi
:= Intval
(Type_High_Bound
(Standard_Integer_32
));
1025 Delta_Val
:= UR_From_Components
(Uint_1
, Uint_4
, 10);
1028 Dlo
:= Intval
(Type_Low_Bound
(Standard_Integer_64
));
1029 Dhi
:= Intval
(Type_High_Bound
(Standard_Integer_64
));
1030 Delta_Val
:= UR_From_Components
(Uint_1
, Uint_9
, 10);
1034 Make_Full_Type_Declaration
(Stloc
,
1035 Defining_Identifier
=> Standard_Duration
,
1037 Make_Ordinary_Fixed_Point_Definition
(Stloc
,
1038 Delta_Expression
=> Make_Real_Literal
(Stloc
, Delta_Val
),
1039 Real_Range_Specification
=>
1040 Make_Real_Range_Specification
(Stloc
,
1041 Low_Bound
=> Make_Real_Literal
(Stloc
,
1042 Realval
=> Dlo
* Delta_Val
),
1043 High_Bound
=> Make_Real_Literal
(Stloc
,
1044 Realval
=> Dhi
* Delta_Val
))));
1046 Set_Ekind
(Standard_Duration
, E_Ordinary_Fixed_Point_Type
);
1047 Set_Etype
(Standard_Duration
, Standard_Duration
);
1050 Init_Size
(Standard_Duration
, 32);
1052 Init_Size
(Standard_Duration
, 64);
1055 Set_Prim_Alignment
(Standard_Duration
);
1056 Set_Delta_Value
(Standard_Duration
, Delta_Val
);
1057 Set_Small_Value
(Standard_Duration
, Delta_Val
);
1058 Set_Scalar_Range
(Standard_Duration
,
1059 Real_Range_Specification
1060 (Type_Definition
(Decl
)));
1062 -- Normally it does not matter that nodes in package Standard are
1063 -- not marked as analyzed. The Scalar_Range of the fixed-point
1064 -- type Standard_Duration is an exception, because of the special
1065 -- test made in Freeze.Freeze_Fixed_Point_Type.
1067 Set_Analyzed
(Scalar_Range
(Standard_Duration
));
1069 Set_Etype
(Type_High_Bound
(Standard_Duration
), Standard_Duration
);
1070 Set_Etype
(Type_Low_Bound
(Standard_Duration
), Standard_Duration
);
1072 Set_Is_Static_Expression
(Type_High_Bound
(Standard_Duration
));
1073 Set_Is_Static_Expression
(Type_Low_Bound
(Standard_Duration
));
1075 Set_Corresponding_Integer_Value
1076 (Type_High_Bound
(Standard_Duration
), Dhi
);
1078 Set_Corresponding_Integer_Value
1079 (Type_Low_Bound
(Standard_Duration
), Dlo
);
1081 Set_Size_Known_At_Compile_Time
(Standard_Duration
);
1084 -- Build standard exception type. Note that the type name here is
1085 -- actually used in the generated code, so it must be set correctly
1087 Standard_Exception_Type
:= New_Standard_Entity
;
1088 Set_Ekind
(Standard_Exception_Type
, E_Record_Type
);
1089 Set_Etype
(Standard_Exception_Type
, Standard_Exception_Type
);
1090 Set_Scope
(Standard_Exception_Type
, Standard_Standard
);
1091 Set_Girder_Constraint
1092 (Standard_Exception_Type
, No_Elist
);
1093 Init_Size_Align
(Standard_Exception_Type
);
1094 Set_Size_Known_At_Compile_Time
1095 (Standard_Exception_Type
, True);
1096 Make_Name
(Standard_Exception_Type
, "exception");
1098 Make_Component
(Standard_Exception_Type
, Standard_Boolean
,
1099 "Not_Handled_By_Others");
1100 Make_Component
(Standard_Exception_Type
, Standard_Character
, "Lang");
1101 Make_Component
(Standard_Exception_Type
, Standard_Natural
,
1103 Make_Component
(Standard_Exception_Type
, Standard_A_Char
,
1105 Make_Component
(Standard_Exception_Type
, Standard_A_Char
,
1107 Make_Component
(Standard_Exception_Type
, Standard_Integer
,
1110 -- Build tree for record declaration, for use by the back-end.
1113 Comp_List
: List_Id
;
1117 Comp
:= First_Entity
(Standard_Exception_Type
);
1118 Comp_List
:= New_List
;
1120 while Present
(Comp
) loop
1122 Make_Component_Declaration
(Stloc
,
1123 Defining_Identifier
=> Comp
,
1124 Subtype_Indication
=> New_Occurrence_Of
(Etype
(Comp
), Stloc
)),
1130 Decl
:= Make_Full_Type_Declaration
(Stloc
,
1131 Defining_Identifier
=> Standard_Exception_Type
,
1133 Make_Record_Definition
(Stloc
,
1136 Make_Component_List
(Stloc
,
1137 Component_Items
=> Comp_List
)));
1140 Append
(Decl
, Decl_S
);
1142 -- Create declarations of standard exceptions
1144 Build_Exception
(S_Constraint_Error
);
1145 Build_Exception
(S_Program_Error
);
1146 Build_Exception
(S_Storage_Error
);
1147 Build_Exception
(S_Tasking_Error
);
1149 -- Numeric_Error is a normal exception in Ada 83, but in Ada 95
1150 -- it is a renaming of Constraint_Error
1153 Build_Exception
(S_Numeric_Error
);
1156 Decl
:= New_Node
(N_Exception_Renaming_Declaration
, Stloc
);
1157 E_Id
:= Standard_Entity
(S_Numeric_Error
);
1159 Set_Ekind
(E_Id
, E_Exception
);
1160 Set_Exception_Code
(E_Id
, Uint_0
);
1161 Set_Etype
(E_Id
, Standard_Exception_Type
);
1162 Set_Is_Public
(E_Id
);
1163 Set_Renamed_Entity
(E_Id
, Standard_Entity
(S_Constraint_Error
));
1165 Set_Defining_Identifier
(Decl
, E_Id
);
1166 Append
(Decl
, Decl_S
);
1168 Ident_Node
:= New_Node
(N_Identifier
, Stloc
);
1169 Set_Chars
(Ident_Node
, Chars
(Standard_Entity
(S_Constraint_Error
)));
1170 Set_Entity
(Ident_Node
, Standard_Entity
(S_Constraint_Error
));
1171 Set_Name
(Decl
, Ident_Node
);
1174 -- Abort_Signal is an entity that does not get made visible
1176 Abort_Signal
:= New_Standard_Entity
;
1177 Set_Chars
(Abort_Signal
, Name_uAbort_Signal
);
1178 Set_Ekind
(Abort_Signal
, E_Exception
);
1179 Set_Exception_Code
(Abort_Signal
, Uint_0
);
1180 Set_Etype
(Abort_Signal
, Standard_Exception_Type
);
1181 Set_Scope
(Abort_Signal
, Standard_Standard
);
1182 Set_Is_Public
(Abort_Signal
, True);
1184 Make_Exception_Declaration
(Stloc
,
1185 Defining_Identifier
=> Abort_Signal
);
1187 -- Create defining identifiers for shift operator entities. Note
1188 -- that these entities are used only for marking shift operators
1189 -- generated internally, and hence need no structure, just a name
1190 -- and a unique identity.
1192 Standard_Op_Rotate_Left
:= New_Standard_Entity
;
1193 Set_Chars
(Standard_Op_Rotate_Left
, Name_Rotate_Left
);
1194 Set_Ekind
(Standard_Op_Rotate_Left
, E_Operator
);
1196 Standard_Op_Rotate_Right
:= New_Standard_Entity
;
1197 Set_Chars
(Standard_Op_Rotate_Right
, Name_Rotate_Right
);
1198 Set_Ekind
(Standard_Op_Rotate_Right
, E_Operator
);
1200 Standard_Op_Shift_Left
:= New_Standard_Entity
;
1201 Set_Chars
(Standard_Op_Shift_Left
, Name_Shift_Left
);
1202 Set_Ekind
(Standard_Op_Shift_Left
, E_Operator
);
1204 Standard_Op_Shift_Right
:= New_Standard_Entity
;
1205 Set_Chars
(Standard_Op_Shift_Right
, Name_Shift_Right
);
1206 Set_Ekind
(Standard_Op_Shift_Right
, E_Operator
);
1208 Standard_Op_Shift_Right_Arithmetic
:= New_Standard_Entity
;
1209 Set_Chars
(Standard_Op_Shift_Right_Arithmetic
,
1210 Name_Shift_Right_Arithmetic
);
1211 Set_Ekind
(Standard_Op_Shift_Right_Arithmetic
,
1214 -- Create standard operator declarations
1218 -- Initialize visibility table with entities in Standard
1220 for E
in Standard_Entity_Type
loop
1221 if Ekind
(Standard_Entity
(E
)) /= E_Operator
then
1223 (Chars
(Standard_Entity
(E
)), Standard_Entity
(E
));
1224 Set_Homonym
(Standard_Entity
(E
), Empty
);
1227 if E
not in S_ASCII_Names
then
1228 Set_Scope
(Standard_Entity
(E
), Standard_Standard
);
1229 Set_Is_Immediately_Visible
(Standard_Entity
(E
));
1233 -- The predefined package Standard itself does not have a scope;
1234 -- it is the only entity in the system not to have one, and this
1235 -- is what identifies the package to Gigi.
1237 Set_Scope
(Standard_Standard
, Empty
);
1239 -- Set global variables indicating last Id values and version
1241 Last_Standard_Node_Id
:= Last_Node_Id
;
1242 Last_Standard_List_Id
:= Last_List_Id
;
1244 -- The Error node has an Etype of Any_Type to help error recovery
1246 Set_Etype
(Error
, Any_Type
);
1247 end Create_Standard
;
1249 ------------------------------------
1250 -- Create_Unconstrained_Base_Type --
1251 ------------------------------------
1253 procedure Create_Unconstrained_Base_Type
1257 New_Ent
: constant Entity_Id
:= New_Copy
(E
);
1261 Set_Is_Constrained
(E
, True);
1262 Set_Etype
(E
, New_Ent
);
1264 Append_Entity
(New_Ent
, Standard_Standard
);
1265 Set_Is_Constrained
(New_Ent
, False);
1266 Set_Etype
(New_Ent
, New_Ent
);
1267 Set_Is_Known_Valid
(New_Ent
, True);
1269 if K
= E_Signed_Integer_Subtype
then
1270 Set_Etype
(Low_Bound
(Scalar_Range
(E
)), New_Ent
);
1271 Set_Etype
(High_Bound
(Scalar_Range
(E
)), New_Ent
);
1274 end Create_Unconstrained_Base_Type
;
1276 --------------------
1277 -- Identifier_For --
1278 --------------------
1280 function Identifier_For
(S
: Standard_Entity_Type
) return Node_Id
is
1281 Ident_Node
: Node_Id
;
1284 Ident_Node
:= New_Node
(N_Identifier
, Stloc
);
1285 Set_Chars
(Ident_Node
, Chars
(Standard_Entity
(S
)));
1289 --------------------
1290 -- Make_Component --
1291 --------------------
1293 procedure Make_Component
1298 Id
: Entity_Id
:= New_Standard_Entity
;
1301 Set_Ekind
(Id
, E_Component
);
1302 Set_Etype
(Id
, Typ
);
1303 Set_Scope
(Id
, Rec
);
1304 Init_Component_Location
(Id
);
1306 Set_Original_Record_Component
(Id
, Id
);
1307 Make_Name
(Id
, Nam
);
1308 Append_Entity
(Id
, Rec
);
1315 function Make_Formal
1317 Formal_Name
: String)
1323 Formal
:= New_Standard_Entity
;
1325 Set_Ekind
(Formal
, E_In_Parameter
);
1326 Set_Mechanism
(Formal
, Default_Mechanism
);
1327 Set_Scope
(Formal
, Standard_Standard
);
1328 Set_Etype
(Formal
, Typ
);
1329 Make_Name
(Formal
, Formal_Name
);
1338 function Make_Integer
(V
: Uint
) return Node_Id
is
1339 N
: constant Node_Id
:= Make_Integer_Literal
(Stloc
, V
);
1342 Set_Is_Static_Expression
(N
);
1350 procedure Make_Name
(Id
: Entity_Id
; Nam
: String) is
1352 for J
in 1 .. Nam
'Length loop
1353 Name_Buffer
(J
) := Fold_Lower
(Nam
(Nam
'First + (J
- 1)));
1356 Name_Len
:= Nam
'Length;
1357 Set_Chars
(Id
, Name_Find
);
1364 function New_Operator
(Op
: Name_Id
; Typ
: Entity_Id
) return Entity_Id
is
1365 Ident_Node
: Entity_Id
;
1368 Ident_Node
:= Make_Defining_Identifier
(Stloc
, Op
);
1370 Set_Is_Pure
(Ident_Node
, True);
1371 Set_Ekind
(Ident_Node
, E_Operator
);
1372 Set_Etype
(Ident_Node
, Typ
);
1373 Set_Scope
(Ident_Node
, Standard_Standard
);
1374 Set_Homonym
(Ident_Node
, Get_Name_Entity_Id
(Op
));
1375 Set_Convention
(Ident_Node
, Convention_Intrinsic
);
1377 Set_Is_Immediately_Visible
(Ident_Node
, True);
1378 Set_Is_Intrinsic_Subprogram
(Ident_Node
, True);
1380 Set_Name_Entity_Id
(Op
, Ident_Node
);
1381 Append_Entity
(Ident_Node
, Standard_Standard
);
1385 -------------------------
1386 -- New_Standard_Entity --
1387 -------------------------
1389 function New_Standard_Entity
1390 (New_Node_Kind
: Node_Kind
:= N_Defining_Identifier
)
1393 E
: constant Entity_Id
:= New_Entity
(New_Node_Kind
, Stloc
);
1396 -- All standard entities are Pure and Public
1401 -- All standard entity names are analyzed manually, and are thus
1402 -- frozen as soon as they are created.
1406 -- Set debug information required for all standard types
1408 Set_Needs_Debug_Info
(E
);
1410 -- All standard entities are built with fully qualified names, so
1411 -- set the flag to prevent an abortive attempt at requalification!
1413 Set_Has_Qualified_Name
(E
);
1415 -- Return newly created entity to be completed by caller
1418 end New_Standard_Entity
;
1420 ----------------------
1421 -- Set_Float_Bounds --
1422 ----------------------
1424 procedure Set_Float_Bounds
(Id
: Entity_Id
) is
1426 -- Low bound of literal value
1429 -- High bound of literal value
1432 -- Range specification
1434 Digs
: constant Nat
:= UI_To_Int
(Digits_Value
(Id
));
1435 -- Digits value, used to select bounds
1438 -- Note: for the call from Cstand to initially create the types in
1439 -- Standard, Vax_Float will always be False. Circuitry in Sem_Vfpt
1440 -- will adjust these types appropriately in the Vax_Float case if
1441 -- a pragma Float_Representation (VAX_Float) is used.
1443 if Vax_Float
(Id
) then
1444 if Digs
= VAXFF_Digits
then
1446 (VAXFF_First
'Universal_Literal_String);
1448 (VAXFF_Last
'Universal_Literal_String);
1450 elsif Digs
= VAXDF_Digits
then
1452 (VAXDF_First
'Universal_Literal_String);
1454 (VAXDF_Last
'Universal_Literal_String);
1457 pragma Assert
(Digs
= VAXGF_Digits
);
1460 (VAXGF_First
'Universal_Literal_String);
1462 (VAXGF_Last
'Universal_Literal_String);
1465 elsif Is_AAMP_Float
(Id
) then
1466 if Digs
= AAMPS_Digits
then
1468 (AAMPS_First
'Universal_Literal_String);
1470 (AAMPS_Last
'Universal_Literal_String);
1473 pragma Assert
(Digs
= AAMPL_Digits
);
1475 (AAMPL_First
'Universal_Literal_String);
1477 (AAMPL_Last
'Universal_Literal_String);
1480 elsif Digs
= IEEES_Digits
then
1482 (IEEES_First
'Universal_Literal_String);
1484 (IEEES_Last
'Universal_Literal_String);
1486 elsif Digs
= IEEEL_Digits
then
1488 (IEEEL_First
'Universal_Literal_String);
1490 (IEEEL_Last
'Universal_Literal_String);
1493 pragma Assert
(Digs
= IEEEX_Digits
);
1496 (IEEEX_First
'Universal_Literal_String);
1498 (IEEEX_Last
'Universal_Literal_String);
1502 Set_Is_Static_Expression
(L
);
1505 Set_Is_Static_Expression
(H
);
1507 R
:= New_Node
(N_Range
, Stloc
);
1508 Set_Low_Bound
(R
, L
);
1509 Set_High_Bound
(R
, H
);
1510 Set_Includes_Infinities
(R
, True);
1511 Set_Scalar_Range
(Id
, R
);
1514 end Set_Float_Bounds
;
1516 ------------------------
1517 -- Set_Integer_Bounds --
1518 ------------------------
1520 procedure Set_Integer_Bounds
1526 L
: Node_Id
; -- Low bound of literal value
1527 H
: Node_Id
; -- High bound of literal value
1528 R
: Node_Id
; -- Range specification
1531 L
:= Make_Integer
(Lb
);
1532 H
:= Make_Integer
(Hb
);
1537 R
:= New_Node
(N_Range
, Stloc
);
1538 Set_Low_Bound
(R
, L
);
1539 Set_High_Bound
(R
, H
);
1540 Set_Scalar_Range
(Id
, R
);
1543 Set_Is_Unsigned_Type
(Id
, Lb
>= 0);
1544 end Set_Integer_Bounds
;