1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2018, 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 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
27 with Csets
; use Csets
;
28 with Debug
; use Debug
;
29 with Einfo
; use Einfo
;
30 with Elists
; use Elists
;
31 with Layout
; use Layout
;
32 with Namet
; use Namet
;
33 with Nlists
; use Nlists
;
34 with Nmake
; use Nmake
;
36 with Output
; use Output
;
37 with Set_Targ
; use Set_Targ
;
38 with Targparm
; use Targparm
;
39 with Tbuild
; use Tbuild
;
40 with Ttypes
; use Ttypes
;
41 with Sem_Mech
; use Sem_Mech
;
42 with Sem_Util
; use Sem_Util
;
43 with Sinfo
; use Sinfo
;
44 with Snames
; use Snames
;
45 with Stand
; use Stand
;
46 with Uintp
; use Uintp
;
47 with Urealp
; use Urealp
;
49 package body CStand
is
51 Stloc
: constant Source_Ptr
:= Standard_Location
;
52 Staloc
: constant Source_Ptr
:= Standard_ASCII_Location
;
53 -- Standard abbreviations used throughout this package
55 Back_End_Float_Types
: Elist_Id
:= No_Elist
;
56 -- List used for any floating point supported by the back end. This needs
57 -- to be at the library level, because the call back procedures retrieving
58 -- this information are at that level.
60 -----------------------
61 -- Local Subprograms --
62 -----------------------
64 procedure Build_Float_Type
70 -- Procedure to build standard predefined float base type. The first
71 -- parameter is the entity for the type. The second parameter is the
72 -- digits value. The third parameter indicates the representation to
73 -- be used for the type. The fourth parameter is the size in bits.
74 -- The fifth parameter is the alignment in storage units. Each type
75 -- is added to the list of predefined floating point types.
77 -- Note that both RM_Size and Esize are set to the specified size, i.e.
78 -- we do not set the RM_Size to the precision passed by the back end.
79 -- This is consistent with the semantics of 'Size specified in the RM
80 -- because we cannot pack components of the type tighter than this size.
82 procedure Build_Signed_Integer_Type
(E
: Entity_Id
; Siz
: Nat
);
83 -- Procedure to build standard predefined signed integer subtype. The
84 -- first parameter is the entity for the subtype. The second parameter
85 -- is the size in bits. The corresponding base type is not built by
86 -- this routine but instead must be built by the caller where needed.
88 procedure Build_Unsigned_Integer_Type
92 -- Procedure to build standard predefined unsigned integer subtype. These
93 -- subtypes are not user visible, but they are used internally. The first
94 -- parameter is the entity for the subtype. The second parameter is the
95 -- size in bits. The third parameter is an identifying name.
97 procedure Copy_Float_Type
(To
: Entity_Id
; From
: Entity_Id
);
98 -- Build a floating point type, copying representation details from From.
99 -- This is used to create predefined floating point types based on
100 -- available types in the back end.
102 procedure Create_Operators
;
103 -- Make entries for each of the predefined operators in Standard
105 procedure Create_Unconstrained_Base_Type
108 -- The predefined signed integer types are constrained subtypes which
109 -- must have a corresponding unconstrained base type. This type is almost
110 -- useless. The only place it has semantics is Subtypes_Statically_Match.
111 -- Consequently, we arrange for it to be identical apart from the setting
112 -- of the constrained bit. This routine takes an entity E for the Type,
113 -- copies it to estabish the base type, then resets the Ekind of the
114 -- original entity to K (the Ekind for the subtype). The Etype field of
115 -- E is set by the call (to point to the created base type entity), and
116 -- also the Is_Constrained flag of E is set.
118 -- To understand the exact requirement for this, see RM 3.5.4(11) which
119 -- makes it clear that Integer, for example, is constrained, with the
120 -- constraint bounds matching the bounds of the (unconstrained) base
121 -- type. The point is that Integer and Integer'Base have identical
122 -- bounds, but do not statically match, since a subtype with constraints
123 -- never matches a subtype with no constraints.
125 function Find_Back_End_Float_Type
(Name
: String) return Entity_Id
;
126 -- Return the first float type in Back_End_Float_Types with the given name.
127 -- Names of entities in back end types, are either type names of C
128 -- predefined types (all lower case), or mode names (upper case).
129 -- These are not generally valid identifier names.
131 function Identifier_For
(S
: Standard_Entity_Type
) return Node_Id
;
132 -- Returns an identifier node with the same name as the defining
133 -- identifier corresponding to the given Standard_Entity_Type value
135 procedure Make_Component
139 -- Build a record component with the given type and name, and append to
140 -- the list of components of Rec.
144 Formal_Name
: String) return Entity_Id
;
145 -- Construct entity for subprogram formal with given name and type
147 function Make_Integer
(V
: Uint
) return Node_Id
;
148 -- Builds integer literal with given value
150 procedure Make_Name
(Id
: Entity_Id
; Nam
: String);
151 -- Make an entry in the names table for Nam, and set as Chars field of Id
153 function New_Operator
(Op
: Name_Id
; Typ
: Entity_Id
) return Entity_Id
;
154 -- Build entity for standard operator with given name and type
156 function New_Standard_Entity
157 (New_Node_Kind
: Node_Kind
:= N_Defining_Identifier
) return Entity_Id
;
158 -- Builds a new entity for Standard
160 function New_Standard_Entity
(S
: String) return Entity_Id
;
161 -- Builds a new entity for Standard with Nkind = N_Defining_Identifier,
162 -- and Chars of this defining identifier set to the given string S.
164 procedure Print_Standard
;
165 -- Print representation of package Standard if switch set
167 procedure Register_Float_Type
170 Float_Rep
: Float_Rep_Kind
;
171 Precision
: Positive;
173 Alignment
: Natural);
174 -- Registers a single back end floating-point type (from FPT_Mode_Table in
175 -- Set_Targ). This will create a predefined floating-point base type for
176 -- one of the floating point types reported by the back end, and add it
177 -- to the list of predefined float types. Name is the name of the type
178 -- as a normal format (non-null-terminated) string. Digs is the number of
179 -- digits, which is always non-zero, since non-floating-point types were
180 -- filtered out earlier. Float_Rep indicates the kind of floating-point
181 -- type, and Precision, Size and Alignment are the precision, size and
182 -- alignment in bits.
184 procedure Set_Integer_Bounds
189 -- Procedure to set bounds for integer type or subtype. Id is the entity
190 -- whose bounds and type are to be set. The Typ parameter is the Etype
191 -- value for the entity (which will be the same as Id for all predefined
192 -- integer base types. The third and fourth parameters are the bounds.
194 ----------------------
195 -- Build_Float_Type --
196 ----------------------
198 procedure Build_Float_Type
201 Rep
: Float_Rep_Kind
;
206 Set_Type_Definition
(Parent
(E
),
207 Make_Floating_Point_Definition
(Stloc
,
208 Digits_Expression
=> Make_Integer
(UI_From_Int
(Digs
))));
210 Set_Ekind
(E
, E_Floating_Point_Type
);
212 Init_Digits_Value
(E
, Digs
);
213 Set_Float_Rep
(E
, Rep
);
215 Set_Elem_Alignment
(E
, Align
);
216 Set_Float_Bounds
(E
);
219 Set_Size_Known_At_Compile_Time
(E
);
220 end Build_Float_Type
;
222 ------------------------------
223 -- Find_Back_End_Float_Type --
224 ------------------------------
226 function Find_Back_End_Float_Type
(Name
: String) return Entity_Id
is
230 N
:= First_Elmt
(Back_End_Float_Types
);
231 while Present
(N
) and then Get_Name_String
(Chars
(Node
(N
))) /= Name
237 end Find_Back_End_Float_Type
;
239 -------------------------------
240 -- Build_Signed_Integer_Type --
241 -------------------------------
243 procedure Build_Signed_Integer_Type
(E
: Entity_Id
; Siz
: Nat
) is
244 U2Siz1
: constant Uint
:= 2 ** (Siz
- 1);
245 Lbound
: constant Uint
:= -U2Siz1
;
246 Ubound
: constant Uint
:= U2Siz1
- 1;
249 Set_Type_Definition
(Parent
(E
),
250 Make_Signed_Integer_Type_Definition
(Stloc
,
251 Low_Bound
=> Make_Integer
(Lbound
),
252 High_Bound
=> Make_Integer
(Ubound
)));
254 Set_Ekind
(E
, E_Signed_Integer_Type
);
257 Set_Elem_Alignment
(E
);
258 Set_Integer_Bounds
(E
, E
, Lbound
, Ubound
);
261 Set_Is_Known_Valid
(E
);
262 Set_Size_Known_At_Compile_Time
(E
);
263 end Build_Signed_Integer_Type
;
265 ---------------------------------
266 -- Build_Unsigned_Integer_Type --
267 ---------------------------------
269 procedure Build_Unsigned_Integer_Type
278 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
279 Set_Defining_Identifier
(Decl
, Uns
);
280 Make_Name
(Uns
, Nam
);
282 Set_Ekind
(Uns
, E_Modular_Integer_Type
);
283 Set_Scope
(Uns
, Standard_Standard
);
284 Set_Etype
(Uns
, Uns
);
285 Init_Size
(Uns
, Siz
);
286 Set_Elem_Alignment
(Uns
);
287 Set_Modulus
(Uns
, Uint_2
** Siz
);
288 Set_Is_Unsigned_Type
(Uns
);
289 Set_Size_Known_At_Compile_Time
(Uns
);
290 Set_Is_Known_Valid
(Uns
, True);
292 R_Node
:= New_Node
(N_Range
, Stloc
);
293 Set_Low_Bound
(R_Node
, Make_Integer
(Uint_0
));
294 Set_High_Bound
(R_Node
, Make_Integer
(Modulus
(Uns
) - 1));
295 Set_Etype
(Low_Bound
(R_Node
), Uns
);
296 Set_Etype
(High_Bound
(R_Node
), Uns
);
297 Set_Scalar_Range
(Uns
, R_Node
);
298 end Build_Unsigned_Integer_Type
;
300 ---------------------
301 -- Copy_Float_Type --
302 ---------------------
304 procedure Copy_Float_Type
(To
: Entity_Id
; From
: Entity_Id
) is
307 (To
, UI_To_Int
(Digits_Value
(From
)), Float_Rep
(From
),
308 UI_To_Int
(Esize
(From
)), UI_To_Int
(Alignment
(From
)));
311 ----------------------
312 -- Create_Operators --
313 ----------------------
315 -- Each operator has an abbreviated signature. The formals have the names
316 -- LEFT and RIGHT. Their types are not actually used for resolution.
318 procedure Create_Operators
is
321 -- The following tables define the binary and unary operators and their
322 -- corresponding result type.
324 Binary_Ops
: constant array (S_Binary_Ops
) of Name_Id
:=
326 -- There is one entry here for each binary operator, except for the
327 -- case of concatenation, where there are three entries, one for a
328 -- String result, one for Wide_String, and one for Wide_Wide_String.
350 Bin_Op_Types
: constant array (S_Binary_Ops
) of Entity_Id
:=
352 -- This table has the corresponding result types. The entries are
353 -- ordered so they correspond to the Binary_Ops array above.
355 (Universal_Integer
, -- Add
356 Standard_Boolean
, -- And
357 Standard_String
, -- Concat (String)
358 Standard_Wide_String
, -- Concat (Wide_String)
359 Standard_Wide_Wide_String
, -- Concat (Wide_Wide_String)
360 Universal_Integer
, -- Divide
361 Standard_Boolean
, -- Eq
362 Universal_Integer
, -- Expon
363 Standard_Boolean
, -- Ge
364 Standard_Boolean
, -- Gt
365 Standard_Boolean
, -- Le
366 Standard_Boolean
, -- Lt
367 Universal_Integer
, -- Mod
368 Universal_Integer
, -- Multiply
369 Standard_Boolean
, -- Ne
370 Standard_Boolean
, -- Or
371 Universal_Integer
, -- Rem
372 Universal_Integer
, -- Subtract
373 Standard_Boolean
); -- Xor
375 Unary_Ops
: constant array (S_Unary_Ops
) of Name_Id
:=
377 -- There is one entry here for each unary operator
384 Unary_Op_Types
: constant array (S_Unary_Ops
) of Entity_Id
:=
386 -- This table has the corresponding result types. The entries are
387 -- ordered so they correspond to the Unary_Ops array above.
389 (Universal_Integer
, -- Abs
390 Universal_Integer
, -- Subtract
391 Standard_Boolean
, -- Not
392 Universal_Integer
); -- Add
395 for J
in S_Binary_Ops
loop
396 Op_Node
:= New_Operator
(Binary_Ops
(J
), Bin_Op_Types
(J
));
398 Append_Entity
(Make_Formal
(Any_Type
, "LEFT"), Op_Node
);
399 Append_Entity
(Make_Formal
(Any_Type
, "RIGHT"), Op_Node
);
402 for J
in S_Unary_Ops
loop
403 Op_Node
:= New_Operator
(Unary_Ops
(J
), Unary_Op_Types
(J
));
405 Append_Entity
(Make_Formal
(Any_Type
, "RIGHT"), Op_Node
);
408 -- For concatenation, we create a separate operator for each
409 -- array type. This simplifies the resolution of the component-
410 -- component concatenation operation. In Standard, we set the types
411 -- of the formals for string, wide [wide]_string, concatenations.
413 Set_Etype
(First_Entity
(Standard_Op_Concat
), Standard_String
);
414 Set_Etype
(Last_Entity
(Standard_Op_Concat
), Standard_String
);
416 Set_Etype
(First_Entity
(Standard_Op_Concatw
), Standard_Wide_String
);
417 Set_Etype
(Last_Entity
(Standard_Op_Concatw
), Standard_Wide_String
);
419 Set_Etype
(First_Entity
(Standard_Op_Concatww
),
420 Standard_Wide_Wide_String
);
422 Set_Etype
(Last_Entity
(Standard_Op_Concatww
),
423 Standard_Wide_Wide_String
);
424 end Create_Operators
;
426 ---------------------
427 -- Create_Standard --
428 ---------------------
430 -- The tree for the package Standard is prefixed to all compilations.
431 -- Several entities required by semantic analysis are denoted by global
432 -- variables that are initialized to point to the corresponding occurrences
433 -- in Standard. The visible entities of Standard are created here. Special
434 -- entities maybe created here as well or may be created from the semantics
435 -- module. By not adding them to the Decls list of Standard they will not
436 -- be visible to Ada programs.
438 procedure Create_Standard
is
439 Decl_S
: constant List_Id
:= New_List
;
440 -- List of declarations in Standard
442 Decl_A
: constant List_Id
:= New_List
;
443 -- List of declarations in ASCII
448 Ident_Node
: Node_Id
;
454 procedure Build_Exception
(S
: Standard_Entity_Type
);
455 -- Procedure to declare given entity as an exception
457 procedure Create_Back_End_Float_Types
;
458 -- Initialize the Back_End_Float_Types list by having the back end
459 -- enumerate all available types and building type entities for them.
461 procedure Create_Float_Types
;
462 -- Creates entities for all predefined floating point types, and
463 -- adds these to the Predefined_Float_Types list in package Standard.
465 procedure Make_Dummy_Index
(E
: Entity_Id
);
466 -- Called to provide a dummy index field value for Any_Array/Any_String
468 procedure Pack_String_Type
(String_Type
: Entity_Id
);
469 -- Generate proper tree for pragma Pack that applies to given type, and
470 -- mark type as having the pragma.
472 ---------------------
473 -- Build_Exception --
474 ---------------------
476 procedure Build_Exception
(S
: Standard_Entity_Type
) is
478 Set_Ekind
(Standard_Entity
(S
), E_Exception
);
479 Set_Etype
(Standard_Entity
(S
), Standard_Exception_Type
);
480 Set_Is_Public
(Standard_Entity
(S
), True);
483 Make_Exception_Declaration
(Stloc
,
484 Defining_Identifier
=> Standard_Entity
(S
));
485 Append
(Decl
, Decl_S
);
488 ---------------------------------
489 -- Create_Back_End_Float_Types --
490 ---------------------------------
492 procedure Create_Back_End_Float_Types
is
494 for J
in 1 .. Num_FPT_Modes
loop
496 E
: FPT_Mode_Entry
renames FPT_Mode_Table
(J
);
499 (E
.NAME
.all, E
.DIGS
, E
.FLOAT_REP
, E
.PRECISION
, E
.SIZE
,
503 end Create_Back_End_Float_Types
;
505 ------------------------
506 -- Create_Float_Types --
507 ------------------------
509 procedure Create_Float_Types
is
511 -- Create type definition nodes for predefined float types
514 (Standard_Short_Float
,
515 Find_Back_End_Float_Type
(C_Type_For
(S_Short_Float
)));
516 Set_Is_Implementation_Defined
(Standard_Short_Float
);
518 Copy_Float_Type
(Standard_Float
, Standard_Short_Float
);
521 (Standard_Long_Float
,
522 Find_Back_End_Float_Type
(C_Type_For
(S_Long_Float
)));
525 (Standard_Long_Long_Float
,
526 Find_Back_End_Float_Type
(C_Type_For
(S_Long_Long_Float
)));
527 Set_Is_Implementation_Defined
(Standard_Long_Long_Float
);
529 Predefined_Float_Types
:= New_Elmt_List
;
531 Append_Elmt
(Standard_Short_Float
, Predefined_Float_Types
);
532 Append_Elmt
(Standard_Float
, Predefined_Float_Types
);
533 Append_Elmt
(Standard_Long_Float
, Predefined_Float_Types
);
534 Append_Elmt
(Standard_Long_Long_Float
, Predefined_Float_Types
);
536 -- Any other back end types are appended at the end of the list of
537 -- predefined float types, and will only be selected if the none of
538 -- the types in Standard is suitable, or if a specific named type is
539 -- requested through a pragma Import.
541 while not Is_Empty_Elmt_List
(Back_End_Float_Types
) loop
543 E
: constant Elmt_Id
:= First_Elmt
(Back_End_Float_Types
);
545 Append_Elmt
(Node
(E
), To
=> Predefined_Float_Types
);
546 Remove_Elmt
(Back_End_Float_Types
, E
);
549 end Create_Float_Types
;
551 ----------------------
552 -- Make_Dummy_Index --
553 ----------------------
555 procedure Make_Dummy_Index
(E
: Entity_Id
) is
561 Make_Range
(Sloc
(E
),
562 Low_Bound
=> Make_Integer
(Uint_0
),
563 High_Bound
=> Make_Integer
(Uint_2
** Standard_Integer_Size
));
564 Set_Etype
(Index
, Standard_Integer
);
565 Set_First_Index
(E
, Index
);
567 -- Make sure Index is a list as required, so Next_Index is Empty
569 Dummy
:= New_List
(Index
);
570 end Make_Dummy_Index
;
572 ----------------------
573 -- Pack_String_Type --
574 ----------------------
576 procedure Pack_String_Type
(String_Type
: Entity_Id
) is
577 Prag
: constant Node_Id
:=
580 Pragma_Argument_Associations
=>
582 Make_Pragma_Argument_Association
(Stloc
,
583 Expression
=> New_Occurrence_Of
(String_Type
, Stloc
))));
585 Append
(Prag
, Decl_S
);
586 Record_Rep_Item
(String_Type
, Prag
);
587 Set_Has_Pragma_Pack
(String_Type
, True);
588 end Pack_String_Type
;
590 -- Start of processing for Create_Standard
593 -- First step is to create defining identifiers for each entity
595 for S
in Standard_Entity_Type
loop
597 S_Name
: constant String := Standard_Entity_Type
'Image (S
);
598 -- Name of entity (note we skip S_ at the start)
600 Ident_Node
: Node_Id
;
601 -- Defining identifier node
604 Ident_Node
:= New_Standard_Entity
;
605 Make_Name
(Ident_Node
, S_Name
(3 .. S_Name
'Length));
606 Standard_Entity
(S
) := Ident_Node
;
610 -- Create package declaration node for package Standard
612 Standard_Package_Node
:= New_Node
(N_Package_Declaration
, Stloc
);
614 Pspec
:= New_Node
(N_Package_Specification
, Stloc
);
615 Set_Specification
(Standard_Package_Node
, Pspec
);
617 Set_Defining_Unit_Name
(Pspec
, Standard_Standard
);
618 Set_Visible_Declarations
(Pspec
, Decl_S
);
620 Set_Ekind
(Standard_Standard
, E_Package
);
621 Set_Is_Pure
(Standard_Standard
);
622 Set_Is_Compilation_Unit
(Standard_Standard
);
624 -- Create type/subtype declaration nodes for standard types
626 for S
in S_Types
loop
628 -- Subtype declaration case
630 if S
= S_Natural
or else S
= S_Positive
then
631 Decl
:= New_Node
(N_Subtype_Declaration
, Stloc
);
632 Set_Subtype_Indication
(Decl
,
633 New_Occurrence_Of
(Standard_Integer
, Stloc
));
635 -- Full type declaration case
638 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
641 Set_Is_Frozen
(Standard_Entity
(S
));
642 Set_Is_Public
(Standard_Entity
(S
));
643 Set_Defining_Identifier
(Decl
, Standard_Entity
(S
));
644 Append
(Decl
, Decl_S
);
647 Create_Back_End_Float_Types
;
649 -- Create type definition node for type Boolean. The Size is set to
650 -- 1 as required by Ada 95 and current ARG interpretations for Ada/83.
652 -- Note: Object_Size of Boolean is 8. This means that we do NOT in
653 -- general know that Boolean variables have valid values, so we do
654 -- not set the Is_Known_Valid flag.
656 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
657 Set_Literals
(Tdef_Node
, New_List
);
658 Append
(Standard_False
, Literals
(Tdef_Node
));
659 Append
(Standard_True
, Literals
(Tdef_Node
));
660 Set_Type_Definition
(Parent
(Standard_Boolean
), Tdef_Node
);
662 Set_Ekind
(Standard_Boolean
, E_Enumeration_Type
);
663 Set_First_Literal
(Standard_Boolean
, Standard_False
);
664 Set_Etype
(Standard_Boolean
, Standard_Boolean
);
665 Init_Esize
(Standard_Boolean
, Standard_Character_Size
);
666 Init_RM_Size
(Standard_Boolean
, 1);
667 Set_Elem_Alignment
(Standard_Boolean
);
669 Set_Is_Unsigned_Type
(Standard_Boolean
);
670 Set_Size_Known_At_Compile_Time
(Standard_Boolean
);
671 Set_Has_Pragma_Ordered
(Standard_Boolean
);
673 Set_Ekind
(Standard_True
, E_Enumeration_Literal
);
674 Set_Etype
(Standard_True
, Standard_Boolean
);
675 Set_Enumeration_Pos
(Standard_True
, Uint_1
);
676 Set_Enumeration_Rep
(Standard_True
, Uint_1
);
677 Set_Is_Known_Valid
(Standard_True
, True);
679 Set_Ekind
(Standard_False
, E_Enumeration_Literal
);
680 Set_Etype
(Standard_False
, Standard_Boolean
);
681 Set_Enumeration_Pos
(Standard_False
, Uint_0
);
682 Set_Enumeration_Rep
(Standard_False
, Uint_0
);
683 Set_Is_Known_Valid
(Standard_False
, True);
685 -- For the bounds of Boolean, we create a range node corresponding to
687 -- range False .. True
689 -- where the occurrences of the literals must point to the
690 -- corresponding definition.
692 R_Node
:= New_Node
(N_Range
, Stloc
);
693 B_Node
:= New_Node
(N_Identifier
, Stloc
);
694 Set_Chars
(B_Node
, Chars
(Standard_False
));
695 Set_Entity
(B_Node
, Standard_False
);
696 Set_Etype
(B_Node
, Standard_Boolean
);
697 Set_Is_Static_Expression
(B_Node
);
698 Set_Low_Bound
(R_Node
, B_Node
);
700 B_Node
:= New_Node
(N_Identifier
, Stloc
);
701 Set_Chars
(B_Node
, Chars
(Standard_True
));
702 Set_Entity
(B_Node
, Standard_True
);
703 Set_Etype
(B_Node
, Standard_Boolean
);
704 Set_Is_Static_Expression
(B_Node
);
705 Set_High_Bound
(R_Node
, B_Node
);
707 Set_Scalar_Range
(Standard_Boolean
, R_Node
);
708 Set_Etype
(R_Node
, Standard_Boolean
);
709 Set_Parent
(R_Node
, Standard_Boolean
);
711 -- Record entity identifiers for boolean literals in the
712 -- Boolean_Literals array, for easy reference during expansion.
714 Boolean_Literals
:= (False => Standard_False
, True => Standard_True
);
716 -- Create type definition nodes for predefined integer types
718 Build_Signed_Integer_Type
719 (Standard_Short_Short_Integer
, Standard_Short_Short_Integer_Size
);
721 Build_Signed_Integer_Type
722 (Standard_Short_Integer
, Standard_Short_Integer_Size
);
723 Set_Is_Implementation_Defined
(Standard_Short_Integer
);
725 Build_Signed_Integer_Type
726 (Standard_Integer
, Standard_Integer_Size
);
728 Build_Signed_Integer_Type
729 (Standard_Long_Integer
, Standard_Long_Integer_Size
);
731 Build_Signed_Integer_Type
732 (Standard_Long_Long_Integer
, Standard_Long_Long_Integer_Size
);
733 Set_Is_Implementation_Defined
(Standard_Long_Long_Integer
);
735 Create_Unconstrained_Base_Type
736 (Standard_Short_Short_Integer
, E_Signed_Integer_Subtype
);
737 Set_Is_Implementation_Defined
(Standard_Short_Short_Integer
);
739 Create_Unconstrained_Base_Type
740 (Standard_Short_Integer
, E_Signed_Integer_Subtype
);
742 Create_Unconstrained_Base_Type
743 (Standard_Integer
, E_Signed_Integer_Subtype
);
745 Create_Unconstrained_Base_Type
746 (Standard_Long_Integer
, E_Signed_Integer_Subtype
);
748 Create_Unconstrained_Base_Type
749 (Standard_Long_Long_Integer
, E_Signed_Integer_Subtype
);
750 Set_Is_Implementation_Defined
(Standard_Short_Short_Integer
);
754 -- Create type definition node for type Character. Note that we do not
755 -- set the Literals field, since type Character is handled with special
756 -- routine that do not need a literal list.
758 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
759 Set_Type_Definition
(Parent
(Standard_Character
), Tdef_Node
);
761 Set_Ekind
(Standard_Character
, E_Enumeration_Type
);
762 Set_Etype
(Standard_Character
, Standard_Character
);
763 Init_Esize
(Standard_Character
, Standard_Character_Size
);
764 Init_RM_Size
(Standard_Character
, 8);
765 Set_Elem_Alignment
(Standard_Character
);
767 Set_Has_Pragma_Ordered
(Standard_Character
);
768 Set_Is_Unsigned_Type
(Standard_Character
);
769 Set_Is_Character_Type
(Standard_Character
);
770 Set_Is_Known_Valid
(Standard_Character
);
771 Set_Size_Known_At_Compile_Time
(Standard_Character
);
773 -- Create the bounds for type Character
775 R_Node
:= New_Node
(N_Range
, Stloc
);
777 -- Low bound for type Character (Standard.Nul)
779 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
780 Set_Is_Static_Expression
(B_Node
);
781 Set_Chars
(B_Node
, No_Name
);
782 Set_Char_Literal_Value
(B_Node
, Uint_0
);
783 Set_Entity
(B_Node
, Empty
);
784 Set_Etype
(B_Node
, Standard_Character
);
785 Set_Low_Bound
(R_Node
, B_Node
);
787 -- High bound for type Character
789 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
790 Set_Is_Static_Expression
(B_Node
);
791 Set_Chars
(B_Node
, No_Name
);
792 Set_Char_Literal_Value
(B_Node
, UI_From_Int
(16#FF#
));
793 Set_Entity
(B_Node
, Empty
);
794 Set_Etype
(B_Node
, Standard_Character
);
795 Set_High_Bound
(R_Node
, B_Node
);
797 Set_Scalar_Range
(Standard_Character
, R_Node
);
798 Set_Etype
(R_Node
, Standard_Character
);
799 Set_Parent
(R_Node
, Standard_Character
);
801 -- Create type definition for type Wide_Character. Note that we do not
802 -- set the Literals field, since type Wide_Character is handled with
803 -- special routines that do not need a literal list.
805 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
806 Set_Type_Definition
(Parent
(Standard_Wide_Character
), Tdef_Node
);
808 Set_Ekind
(Standard_Wide_Character
, E_Enumeration_Type
);
809 Set_Etype
(Standard_Wide_Character
, Standard_Wide_Character
);
810 Init_Size
(Standard_Wide_Character
, Standard_Wide_Character_Size
);
812 Set_Elem_Alignment
(Standard_Wide_Character
);
813 Set_Has_Pragma_Ordered
(Standard_Wide_Character
);
814 Set_Is_Unsigned_Type
(Standard_Wide_Character
);
815 Set_Is_Character_Type
(Standard_Wide_Character
);
816 Set_Is_Known_Valid
(Standard_Wide_Character
);
817 Set_Size_Known_At_Compile_Time
(Standard_Wide_Character
);
819 -- Create the bounds for type Wide_Character
821 R_Node
:= New_Node
(N_Range
, Stloc
);
823 -- Low bound for type Wide_Character
825 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
826 Set_Is_Static_Expression
(B_Node
);
827 Set_Chars
(B_Node
, No_Name
); -- ???
828 Set_Char_Literal_Value
(B_Node
, Uint_0
);
829 Set_Entity
(B_Node
, Empty
);
830 Set_Etype
(B_Node
, Standard_Wide_Character
);
831 Set_Low_Bound
(R_Node
, B_Node
);
833 -- High bound for type Wide_Character
835 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
836 Set_Is_Static_Expression
(B_Node
);
837 Set_Chars
(B_Node
, No_Name
); -- ???
838 Set_Char_Literal_Value
(B_Node
, UI_From_Int
(16#FFFF#
));
839 Set_Entity
(B_Node
, Empty
);
840 Set_Etype
(B_Node
, Standard_Wide_Character
);
841 Set_High_Bound
(R_Node
, B_Node
);
843 Set_Scalar_Range
(Standard_Wide_Character
, R_Node
);
844 Set_Etype
(R_Node
, Standard_Wide_Character
);
845 Set_Parent
(R_Node
, Standard_Wide_Character
);
847 -- Create type definition for type Wide_Wide_Character. Note that we
848 -- do not set the Literals field, since type Wide_Wide_Character is
849 -- handled with special routines that do not need a literal list.
851 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
852 Set_Type_Definition
(Parent
(Standard_Wide_Wide_Character
), Tdef_Node
);
854 Set_Ekind
(Standard_Wide_Wide_Character
, E_Enumeration_Type
);
855 Set_Etype
(Standard_Wide_Wide_Character
,
856 Standard_Wide_Wide_Character
);
857 Init_Size
(Standard_Wide_Wide_Character
,
858 Standard_Wide_Wide_Character_Size
);
860 Set_Elem_Alignment
(Standard_Wide_Wide_Character
);
861 Set_Has_Pragma_Ordered
(Standard_Wide_Wide_Character
);
862 Set_Is_Unsigned_Type
(Standard_Wide_Wide_Character
);
863 Set_Is_Character_Type
(Standard_Wide_Wide_Character
);
864 Set_Is_Known_Valid
(Standard_Wide_Wide_Character
);
865 Set_Size_Known_At_Compile_Time
(Standard_Wide_Wide_Character
);
866 Set_Is_Ada_2005_Only
(Standard_Wide_Wide_Character
);
868 -- Create the bounds for type Wide_Wide_Character
870 R_Node
:= New_Node
(N_Range
, Stloc
);
872 -- Low bound for type Wide_Wide_Character
874 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
875 Set_Is_Static_Expression
(B_Node
);
876 Set_Chars
(B_Node
, No_Name
); -- ???
877 Set_Char_Literal_Value
(B_Node
, Uint_0
);
878 Set_Entity
(B_Node
, Empty
);
879 Set_Etype
(B_Node
, Standard_Wide_Wide_Character
);
880 Set_Low_Bound
(R_Node
, B_Node
);
882 -- High bound for type Wide_Wide_Character
884 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
885 Set_Is_Static_Expression
(B_Node
);
886 Set_Chars
(B_Node
, No_Name
); -- ???
887 Set_Char_Literal_Value
(B_Node
, UI_From_Int
(16#
7FFF_FFFF#
));
888 Set_Entity
(B_Node
, Empty
);
889 Set_Etype
(B_Node
, Standard_Wide_Wide_Character
);
890 Set_High_Bound
(R_Node
, B_Node
);
892 Set_Scalar_Range
(Standard_Wide_Wide_Character
, R_Node
);
893 Set_Etype
(R_Node
, Standard_Wide_Wide_Character
);
894 Set_Parent
(R_Node
, Standard_Wide_Wide_Character
);
896 -- Create type definition node for type String
898 Tdef_Node
:= New_Node
(N_Unconstrained_Array_Definition
, Stloc
);
901 CompDef_Node
: Node_Id
;
903 CompDef_Node
:= New_Node
(N_Component_Definition
, Stloc
);
904 Set_Aliased_Present
(CompDef_Node
, False);
905 Set_Access_Definition
(CompDef_Node
, Empty
);
906 Set_Subtype_Indication
(CompDef_Node
, Identifier_For
(S_Character
));
907 Set_Component_Definition
(Tdef_Node
, CompDef_Node
);
910 Set_Subtype_Marks
(Tdef_Node
, New_List
);
911 Append
(Identifier_For
(S_Positive
), Subtype_Marks
(Tdef_Node
));
912 Set_Type_Definition
(Parent
(Standard_String
), Tdef_Node
);
914 Set_Ekind
(Standard_String
, E_Array_Type
);
915 Set_Etype
(Standard_String
, Standard_String
);
916 Set_Component_Type
(Standard_String
, Standard_Character
);
917 Set_Component_Size
(Standard_String
, Uint_8
);
918 Init_Size_Align
(Standard_String
);
919 Set_Alignment
(Standard_String
, Uint_1
);
920 Pack_String_Type
(Standard_String
);
922 -- On targets where a storage unit is larger than a byte (such as AAMP),
923 -- pragma Pack has a real effect on the representation of type String,
924 -- and the type must be marked as having a nonstandard representation.
926 if System_Storage_Unit
> Uint_8
then
927 Set_Has_Non_Standard_Rep
(Standard_String
);
928 Set_Has_Pragma_Pack
(Standard_String
);
931 -- Set index type of String
934 First
(Subtype_Marks
(Type_Definition
(Parent
(Standard_String
))));
935 Set_First_Index
(Standard_String
, E_Id
);
936 Set_Entity
(E_Id
, Standard_Positive
);
937 Set_Etype
(E_Id
, Standard_Positive
);
939 -- Create type definition node for type Wide_String
941 Tdef_Node
:= New_Node
(N_Unconstrained_Array_Definition
, Stloc
);
944 CompDef_Node
: Node_Id
;
946 CompDef_Node
:= New_Node
(N_Component_Definition
, Stloc
);
947 Set_Aliased_Present
(CompDef_Node
, False);
948 Set_Access_Definition
(CompDef_Node
, Empty
);
949 Set_Subtype_Indication
(CompDef_Node
,
950 Identifier_For
(S_Wide_Character
));
951 Set_Component_Definition
(Tdef_Node
, CompDef_Node
);
954 Set_Subtype_Marks
(Tdef_Node
, New_List
);
955 Append
(Identifier_For
(S_Positive
), Subtype_Marks
(Tdef_Node
));
956 Set_Type_Definition
(Parent
(Standard_Wide_String
), Tdef_Node
);
958 Set_Ekind
(Standard_Wide_String
, E_Array_Type
);
959 Set_Etype
(Standard_Wide_String
, Standard_Wide_String
);
960 Set_Component_Type
(Standard_Wide_String
, Standard_Wide_Character
);
961 Set_Component_Size
(Standard_Wide_String
, Uint_16
);
962 Init_Size_Align
(Standard_Wide_String
);
963 Pack_String_Type
(Standard_Wide_String
);
965 -- Set index type of Wide_String
969 (Subtype_Marks
(Type_Definition
(Parent
(Standard_Wide_String
))));
970 Set_First_Index
(Standard_Wide_String
, E_Id
);
971 Set_Entity
(E_Id
, Standard_Positive
);
972 Set_Etype
(E_Id
, Standard_Positive
);
974 -- Create type definition node for type Wide_Wide_String
976 Tdef_Node
:= New_Node
(N_Unconstrained_Array_Definition
, Stloc
);
979 CompDef_Node
: Node_Id
;
981 CompDef_Node
:= New_Node
(N_Component_Definition
, Stloc
);
982 Set_Aliased_Present
(CompDef_Node
, False);
983 Set_Access_Definition
(CompDef_Node
, Empty
);
984 Set_Subtype_Indication
(CompDef_Node
,
985 Identifier_For
(S_Wide_Wide_Character
));
986 Set_Component_Definition
(Tdef_Node
, CompDef_Node
);
989 Set_Subtype_Marks
(Tdef_Node
, New_List
);
990 Append
(Identifier_For
(S_Positive
), Subtype_Marks
(Tdef_Node
));
991 Set_Type_Definition
(Parent
(Standard_Wide_Wide_String
), Tdef_Node
);
993 Set_Ekind
(Standard_Wide_Wide_String
, E_Array_Type
);
994 Set_Etype
(Standard_Wide_Wide_String
,
995 Standard_Wide_Wide_String
);
996 Set_Component_Type
(Standard_Wide_Wide_String
,
997 Standard_Wide_Wide_Character
);
998 Set_Component_Size
(Standard_Wide_Wide_String
, Uint_32
);
999 Init_Size_Align
(Standard_Wide_Wide_String
);
1000 Set_Is_Ada_2005_Only
(Standard_Wide_Wide_String
);
1001 Pack_String_Type
(Standard_Wide_Wide_String
);
1003 -- Set index type of Wide_Wide_String
1008 (Type_Definition
(Parent
(Standard_Wide_Wide_String
))));
1009 Set_First_Index
(Standard_Wide_Wide_String
, E_Id
);
1010 Set_Entity
(E_Id
, Standard_Positive
);
1011 Set_Etype
(E_Id
, Standard_Positive
);
1013 -- Setup entity for Natural
1015 Set_Ekind
(Standard_Natural
, E_Signed_Integer_Subtype
);
1016 Set_Etype
(Standard_Natural
, Base_Type
(Standard_Integer
));
1017 Init_Esize
(Standard_Natural
, Standard_Integer_Size
);
1018 Init_RM_Size
(Standard_Natural
, Standard_Integer_Size
- 1);
1019 Set_Elem_Alignment
(Standard_Natural
);
1020 Set_Size_Known_At_Compile_Time
1022 Set_Integer_Bounds
(Standard_Natural
,
1023 Typ
=> Base_Type
(Standard_Integer
),
1025 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
1026 Set_Is_Constrained
(Standard_Natural
);
1028 -- Setup entity for Positive
1030 Set_Ekind
(Standard_Positive
, E_Signed_Integer_Subtype
);
1031 Set_Etype
(Standard_Positive
, Base_Type
(Standard_Integer
));
1032 Init_Esize
(Standard_Positive
, Standard_Integer_Size
);
1033 Init_RM_Size
(Standard_Positive
, Standard_Integer_Size
- 1);
1034 Set_Elem_Alignment
(Standard_Positive
);
1036 Set_Size_Known_At_Compile_Time
(Standard_Positive
);
1038 Set_Integer_Bounds
(Standard_Positive
,
1039 Typ
=> Base_Type
(Standard_Integer
),
1041 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
1042 Set_Is_Constrained
(Standard_Positive
);
1044 -- Create declaration for package ASCII
1046 Decl
:= New_Node
(N_Package_Declaration
, Stloc
);
1047 Append
(Decl
, Decl_S
);
1049 Pspec
:= New_Node
(N_Package_Specification
, Stloc
);
1050 Set_Specification
(Decl
, Pspec
);
1052 Set_Defining_Unit_Name
(Pspec
, Standard_Entity
(S_ASCII
));
1053 Set_Ekind
(Standard_Entity
(S_ASCII
), E_Package
);
1054 Set_Visible_Declarations
(Pspec
, Decl_A
);
1056 -- Create control character definitions in package ASCII. Note that
1057 -- the character literal entries created here correspond to literal
1058 -- values that are impossible in the source, but can be represented
1059 -- internally with no difficulties.
1063 for S
in S_ASCII_Names
loop
1064 Decl
:= New_Node
(N_Object_Declaration
, Staloc
);
1065 Set_Constant_Present
(Decl
, True);
1068 A_Char
: constant Entity_Id
:= Standard_Entity
(S
);
1069 Expr_Decl
: Node_Id
;
1072 Set_Sloc
(A_Char
, Staloc
);
1073 Set_Ekind
(A_Char
, E_Constant
);
1074 Set_Never_Set_In_Source
(A_Char
, True);
1075 Set_Is_True_Constant
(A_Char
, True);
1076 Set_Etype
(A_Char
, Standard_Character
);
1077 Set_Scope
(A_Char
, Standard_Entity
(S_ASCII
));
1078 Set_Is_Immediately_Visible
(A_Char
, False);
1079 Set_Is_Public
(A_Char
, True);
1080 Set_Is_Known_Valid
(A_Char
, True);
1082 Append_Entity
(A_Char
, Standard_Entity
(S_ASCII
));
1083 Set_Defining_Identifier
(Decl
, A_Char
);
1085 Set_Object_Definition
(Decl
, Identifier_For
(S_Character
));
1086 Expr_Decl
:= New_Node
(N_Character_Literal
, Staloc
);
1087 Set_Expression
(Decl
, Expr_Decl
);
1089 Set_Is_Static_Expression
(Expr_Decl
);
1090 Set_Chars
(Expr_Decl
, No_Name
);
1091 Set_Etype
(Expr_Decl
, Standard_Character
);
1092 Set_Char_Literal_Value
(Expr_Decl
, UI_From_Int
(Int
(Ccode
)));
1095 Append
(Decl
, Decl_A
);
1097 -- Increment character code, dealing with non-contiguities
1101 if Ccode
= 16#
20#
then
1103 elsif Ccode
= 16#
27#
then
1105 elsif Ccode
= 16#
3C#
then
1107 elsif Ccode
= 16#
41#
then
1112 -- Create semantic phase entities
1114 Standard_Void_Type
:= New_Standard_Entity
;
1115 Set_Ekind
(Standard_Void_Type
, E_Void
);
1116 Set_Etype
(Standard_Void_Type
, Standard_Void_Type
);
1117 Set_Scope
(Standard_Void_Type
, Standard_Standard
);
1118 Make_Name
(Standard_Void_Type
, "_void_type");
1120 -- The type field of packages is set to void
1122 Set_Etype
(Standard_Standard
, Standard_Void_Type
);
1123 Set_Etype
(Standard_ASCII
, Standard_Void_Type
);
1125 -- Standard_A_String is actually used in generated code, so it has a
1126 -- type name that is reasonable, but does not overlap any Ada name.
1128 Standard_A_String
:= New_Standard_Entity
;
1129 Set_Ekind
(Standard_A_String
, E_Access_Type
);
1130 Set_Scope
(Standard_A_String
, Standard_Standard
);
1131 Set_Etype
(Standard_A_String
, Standard_A_String
);
1133 if Debug_Flag_6
then
1134 Init_Size
(Standard_A_String
, System_Address_Size
);
1136 Init_Size
(Standard_A_String
, System_Address_Size
* 2);
1139 Init_Alignment
(Standard_A_String
);
1141 Set_Directly_Designated_Type
1142 (Standard_A_String
, Standard_String
);
1143 Make_Name
(Standard_A_String
, "access_string");
1145 Standard_A_Char
:= New_Standard_Entity
;
1146 Set_Ekind
(Standard_A_Char
, E_Access_Type
);
1147 Set_Scope
(Standard_A_Char
, Standard_Standard
);
1148 Set_Etype
(Standard_A_Char
, Standard_A_String
);
1149 Init_Size
(Standard_A_Char
, System_Address_Size
);
1150 Set_Elem_Alignment
(Standard_A_Char
);
1152 Set_Directly_Designated_Type
(Standard_A_Char
, Standard_Character
);
1153 Make_Name
(Standard_A_Char
, "access_character");
1155 -- Standard_Debug_Renaming_Type is used for the special objects created
1156 -- to encode the names occurring in renaming declarations for use by the
1157 -- debugger (see exp_dbug.adb). The type is a zero-sized subtype of
1158 -- Standard.Integer.
1160 Standard_Debug_Renaming_Type
:= New_Standard_Entity
;
1162 Set_Ekind
(Standard_Debug_Renaming_Type
, E_Signed_Integer_Subtype
);
1163 Set_Scope
(Standard_Debug_Renaming_Type
, Standard_Standard
);
1164 Set_Etype
(Standard_Debug_Renaming_Type
, Base_Type
(Standard_Integer
));
1165 Init_Esize
(Standard_Debug_Renaming_Type
, 0);
1166 Init_RM_Size
(Standard_Debug_Renaming_Type
, 0);
1167 Set_Size_Known_At_Compile_Time
(Standard_Debug_Renaming_Type
);
1168 Set_Integer_Bounds
(Standard_Debug_Renaming_Type
,
1169 Typ
=> Base_Type
(Standard_Debug_Renaming_Type
),
1172 Set_Is_Constrained
(Standard_Debug_Renaming_Type
);
1173 Set_Has_Size_Clause
(Standard_Debug_Renaming_Type
);
1175 Make_Name
(Standard_Debug_Renaming_Type
, "_renaming_type");
1177 -- Note on type names. The type names for the following special types
1178 -- are constructed so that they will look reasonable should they ever
1179 -- appear in error messages etc, although in practice the use of the
1180 -- special insertion character } for types results in special handling
1181 -- of these type names in any case. The blanks in these names would
1182 -- trouble in Gigi, but that's OK here, since none of these types
1183 -- should ever get through to Gigi. Attributes of these types are
1184 -- filled out to minimize problems with cascaded errors (for example,
1185 -- Any_Integer is given reasonable and consistent type and size values)
1187 Any_Type
:= New_Standard_Entity
("any type");
1188 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1189 Set_Defining_Identifier
(Decl
, Any_Type
);
1190 Set_Scope
(Any_Type
, Standard_Standard
);
1191 Build_Signed_Integer_Type
(Any_Type
, Standard_Integer_Size
);
1193 Any_Id
:= New_Standard_Entity
("any id");
1194 Set_Ekind
(Any_Id
, E_Variable
);
1195 Set_Scope
(Any_Id
, Standard_Standard
);
1196 Set_Etype
(Any_Id
, Any_Type
);
1197 Init_Esize
(Any_Id
);
1198 Init_Alignment
(Any_Id
);
1200 Any_Access
:= New_Standard_Entity
("an access type");
1201 Set_Ekind
(Any_Access
, E_Access_Type
);
1202 Set_Scope
(Any_Access
, Standard_Standard
);
1203 Set_Etype
(Any_Access
, Any_Access
);
1204 Init_Size
(Any_Access
, System_Address_Size
);
1205 Set_Elem_Alignment
(Any_Access
);
1206 Set_Directly_Designated_Type
1207 (Any_Access
, Any_Type
);
1209 Any_Character
:= New_Standard_Entity
("a character type");
1210 Set_Ekind
(Any_Character
, E_Enumeration_Type
);
1211 Set_Scope
(Any_Character
, Standard_Standard
);
1212 Set_Etype
(Any_Character
, Any_Character
);
1213 Set_Is_Unsigned_Type
(Any_Character
);
1214 Set_Is_Character_Type
(Any_Character
);
1215 Init_Esize
(Any_Character
, Standard_Character_Size
);
1216 Init_RM_Size
(Any_Character
, 8);
1217 Set_Elem_Alignment
(Any_Character
);
1218 Set_Scalar_Range
(Any_Character
, Scalar_Range
(Standard_Character
));
1220 Any_Array
:= New_Standard_Entity
("an array type");
1221 Set_Ekind
(Any_Array
, E_Array_Type
);
1222 Set_Scope
(Any_Array
, Standard_Standard
);
1223 Set_Etype
(Any_Array
, Any_Array
);
1224 Set_Component_Type
(Any_Array
, Any_Character
);
1225 Init_Size_Align
(Any_Array
);
1226 Make_Dummy_Index
(Any_Array
);
1228 Any_Boolean
:= New_Standard_Entity
("a boolean type");
1229 Set_Ekind
(Any_Boolean
, E_Enumeration_Type
);
1230 Set_Scope
(Any_Boolean
, Standard_Standard
);
1231 Set_Etype
(Any_Boolean
, Standard_Boolean
);
1232 Init_Esize
(Any_Boolean
, Standard_Character_Size
);
1233 Init_RM_Size
(Any_Boolean
, 1);
1234 Set_Elem_Alignment
(Any_Boolean
);
1235 Set_Is_Unsigned_Type
(Any_Boolean
);
1236 Set_Scalar_Range
(Any_Boolean
, Scalar_Range
(Standard_Boolean
));
1238 Any_Composite
:= New_Standard_Entity
("a composite type");
1239 Set_Ekind
(Any_Composite
, E_Array_Type
);
1240 Set_Scope
(Any_Composite
, Standard_Standard
);
1241 Set_Etype
(Any_Composite
, Any_Composite
);
1242 Set_Component_Size
(Any_Composite
, Uint_0
);
1243 Set_Component_Type
(Any_Composite
, Standard_Integer
);
1244 Init_Size_Align
(Any_Composite
);
1246 Any_Discrete
:= New_Standard_Entity
("a discrete type");
1247 Set_Ekind
(Any_Discrete
, E_Signed_Integer_Type
);
1248 Set_Scope
(Any_Discrete
, Standard_Standard
);
1249 Set_Etype
(Any_Discrete
, Any_Discrete
);
1250 Init_Size
(Any_Discrete
, Standard_Integer_Size
);
1251 Set_Elem_Alignment
(Any_Discrete
);
1253 Any_Fixed
:= New_Standard_Entity
("a fixed-point type");
1254 Set_Ekind
(Any_Fixed
, E_Ordinary_Fixed_Point_Type
);
1255 Set_Scope
(Any_Fixed
, Standard_Standard
);
1256 Set_Etype
(Any_Fixed
, Any_Fixed
);
1257 Init_Size
(Any_Fixed
, Standard_Integer_Size
);
1258 Set_Elem_Alignment
(Any_Fixed
);
1260 Any_Integer
:= New_Standard_Entity
("an integer type");
1261 Set_Ekind
(Any_Integer
, E_Signed_Integer_Type
);
1262 Set_Scope
(Any_Integer
, Standard_Standard
);
1263 Set_Etype
(Any_Integer
, Standard_Long_Long_Integer
);
1264 Init_Size
(Any_Integer
, Standard_Long_Long_Integer_Size
);
1265 Set_Elem_Alignment
(Any_Integer
);
1269 Typ
=> Base_Type
(Standard_Integer
),
1271 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
1273 Any_Modular
:= New_Standard_Entity
("a modular type");
1274 Set_Ekind
(Any_Modular
, E_Modular_Integer_Type
);
1275 Set_Scope
(Any_Modular
, Standard_Standard
);
1276 Set_Etype
(Any_Modular
, Standard_Long_Long_Integer
);
1277 Init_Size
(Any_Modular
, Standard_Long_Long_Integer_Size
);
1278 Set_Elem_Alignment
(Any_Modular
);
1279 Set_Is_Unsigned_Type
(Any_Modular
);
1281 Any_Numeric
:= New_Standard_Entity
("a numeric type");
1282 Set_Ekind
(Any_Numeric
, E_Signed_Integer_Type
);
1283 Set_Scope
(Any_Numeric
, Standard_Standard
);
1284 Set_Etype
(Any_Numeric
, Standard_Long_Long_Integer
);
1285 Init_Size
(Any_Numeric
, Standard_Long_Long_Integer_Size
);
1286 Set_Elem_Alignment
(Any_Numeric
);
1288 Any_Real
:= New_Standard_Entity
("a real type");
1289 Set_Ekind
(Any_Real
, E_Floating_Point_Type
);
1290 Set_Scope
(Any_Real
, Standard_Standard
);
1291 Set_Etype
(Any_Real
, Standard_Long_Long_Float
);
1292 Init_Size
(Any_Real
,
1293 UI_To_Int
(Esize
(Standard_Long_Long_Float
)));
1294 Set_Elem_Alignment
(Any_Real
);
1296 Any_Scalar
:= New_Standard_Entity
("a scalar type");
1297 Set_Ekind
(Any_Scalar
, E_Signed_Integer_Type
);
1298 Set_Scope
(Any_Scalar
, Standard_Standard
);
1299 Set_Etype
(Any_Scalar
, Any_Scalar
);
1300 Init_Size
(Any_Scalar
, Standard_Integer_Size
);
1301 Set_Elem_Alignment
(Any_Scalar
);
1303 Any_String
:= New_Standard_Entity
("a string type");
1304 Set_Ekind
(Any_String
, E_Array_Type
);
1305 Set_Scope
(Any_String
, Standard_Standard
);
1306 Set_Etype
(Any_String
, Any_String
);
1307 Set_Component_Type
(Any_String
, Any_Character
);
1308 Init_Size_Align
(Any_String
);
1309 Make_Dummy_Index
(Any_String
);
1311 Raise_Type
:= New_Standard_Entity
("raise type");
1312 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1313 Set_Defining_Identifier
(Decl
, Raise_Type
);
1314 Set_Scope
(Raise_Type
, Standard_Standard
);
1315 Build_Signed_Integer_Type
(Raise_Type
, Standard_Integer_Size
);
1317 Standard_Integer_8
:= New_Standard_Entity
("integer_8");
1318 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1319 Set_Defining_Identifier
(Decl
, Standard_Integer_8
);
1320 Set_Scope
(Standard_Integer_8
, Standard_Standard
);
1321 Build_Signed_Integer_Type
(Standard_Integer_8
, 8);
1323 Standard_Integer_16
:= New_Standard_Entity
("integer_16");
1324 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1325 Set_Defining_Identifier
(Decl
, Standard_Integer_16
);
1326 Set_Scope
(Standard_Integer_16
, Standard_Standard
);
1327 Build_Signed_Integer_Type
(Standard_Integer_16
, 16);
1329 Standard_Integer_32
:= New_Standard_Entity
("integer_32");
1330 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1331 Set_Defining_Identifier
(Decl
, Standard_Integer_32
);
1332 Set_Scope
(Standard_Integer_32
, Standard_Standard
);
1333 Build_Signed_Integer_Type
(Standard_Integer_32
, 32);
1335 Standard_Integer_64
:= New_Standard_Entity
("integer_64");
1336 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1337 Set_Defining_Identifier
(Decl
, Standard_Integer_64
);
1338 Set_Scope
(Standard_Integer_64
, Standard_Standard
);
1339 Build_Signed_Integer_Type
(Standard_Integer_64
, 64);
1341 -- Standard_*_Unsigned subtypes are not user visible, but they are
1342 -- used internally. They are unsigned types with the same length as
1343 -- the correspondingly named signed integer types.
1345 Standard_Short_Short_Unsigned
:= New_Standard_Entity
;
1346 Build_Unsigned_Integer_Type
1347 (Standard_Short_Short_Unsigned
,
1348 Standard_Short_Short_Integer_Size
,
1349 "short_short_unsigned");
1351 Standard_Short_Unsigned
:= New_Standard_Entity
;
1352 Build_Unsigned_Integer_Type
1353 (Standard_Short_Unsigned
,
1354 Standard_Short_Integer_Size
,
1357 Standard_Unsigned
:= New_Standard_Entity
;
1358 Build_Unsigned_Integer_Type
1360 Standard_Integer_Size
,
1363 Standard_Long_Unsigned
:= New_Standard_Entity
;
1364 Build_Unsigned_Integer_Type
1365 (Standard_Long_Unsigned
,
1366 Standard_Long_Integer_Size
,
1369 Standard_Long_Long_Unsigned
:= New_Standard_Entity
;
1370 Build_Unsigned_Integer_Type
1371 (Standard_Long_Long_Unsigned
,
1372 Standard_Long_Long_Integer_Size
,
1373 "long_long_unsigned");
1375 -- Standard_Unsigned_64 is not user visible, but is used internally. It
1376 -- is an unsigned type mod 2**64, 64-bits unsigned, size is 64.
1378 Standard_Unsigned_64
:= New_Standard_Entity
;
1379 Build_Unsigned_Integer_Type
(Standard_Unsigned_64
, 64, "unsigned_64");
1381 -- Note: universal integer and universal real are constructed as fully
1382 -- formed signed numeric types, with parameters corresponding to the
1383 -- longest runtime types (Long_Long_Integer and Long_Long_Float). This
1384 -- allows Gigi to properly process references to universal types that
1385 -- are not folded at compile time.
1387 Universal_Integer
:= New_Standard_Entity
;
1388 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1389 Set_Defining_Identifier
(Decl
, Universal_Integer
);
1390 Make_Name
(Universal_Integer
, "universal_integer");
1391 Set_Scope
(Universal_Integer
, Standard_Standard
);
1392 Build_Signed_Integer_Type
1393 (Universal_Integer
, Standard_Long_Long_Integer_Size
);
1395 Universal_Real
:= New_Standard_Entity
;
1396 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1397 Set_Defining_Identifier
(Decl
, Universal_Real
);
1398 Make_Name
(Universal_Real
, "universal_real");
1399 Set_Scope
(Universal_Real
, Standard_Standard
);
1400 Copy_Float_Type
(Universal_Real
, Standard_Long_Long_Float
);
1402 -- Note: universal fixed, unlike universal integer and universal real,
1403 -- is never used at runtime, so it does not need to have bounds set.
1405 Universal_Fixed
:= New_Standard_Entity
;
1406 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1407 Set_Defining_Identifier
(Decl
, Universal_Fixed
);
1408 Make_Name
(Universal_Fixed
, "universal_fixed");
1409 Set_Ekind
(Universal_Fixed
, E_Ordinary_Fixed_Point_Type
);
1410 Set_Etype
(Universal_Fixed
, Universal_Fixed
);
1411 Set_Scope
(Universal_Fixed
, Standard_Standard
);
1412 Init_Size
(Universal_Fixed
, Standard_Long_Long_Integer_Size
);
1413 Set_Elem_Alignment
(Universal_Fixed
);
1414 Set_Size_Known_At_Compile_Time
1417 -- Create type declaration for Duration, using a 64-bit size. The
1418 -- delta and size values depend on the mode set in system.ads.
1420 Build_Duration
: declare
1426 -- In 32 bit mode, the size is 32 bits, and the delta and
1427 -- small values are set to 20 milliseconds (20.0*(10.0**(-3)).
1429 if Duration_32_Bits_On_Target
then
1430 Dlo
:= Intval
(Type_Low_Bound
(Standard_Integer_32
));
1431 Dhi
:= Intval
(Type_High_Bound
(Standard_Integer_32
));
1432 Delta_Val
:= UR_From_Components
(UI_From_Int
(20), Uint_3
, 10);
1434 -- In 64-bit mode, the size is 64-bits and the delta and
1435 -- small values are set to nanoseconds (1.0*(10.0**(-9)).
1438 Dlo
:= Intval
(Type_Low_Bound
(Standard_Integer_64
));
1439 Dhi
:= Intval
(Type_High_Bound
(Standard_Integer_64
));
1440 Delta_Val
:= UR_From_Components
(Uint_1
, Uint_9
, 10);
1443 Tdef_Node
:= Make_Ordinary_Fixed_Point_Definition
(Stloc
,
1444 Delta_Expression
=> Make_Real_Literal
(Stloc
, Delta_Val
),
1445 Real_Range_Specification
=>
1446 Make_Real_Range_Specification
(Stloc
,
1447 Low_Bound
=> Make_Real_Literal
(Stloc
,
1448 Realval
=> Dlo
* Delta_Val
),
1449 High_Bound
=> Make_Real_Literal
(Stloc
,
1450 Realval
=> Dhi
* Delta_Val
)));
1452 Set_Type_Definition
(Parent
(Standard_Duration
), Tdef_Node
);
1454 Set_Ekind
(Standard_Duration
, E_Ordinary_Fixed_Point_Type
);
1455 Set_Etype
(Standard_Duration
, Standard_Duration
);
1457 if Duration_32_Bits_On_Target
then
1458 Init_Size
(Standard_Duration
, 32);
1460 Init_Size
(Standard_Duration
, 64);
1463 Set_Elem_Alignment
(Standard_Duration
);
1464 Set_Delta_Value
(Standard_Duration
, Delta_Val
);
1465 Set_Small_Value
(Standard_Duration
, Delta_Val
);
1466 Set_Scalar_Range
(Standard_Duration
,
1467 Real_Range_Specification
1468 (Type_Definition
(Parent
(Standard_Duration
))));
1470 -- Normally it does not matter that nodes in package Standard are
1471 -- not marked as analyzed. The Scalar_Range of the fixed-point type
1472 -- Standard_Duration is an exception, because of the special test
1473 -- made in Freeze.Freeze_Fixed_Point_Type.
1475 Set_Analyzed
(Scalar_Range
(Standard_Duration
));
1477 Set_Etype
(Type_High_Bound
(Standard_Duration
), Standard_Duration
);
1478 Set_Etype
(Type_Low_Bound
(Standard_Duration
), Standard_Duration
);
1480 Set_Is_Static_Expression
(Type_High_Bound
(Standard_Duration
));
1481 Set_Is_Static_Expression
(Type_Low_Bound
(Standard_Duration
));
1483 Set_Corresponding_Integer_Value
1484 (Type_High_Bound
(Standard_Duration
), Dhi
);
1486 Set_Corresponding_Integer_Value
1487 (Type_Low_Bound
(Standard_Duration
), Dlo
);
1489 Set_Size_Known_At_Compile_Time
(Standard_Duration
);
1492 -- Build standard exception type. Note that the type name here is
1493 -- actually used in the generated code, so it must be set correctly.
1494 -- The type Standard_Exception_Type must be consistent with the type
1495 -- System.Standard_Library.Exception_Data, as the latter is what is
1496 -- known by the run-time. Components of the record are documented in
1497 -- the declaration in System.Standard_Library.
1499 Standard_Exception_Type
:= New_Standard_Entity
;
1500 Set_Ekind
(Standard_Exception_Type
, E_Record_Type
);
1501 Set_Etype
(Standard_Exception_Type
, Standard_Exception_Type
);
1502 Set_Scope
(Standard_Exception_Type
, Standard_Standard
);
1503 Set_Stored_Constraint
1504 (Standard_Exception_Type
, No_Elist
);
1505 Init_Size_Align
(Standard_Exception_Type
);
1506 Set_Size_Known_At_Compile_Time
1507 (Standard_Exception_Type
, True);
1508 Make_Name
(Standard_Exception_Type
, "exception");
1511 (Standard_Exception_Type
, Standard_Boolean
, "Not_Handled_By_Others");
1513 (Standard_Exception_Type
, Standard_Character
, "Lang");
1515 (Standard_Exception_Type
, Standard_Natural
, "Name_Length");
1517 (Standard_Exception_Type
, Standard_A_Char
, "Full_Name");
1519 (Standard_Exception_Type
, Standard_A_Char
, "HTable_Ptr");
1521 (Standard_Exception_Type
, Standard_A_Char
, "Foreign_Data");
1523 (Standard_Exception_Type
, Standard_A_Char
, "Raise_Hook");
1525 -- Build tree for record declaration, for use by the back-end
1528 Comp_List
: List_Id
;
1532 Comp
:= First_Entity
(Standard_Exception_Type
);
1533 Comp_List
:= New_List
;
1534 while Present
(Comp
) loop
1536 Make_Component_Declaration
(Stloc
,
1537 Defining_Identifier
=> Comp
,
1538 Component_Definition
=>
1539 Make_Component_Definition
(Stloc
,
1540 Aliased_Present
=> False,
1541 Subtype_Indication
=> New_Occurrence_Of
(Etype
(Comp
),
1548 Decl
:= Make_Full_Type_Declaration
(Stloc
,
1549 Defining_Identifier
=> Standard_Exception_Type
,
1551 Make_Record_Definition
(Stloc
,
1554 Make_Component_List
(Stloc
,
1555 Component_Items
=> Comp_List
)));
1558 Append
(Decl
, Decl_S
);
1560 Layout_Type
(Standard_Exception_Type
);
1562 -- Create declarations of standard exceptions
1564 Build_Exception
(S_Constraint_Error
);
1565 Build_Exception
(S_Program_Error
);
1566 Build_Exception
(S_Storage_Error
);
1567 Build_Exception
(S_Tasking_Error
);
1569 -- Numeric_Error is a normal exception in Ada 83, but in Ada 95
1570 -- it is a renaming of Constraint_Error. Is this test too early???
1572 if Ada_Version
= Ada_83
then
1573 Build_Exception
(S_Numeric_Error
);
1576 Decl
:= New_Node
(N_Exception_Renaming_Declaration
, Stloc
);
1577 E_Id
:= Standard_Entity
(S_Numeric_Error
);
1579 Set_Ekind
(E_Id
, E_Exception
);
1580 Set_Etype
(E_Id
, Standard_Exception_Type
);
1581 Set_Is_Public
(E_Id
);
1582 Set_Renamed_Entity
(E_Id
, Standard_Entity
(S_Constraint_Error
));
1584 Set_Defining_Identifier
(Decl
, E_Id
);
1585 Append
(Decl
, Decl_S
);
1587 Ident_Node
:= New_Node
(N_Identifier
, Stloc
);
1588 Set_Chars
(Ident_Node
, Chars
(Standard_Entity
(S_Constraint_Error
)));
1589 Set_Entity
(Ident_Node
, Standard_Entity
(S_Constraint_Error
));
1590 Set_Name
(Decl
, Ident_Node
);
1593 -- Abort_Signal is an entity that does not get made visible
1595 Abort_Signal
:= New_Standard_Entity
;
1596 Set_Chars
(Abort_Signal
, Name_uAbort_Signal
);
1597 Set_Ekind
(Abort_Signal
, E_Exception
);
1598 Set_Etype
(Abort_Signal
, Standard_Exception_Type
);
1599 Set_Scope
(Abort_Signal
, Standard_Standard
);
1600 Set_Is_Public
(Abort_Signal
, True);
1602 Make_Exception_Declaration
(Stloc
,
1603 Defining_Identifier
=> Abort_Signal
);
1605 -- Create defining identifiers for shift operator entities. Note
1606 -- that these entities are used only for marking shift operators
1607 -- generated internally, and hence need no structure, just a name
1608 -- and a unique identity.
1610 Standard_Op_Rotate_Left
:= New_Standard_Entity
;
1611 Set_Chars
(Standard_Op_Rotate_Left
, Name_Rotate_Left
);
1612 Set_Ekind
(Standard_Op_Rotate_Left
, E_Operator
);
1614 Standard_Op_Rotate_Right
:= New_Standard_Entity
;
1615 Set_Chars
(Standard_Op_Rotate_Right
, Name_Rotate_Right
);
1616 Set_Ekind
(Standard_Op_Rotate_Right
, E_Operator
);
1618 Standard_Op_Shift_Left
:= New_Standard_Entity
;
1619 Set_Chars
(Standard_Op_Shift_Left
, Name_Shift_Left
);
1620 Set_Ekind
(Standard_Op_Shift_Left
, E_Operator
);
1622 Standard_Op_Shift_Right
:= New_Standard_Entity
;
1623 Set_Chars
(Standard_Op_Shift_Right
, Name_Shift_Right
);
1624 Set_Ekind
(Standard_Op_Shift_Right
, E_Operator
);
1626 Standard_Op_Shift_Right_Arithmetic
:= New_Standard_Entity
;
1627 Set_Chars
(Standard_Op_Shift_Right_Arithmetic
,
1628 Name_Shift_Right_Arithmetic
);
1629 Set_Ekind
(Standard_Op_Shift_Right_Arithmetic
,
1632 -- Create standard operator declarations
1636 -- Initialize visibility table with entities in Standard
1638 for E
in Standard_Entity_Type
loop
1639 if Ekind
(Standard_Entity
(E
)) /= E_Operator
then
1641 (Chars
(Standard_Entity
(E
)), Standard_Entity
(E
));
1642 Set_Homonym
(Standard_Entity
(E
), Empty
);
1645 if E
not in S_ASCII_Names
then
1646 Set_Scope
(Standard_Entity
(E
), Standard_Standard
);
1647 Set_Is_Immediately_Visible
(Standard_Entity
(E
));
1651 -- The predefined package Standard itself does not have a scope;
1652 -- it is the only entity in the system not to have one, and this
1653 -- is what identifies the package to Gigi.
1655 Set_Scope
(Standard_Standard
, Empty
);
1657 -- Set global variables indicating last Id values and version
1659 Last_Standard_Node_Id
:= Last_Node_Id
;
1660 Last_Standard_List_Id
:= Last_List_Id
;
1662 -- The Error node has an Etype of Any_Type to help error recovery
1664 Set_Etype
(Error
, Any_Type
);
1666 -- Print representation of standard if switch set
1668 if Opt
.Print_Standard
then
1671 end Create_Standard
;
1673 ------------------------------------
1674 -- Create_Unconstrained_Base_Type --
1675 ------------------------------------
1677 procedure Create_Unconstrained_Base_Type
1681 New_Ent
: constant Entity_Id
:= New_Copy
(E
);
1685 Set_Is_Constrained
(E
, True);
1686 Set_Is_First_Subtype
(E
, True);
1687 Set_Etype
(E
, New_Ent
);
1689 Append_Entity
(New_Ent
, Standard_Standard
);
1690 Set_Is_Constrained
(New_Ent
, False);
1691 Set_Etype
(New_Ent
, New_Ent
);
1692 Set_Is_Known_Valid
(New_Ent
, True);
1694 if K
= E_Signed_Integer_Subtype
then
1695 Set_Etype
(Low_Bound
(Scalar_Range
(E
)), New_Ent
);
1696 Set_Etype
(High_Bound
(Scalar_Range
(E
)), New_Ent
);
1699 end Create_Unconstrained_Base_Type
;
1701 --------------------
1702 -- Identifier_For --
1703 --------------------
1705 function Identifier_For
(S
: Standard_Entity_Type
) return Node_Id
is
1706 Ident_Node
: Node_Id
;
1708 Ident_Node
:= New_Node
(N_Identifier
, Stloc
);
1709 Set_Chars
(Ident_Node
, Chars
(Standard_Entity
(S
)));
1710 Set_Entity
(Ident_Node
, Standard_Entity
(S
));
1714 --------------------
1715 -- Make_Component --
1716 --------------------
1718 procedure Make_Component
1723 Id
: constant Entity_Id
:= New_Standard_Entity
;
1726 Set_Ekind
(Id
, E_Component
);
1727 Set_Etype
(Id
, Typ
);
1728 Set_Scope
(Id
, Rec
);
1729 Init_Component_Location
(Id
);
1731 Set_Original_Record_Component
(Id
, Id
);
1732 Make_Name
(Id
, Nam
);
1733 Append_Entity
(Id
, Rec
);
1740 function Make_Formal
1742 Formal_Name
: String) return Entity_Id
1747 Formal
:= New_Standard_Entity
;
1749 Set_Ekind
(Formal
, E_In_Parameter
);
1750 Set_Mechanism
(Formal
, Default_Mechanism
);
1751 Set_Scope
(Formal
, Standard_Standard
);
1752 Set_Etype
(Formal
, Typ
);
1753 Make_Name
(Formal
, Formal_Name
);
1762 function Make_Integer
(V
: Uint
) return Node_Id
is
1763 N
: constant Node_Id
:= Make_Integer_Literal
(Stloc
, V
);
1765 Set_Is_Static_Expression
(N
);
1773 procedure Make_Name
(Id
: Entity_Id
; Nam
: String) is
1775 for J
in 1 .. Nam
'Length loop
1776 Name_Buffer
(J
) := Fold_Lower
(Nam
(Nam
'First + (J
- 1)));
1779 Name_Len
:= Nam
'Length;
1780 Set_Chars
(Id
, Name_Find
);
1787 function New_Operator
(Op
: Name_Id
; Typ
: Entity_Id
) return Entity_Id
is
1788 Ident_Node
: Entity_Id
;
1791 Ident_Node
:= Make_Defining_Identifier
(Stloc
, Op
);
1793 Set_Is_Pure
(Ident_Node
, True);
1794 Set_Ekind
(Ident_Node
, E_Operator
);
1795 Set_Etype
(Ident_Node
, Typ
);
1796 Set_Scope
(Ident_Node
, Standard_Standard
);
1797 Set_Homonym
(Ident_Node
, Get_Name_Entity_Id
(Op
));
1798 Set_Convention
(Ident_Node
, Convention_Intrinsic
);
1800 Set_Is_Immediately_Visible
(Ident_Node
, True);
1801 Set_Is_Intrinsic_Subprogram
(Ident_Node
, True);
1803 Set_Name_Entity_Id
(Op
, Ident_Node
);
1804 Append_Entity
(Ident_Node
, Standard_Standard
);
1808 -------------------------
1809 -- New_Standard_Entity --
1810 -------------------------
1812 function New_Standard_Entity
1813 (New_Node_Kind
: Node_Kind
:= N_Defining_Identifier
) return Entity_Id
1815 E
: constant Entity_Id
:= New_Entity
(New_Node_Kind
, Stloc
);
1818 -- All standard entities are Pure and Public
1823 -- All standard entity names are analyzed manually, and are thus
1824 -- frozen as soon as they are created.
1828 -- Set debug information required for all standard types
1830 Set_Needs_Debug_Info
(E
);
1832 -- All standard entities are built with fully qualified names, so
1833 -- set the flag to prevent an abortive attempt at requalification.
1835 Set_Has_Qualified_Name
(E
);
1837 -- Return newly created entity to be completed by caller
1840 end New_Standard_Entity
;
1842 function New_Standard_Entity
(S
: String) return Entity_Id
is
1843 Ent
: constant Entity_Id
:= New_Standard_Entity
;
1847 end New_Standard_Entity
;
1849 --------------------
1850 -- Print_Standard --
1851 --------------------
1853 procedure Print_Standard
is
1855 procedure P
(Item
: String) renames Output
.Write_Line
;
1856 -- Short-hand, since we do a lot of line writes here
1858 procedure P_Int_Range
(Size
: Pos
);
1859 -- Prints the range of an integer based on its Size
1861 procedure P_Float_Range
(Id
: Entity_Id
);
1862 -- Prints the bounds range for the given float type entity
1864 procedure P_Float_Type
(Id
: Entity_Id
);
1865 -- Prints the type declaration of the given float type entity
1867 procedure P_Mixed_Name
(Id
: Name_Id
);
1868 -- Prints Id in mixed case
1874 procedure P_Float_Range
(Id
: Entity_Id
) is
1876 Write_Str
(" range ");
1877 UR_Write
(Realval
(Type_Low_Bound
(Id
)));
1879 UR_Write
(Realval
(Type_High_Bound
(Id
)));
1888 procedure P_Float_Type
(Id
: Entity_Id
) is
1890 Write_Str
(" type ");
1891 P_Mixed_Name
(Chars
(Id
));
1892 Write_Str
(" is digits ");
1893 Write_Int
(UI_To_Int
(Digits_Value
(Id
)));
1896 Write_Str
(" for ");
1897 P_Mixed_Name
(Chars
(Id
));
1898 Write_Str
("'Size use ");
1899 Write_Int
(UI_To_Int
(RM_Size
(Id
)));
1908 procedure P_Int_Range
(Size
: Pos
) is
1910 Write_Str
(" is range -(2 **");
1911 Write_Int
(Size
- 1);
1913 Write_Str
(" .. +(2 **");
1914 Write_Int
(Size
- 1);
1915 Write_Str
(" - 1);");
1923 procedure P_Mixed_Name
(Id
: Name_Id
) is
1925 Get_Name_String
(Id
);
1927 for J
in 1 .. Name_Len
loop
1928 if J
= 1 or else Name_Buffer
(J
- 1) = '_' then
1929 Name_Buffer
(J
) := Fold_Upper
(Name_Buffer
(J
));
1933 Write_Str
(Name_Buffer
(1 .. Name_Len
));
1936 -- Start of processing for Print_Standard
1939 P
("-- Representation of package Standard");
1941 P
("-- This is not accurate Ada, since new base types cannot be ");
1942 P
("-- created, but the listing shows the target dependent");
1943 P
("-- characteristics of the Standard types for this compiler");
1946 P
("package Standard is");
1947 P
("pragma Pure (Standard);");
1950 P
(" type Boolean is (False, True);");
1951 P
(" for Boolean'Size use 1;");
1952 P
(" for Boolean use (False => 0, True => 1);");
1957 Write_Str
(" type Integer");
1958 P_Int_Range
(Standard_Integer_Size
);
1959 Write_Str
(" for Integer'Size use ");
1960 Write_Int
(Standard_Integer_Size
);
1964 P
(" subtype Natural is Integer range 0 .. Integer'Last;");
1965 P
(" subtype Positive is Integer range 1 .. Integer'Last;");
1968 Write_Str
(" type Short_Short_Integer");
1969 P_Int_Range
(Standard_Short_Short_Integer_Size
);
1970 Write_Str
(" for Short_Short_Integer'Size use ");
1971 Write_Int
(Standard_Short_Short_Integer_Size
);
1975 Write_Str
(" type Short_Integer");
1976 P_Int_Range
(Standard_Short_Integer_Size
);
1977 Write_Str
(" for Short_Integer'Size use ");
1978 Write_Int
(Standard_Short_Integer_Size
);
1982 Write_Str
(" type Long_Integer");
1983 P_Int_Range
(Standard_Long_Integer_Size
);
1984 Write_Str
(" for Long_Integer'Size use ");
1985 Write_Int
(Standard_Long_Integer_Size
);
1989 Write_Str
(" type Long_Long_Integer");
1990 P_Int_Range
(Standard_Long_Long_Integer_Size
);
1991 Write_Str
(" for Long_Long_Integer'Size use ");
1992 Write_Int
(Standard_Long_Long_Integer_Size
);
1996 -- Floating point types
1998 P_Float_Type
(Standard_Short_Float
);
1999 P_Float_Type
(Standard_Float
);
2000 P_Float_Type
(Standard_Long_Float
);
2001 P_Float_Type
(Standard_Long_Long_Float
);
2003 P
(" type Character is (...)");
2004 Write_Str
(" for Character'Size use ");
2005 Write_Int
(Standard_Character_Size
);
2007 P
(" -- See RM A.1(35) for details of this type");
2010 P
(" type Wide_Character is (...)");
2011 Write_Str
(" for Wide_Character'Size use ");
2012 Write_Int
(Standard_Wide_Character_Size
);
2014 P
(" -- See RM A.1(36) for details of this type");
2017 P
(" type Wide_Wide_Character is (...)");
2018 Write_Str
(" for Wide_Wide_Character'Size use ");
2019 Write_Int
(Standard_Wide_Wide_Character_Size
);
2021 P
(" -- See RM A.1(36) for details of this type");
2023 P
(" type String is array (Positive range <>) of Character;");
2024 P
(" pragma Pack (String);");
2027 P
(" type Wide_String is array (Positive range <>)" &
2028 " of Wide_Character;");
2029 P
(" pragma Pack (Wide_String);");
2032 P
(" type Wide_Wide_String is array (Positive range <>)" &
2033 " of Wide_Wide_Character;");
2034 P
(" pragma Pack (Wide_Wide_String);");
2037 -- We only have one representation each for 32-bit and 64-bit sizes,
2038 -- so select the right one based on Duration_32_Bits_On_Target.
2040 if Duration_32_Bits_On_Target
then
2041 P
(" type Duration is delta 0.020");
2042 P
(" range -((2 ** 31) * 0.020) ..");
2043 P
(" +((2 ** 31 - 1) * 0.020);");
2044 P
(" for Duration'Small use 0.020;");
2047 P
(" type Duration is delta 0.000000001");
2048 P
(" range -((2 ** 63) * 0.000000001) ..");
2049 P
(" +((2 ** 63 - 1) * 0.000000001);");
2050 P
(" for Duration'Small use 0.000000001;");
2055 P
(" Constraint_Error : exception;");
2056 P
(" Program_Error : exception;");
2057 P
(" Storage_Error : exception;");
2058 P
(" Tasking_Error : exception;");
2059 P
(" Numeric_Error : exception renames Constraint_Error;");
2062 P
("end Standard;");
2065 -------------------------
2066 -- Register_Float_Type --
2067 -------------------------
2069 procedure Register_Float_Type
2072 Float_Rep
: Float_Rep_Kind
;
2073 Precision
: Positive;
2075 Alignment
: Natural)
2077 pragma Unreferenced
(Precision
);
2078 -- See Build_Float_Type for the rationale
2080 Ent
: constant Entity_Id
:= New_Standard_Entity
;
2083 Set_Defining_Identifier
(New_Node
(N_Full_Type_Declaration
, Stloc
), Ent
);
2084 Make_Name
(Ent
, Name
);
2085 Set_Scope
(Ent
, Standard_Standard
);
2087 (Ent
, Pos
(Digs
), Float_Rep
, Int
(Size
), Int
(Alignment
/ 8));
2089 if No
(Back_End_Float_Types
) then
2090 Back_End_Float_Types
:= New_Elmt_List
;
2093 Append_Elmt
(Ent
, Back_End_Float_Types
);
2094 end Register_Float_Type
;
2096 ----------------------
2097 -- Set_Float_Bounds --
2098 ----------------------
2100 procedure Set_Float_Bounds
(Id
: Entity_Id
) is
2103 -- Low and high bounds of literal value
2106 -- Range specification
2108 Radix
: constant Uint
:= Machine_Radix_Value
(Id
);
2109 Mantissa
: constant Uint
:= Machine_Mantissa_Value
(Id
);
2110 Emax
: constant Uint
:= Machine_Emax_Value
(Id
);
2111 Significand
: constant Uint
:= Radix
** Mantissa
- 1;
2112 Exponent
: constant Uint
:= Emax
- Mantissa
;
2115 H
:= Make_Float_Literal
(Stloc
, Radix
, Significand
, Exponent
);
2116 L
:= Make_Float_Literal
(Stloc
, Radix
, -Significand
, Exponent
);
2119 Set_Is_Static_Expression
(L
);
2122 Set_Is_Static_Expression
(H
);
2124 R
:= New_Node
(N_Range
, Stloc
);
2125 Set_Low_Bound
(R
, L
);
2126 Set_High_Bound
(R
, H
);
2127 Set_Includes_Infinities
(R
, True);
2128 Set_Scalar_Range
(Id
, R
);
2131 end Set_Float_Bounds
;
2133 ------------------------
2134 -- Set_Integer_Bounds --
2135 ------------------------
2137 procedure Set_Integer_Bounds
2145 -- Low and high bounds of literal value
2148 -- Range specification
2151 L
:= Make_Integer
(Lb
);
2152 H
:= Make_Integer
(Hb
);
2157 R
:= New_Node
(N_Range
, Stloc
);
2158 Set_Low_Bound
(R
, L
);
2159 Set_High_Bound
(R
, H
);
2160 Set_Scalar_Range
(Id
, R
);
2163 Set_Is_Unsigned_Type
(Id
, Lb
>= 0);
2164 end Set_Integer_Bounds
;