1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, 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 Layout
; use Layout
;
31 with Namet
; use Namet
;
32 with Nlists
; use Nlists
;
33 with Nmake
; use Nmake
;
35 with Output
; use Output
;
36 with Targparm
; use Targparm
;
37 with Tbuild
; use Tbuild
;
38 with Ttypes
; use Ttypes
;
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) return Entity_Id
;
106 -- Construct entity for subprogram formal with given name and type
108 function Make_Integer
(V
: Uint
) return Node_Id
;
109 -- Builds integer literal with given value
111 procedure Make_Name
(Id
: Entity_Id
; Nam
: String);
112 -- Make an entry in the names table for Nam, and set as Chars field of Id
114 function New_Operator
(Op
: Name_Id
; Typ
: Entity_Id
) return Entity_Id
;
115 -- Build entity for standard operator with given name and type
117 function New_Standard_Entity
118 (New_Node_Kind
: Node_Kind
:= N_Defining_Identifier
) return Entity_Id
;
119 -- Builds a new entity for Standard
121 procedure Print_Standard
;
122 -- Print representation of package Standard if switch set
124 procedure Set_Integer_Bounds
129 -- Procedure to set bounds for integer type or subtype. Id is the entity
130 -- whose bounds and type are to be set. The Typ parameter is the Etype
131 -- value for the entity (which will be the same as Id for all predefined
132 -- integer base types. The third and fourth parameters are the bounds.
134 ----------------------
135 -- Build_Float_Type --
136 ----------------------
138 procedure Build_Float_Type
(E
: Entity_Id
; Siz
: Int
; Digs
: Int
) is
140 Set_Type_Definition
(Parent
(E
),
141 Make_Floating_Point_Definition
(Stloc
,
142 Digits_Expression
=> Make_Integer
(UI_From_Int
(Digs
))));
144 Set_Ekind
(E
, E_Floating_Point_Type
);
147 if AAMP_On_Target
then
148 Set_Float_Rep
(E
, AAMP
);
150 Set_Float_Rep
(E
, IEEE_Binary
);
154 Set_Elem_Alignment
(E
);
155 Init_Digits_Value
(E
, Digs
);
156 Set_Float_Bounds
(E
);
159 Set_Size_Known_At_Compile_Time
(E
);
160 end Build_Float_Type
;
162 -------------------------------
163 -- Build_Signed_Integer_Type --
164 -------------------------------
166 procedure Build_Signed_Integer_Type
(E
: Entity_Id
; Siz
: Int
) is
167 U2Siz1
: constant Uint
:= 2 ** (Siz
- 1);
168 Lbound
: constant Uint
:= -U2Siz1
;
169 Ubound
: constant Uint
:= U2Siz1
- 1;
172 Set_Type_Definition
(Parent
(E
),
173 Make_Signed_Integer_Type_Definition
(Stloc
,
174 Low_Bound
=> Make_Integer
(Lbound
),
175 High_Bound
=> Make_Integer
(Ubound
)));
177 Set_Ekind
(E
, E_Signed_Integer_Type
);
180 Set_Elem_Alignment
(E
);
181 Set_Integer_Bounds
(E
, E
, Lbound
, Ubound
);
184 Set_Is_Known_Valid
(E
);
185 Set_Size_Known_At_Compile_Time
(E
);
186 end Build_Signed_Integer_Type
;
188 ----------------------
189 -- Create_Operators --
190 ----------------------
192 -- Each operator has an abbreviated signature. The formals have the names
193 -- LEFT and RIGHT. Their types are not actually used for resolution.
195 procedure Create_Operators
is
198 -- The following tables define the binary and unary operators and their
199 -- corresponding result type.
201 Binary_Ops
: constant array (S_Binary_Ops
) of Name_Id
:=
203 -- There is one entry here for each binary operator, except for the
204 -- case of concatenation, where there are three entries, one for a
205 -- String result, one for Wide_String, and one for Wide_Wide_String.
227 Bin_Op_Types
: constant array (S_Binary_Ops
) of Entity_Id
:=
229 -- This table has the corresponding result types. The entries are
230 -- ordered so they correspond to the Binary_Ops array above.
232 (Universal_Integer
, -- Add
233 Standard_Boolean
, -- And
234 Standard_String
, -- Concat (String)
235 Standard_Wide_String
, -- Concat (Wide_String)
236 Standard_Wide_Wide_String
, -- Concat (Wide_Wide_String)
237 Universal_Integer
, -- Divide
238 Standard_Boolean
, -- Eq
239 Universal_Integer
, -- Expon
240 Standard_Boolean
, -- Ge
241 Standard_Boolean
, -- Gt
242 Standard_Boolean
, -- Le
243 Standard_Boolean
, -- Lt
244 Universal_Integer
, -- Mod
245 Universal_Integer
, -- Multiply
246 Standard_Boolean
, -- Ne
247 Standard_Boolean
, -- Or
248 Universal_Integer
, -- Rem
249 Universal_Integer
, -- Subtract
250 Standard_Boolean
); -- Xor
252 Unary_Ops
: constant array (S_Unary_Ops
) of Name_Id
:=
254 -- There is one entry here for each unary operator
261 Unary_Op_Types
: constant array (S_Unary_Ops
) of Entity_Id
:=
263 -- This table has the corresponding result types. The entries are
264 -- ordered so they correspond to the Unary_Ops array above.
266 (Universal_Integer
, -- Abs
267 Universal_Integer
, -- Subtract
268 Standard_Boolean
, -- Not
269 Universal_Integer
); -- Add
272 for J
in S_Binary_Ops
loop
273 Op_Node
:= New_Operator
(Binary_Ops
(J
), Bin_Op_Types
(J
));
275 Append_Entity
(Make_Formal
(Any_Type
, "LEFT"), Op_Node
);
276 Append_Entity
(Make_Formal
(Any_Type
, "RIGHT"), Op_Node
);
279 for J
in S_Unary_Ops
loop
280 Op_Node
:= New_Operator
(Unary_Ops
(J
), Unary_Op_Types
(J
));
282 Append_Entity
(Make_Formal
(Any_Type
, "RIGHT"), Op_Node
);
285 -- For concatenation, we create a separate operator for each
286 -- array type. This simplifies the resolution of the component-
287 -- component concatenation operation. In Standard, we set the types
288 -- of the formals for string, wide [wide]_string, concatenations.
290 Set_Etype
(First_Entity
(Standard_Op_Concat
), Standard_String
);
291 Set_Etype
(Last_Entity
(Standard_Op_Concat
), Standard_String
);
293 Set_Etype
(First_Entity
(Standard_Op_Concatw
), Standard_Wide_String
);
294 Set_Etype
(Last_Entity
(Standard_Op_Concatw
), Standard_Wide_String
);
296 Set_Etype
(First_Entity
(Standard_Op_Concatww
),
297 Standard_Wide_Wide_String
);
299 Set_Etype
(Last_Entity
(Standard_Op_Concatww
),
300 Standard_Wide_Wide_String
);
301 end Create_Operators
;
303 ---------------------
304 -- Create_Standard --
305 ---------------------
307 -- The tree for the package Standard is prefixed to all compilations.
308 -- Several entities required by semantic analysis are denoted by global
309 -- variables that are initialized to point to the corresponding
310 -- occurrences in STANDARD. The visible entities of STANDARD are
311 -- created here. The private entities defined in STANDARD are created
312 -- by Initialize_Standard in the semantics module.
314 procedure Create_Standard
is
315 Decl_S
: constant List_Id
:= New_List
;
316 -- List of declarations in Standard
318 Decl_A
: constant List_Id
:= New_List
;
319 -- List of declarations in ASCII
324 Ident_Node
: Node_Id
;
330 procedure Build_Exception
(S
: Standard_Entity_Type
);
331 -- Procedure to declare given entity as an exception
333 procedure Pack_String_Type
(String_Type
: Entity_Id
);
334 -- Generate proper tree for pragma Pack that applies to given type, and
335 -- mark type as having the pragma.
337 ---------------------
338 -- Build_Exception --
339 ---------------------
341 procedure Build_Exception
(S
: Standard_Entity_Type
) is
343 Set_Ekind
(Standard_Entity
(S
), E_Exception
);
344 Set_Etype
(Standard_Entity
(S
), Standard_Exception_Type
);
345 Set_Exception_Code
(Standard_Entity
(S
), Uint_0
);
346 Set_Is_Public
(Standard_Entity
(S
), True);
349 Make_Exception_Declaration
(Stloc
,
350 Defining_Identifier
=> Standard_Entity
(S
));
351 Append
(Decl
, Decl_S
);
354 ----------------------
355 -- Pack_String_Type --
356 ----------------------
358 procedure Pack_String_Type
(String_Type
: Entity_Id
) is
359 Prag
: constant Node_Id
:=
362 Pragma_Argument_Associations
=>
364 Make_Pragma_Argument_Association
(Stloc
,
366 New_Occurrence_Of
(String_Type
, Stloc
))));
368 Append
(Prag
, Decl_S
);
369 Record_Rep_Item
(String_Type
, Prag
);
370 Set_Has_Pragma_Pack
(String_Type
, True);
371 end Pack_String_Type
;
373 -- Start of processing for Create_Standard
376 -- Initialize scanner for internal scans of literals
378 Scn
.Initialize_Scanner
(No_Unit
, Internal_Source_File
);
380 -- First step is to create defining identifiers for each entity
382 for S
in Standard_Entity_Type
loop
384 S_Name
: constant String := Standard_Entity_Type
'Image (S
);
385 -- Name of entity (note we skip S_ at the start)
387 Ident_Node
: Node_Id
;
388 -- Defining identifier node
391 Ident_Node
:= New_Standard_Entity
;
392 Make_Name
(Ident_Node
, S_Name
(3 .. S_Name
'Length));
393 Standard_Entity
(S
) := Ident_Node
;
397 -- Create package declaration node for package Standard
399 Standard_Package_Node
:= New_Node
(N_Package_Declaration
, Stloc
);
401 Pspec
:= New_Node
(N_Package_Specification
, Stloc
);
402 Set_Specification
(Standard_Package_Node
, Pspec
);
404 Set_Defining_Unit_Name
(Pspec
, Standard_Standard
);
405 Set_Visible_Declarations
(Pspec
, Decl_S
);
407 Set_Ekind
(Standard_Standard
, E_Package
);
408 Set_Is_Pure
(Standard_Standard
);
409 Set_Is_Compilation_Unit
(Standard_Standard
);
411 -- Create type/subtype declaration nodes for standard types
413 for S
in S_Types
loop
415 -- Subtype declaration case
417 if S
= S_Natural
or else S
= S_Positive
then
418 Decl
:= New_Node
(N_Subtype_Declaration
, Stloc
);
419 Set_Subtype_Indication
(Decl
,
420 New_Occurrence_Of
(Standard_Integer
, Stloc
));
422 -- Full type declaration case
425 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
428 Set_Is_Frozen
(Standard_Entity
(S
));
429 Set_Is_Public
(Standard_Entity
(S
));
430 Set_Defining_Identifier
(Decl
, Standard_Entity
(S
));
431 Append
(Decl
, Decl_S
);
434 -- Create type definition node for type Boolean. The Size is set to
435 -- 1 as required by Ada 95 and current ARG interpretations for Ada/83.
437 -- Note: Object_Size of Boolean is 8. This means that we do NOT in
438 -- general know that Boolean variables have valid values, so we do
439 -- not set the Is_Known_Valid flag.
441 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
442 Set_Literals
(Tdef_Node
, New_List
);
443 Append
(Standard_False
, Literals
(Tdef_Node
));
444 Append
(Standard_True
, Literals
(Tdef_Node
));
445 Set_Type_Definition
(Parent
(Standard_Boolean
), Tdef_Node
);
447 Set_Ekind
(Standard_Boolean
, E_Enumeration_Type
);
448 Set_First_Literal
(Standard_Boolean
, Standard_False
);
449 Set_Etype
(Standard_Boolean
, Standard_Boolean
);
450 Init_Esize
(Standard_Boolean
, Standard_Character_Size
);
451 Init_RM_Size
(Standard_Boolean
, 1);
452 Set_Elem_Alignment
(Standard_Boolean
);
454 Set_Is_Unsigned_Type
(Standard_Boolean
);
455 Set_Size_Known_At_Compile_Time
(Standard_Boolean
);
456 Set_Has_Pragma_Ordered
(Standard_Boolean
);
458 Set_Ekind
(Standard_True
, E_Enumeration_Literal
);
459 Set_Etype
(Standard_True
, Standard_Boolean
);
460 Set_Enumeration_Pos
(Standard_True
, Uint_1
);
461 Set_Enumeration_Rep
(Standard_True
, Uint_1
);
462 Set_Is_Known_Valid
(Standard_True
, True);
464 Set_Ekind
(Standard_False
, E_Enumeration_Literal
);
465 Set_Etype
(Standard_False
, Standard_Boolean
);
466 Set_Enumeration_Pos
(Standard_False
, Uint_0
);
467 Set_Enumeration_Rep
(Standard_False
, Uint_0
);
468 Set_Is_Known_Valid
(Standard_False
, True);
470 -- For the bounds of Boolean, we create a range node corresponding to
472 -- range False .. True
474 -- where the occurrences of the literals must point to the
475 -- corresponding definition.
477 R_Node
:= New_Node
(N_Range
, Stloc
);
478 B_Node
:= New_Node
(N_Identifier
, Stloc
);
479 Set_Chars
(B_Node
, Chars
(Standard_False
));
480 Set_Entity
(B_Node
, Standard_False
);
481 Set_Etype
(B_Node
, Standard_Boolean
);
482 Set_Is_Static_Expression
(B_Node
);
483 Set_Low_Bound
(R_Node
, B_Node
);
485 B_Node
:= New_Node
(N_Identifier
, Stloc
);
486 Set_Chars
(B_Node
, Chars
(Standard_True
));
487 Set_Entity
(B_Node
, Standard_True
);
488 Set_Etype
(B_Node
, Standard_Boolean
);
489 Set_Is_Static_Expression
(B_Node
);
490 Set_High_Bound
(R_Node
, B_Node
);
492 Set_Scalar_Range
(Standard_Boolean
, R_Node
);
493 Set_Etype
(R_Node
, Standard_Boolean
);
494 Set_Parent
(R_Node
, Standard_Boolean
);
496 -- Record entity identifiers for boolean literals in the
497 -- Boolean_Literals array, for easy reference during expansion.
499 Boolean_Literals
:= (False => Standard_False
, True => Standard_True
);
501 -- Create type definition nodes for predefined integer types
503 Build_Signed_Integer_Type
504 (Standard_Short_Short_Integer
, Standard_Short_Short_Integer_Size
);
506 Build_Signed_Integer_Type
507 (Standard_Short_Integer
, Standard_Short_Integer_Size
);
509 Build_Signed_Integer_Type
510 (Standard_Integer
, Standard_Integer_Size
);
518 LIS
:= Standard_Long_Integer_Size
;
521 Build_Signed_Integer_Type
(Standard_Long_Integer
, LIS
);
524 Build_Signed_Integer_Type
525 (Standard_Long_Long_Integer
, Standard_Long_Long_Integer_Size
);
527 Create_Unconstrained_Base_Type
528 (Standard_Short_Short_Integer
, E_Signed_Integer_Subtype
);
530 Create_Unconstrained_Base_Type
531 (Standard_Short_Integer
, E_Signed_Integer_Subtype
);
533 Create_Unconstrained_Base_Type
534 (Standard_Integer
, E_Signed_Integer_Subtype
);
536 Create_Unconstrained_Base_Type
537 (Standard_Long_Integer
, E_Signed_Integer_Subtype
);
539 Create_Unconstrained_Base_Type
540 (Standard_Long_Long_Integer
, E_Signed_Integer_Subtype
);
542 -- Create type definition nodes for predefined float types
545 (Standard_Short_Float
,
546 Standard_Short_Float_Size
,
547 Standard_Short_Float_Digits
);
552 Standard_Float_Digits
);
555 (Standard_Long_Float
,
556 Standard_Long_Float_Size
,
557 Standard_Long_Float_Digits
);
560 (Standard_Long_Long_Float
,
561 Standard_Long_Long_Float_Size
,
562 Standard_Long_Long_Float_Digits
);
564 -- Create type definition node for type Character. Note that we do not
565 -- set the Literals field, since type Character is handled with special
566 -- routine that do not need a literal list.
568 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
569 Set_Type_Definition
(Parent
(Standard_Character
), Tdef_Node
);
571 Set_Ekind
(Standard_Character
, E_Enumeration_Type
);
572 Set_Etype
(Standard_Character
, Standard_Character
);
573 Init_Esize
(Standard_Character
, Standard_Character_Size
);
574 Init_RM_Size
(Standard_Character
, 8);
575 Set_Elem_Alignment
(Standard_Character
);
577 Set_Has_Pragma_Ordered
(Standard_Character
);
578 Set_Is_Unsigned_Type
(Standard_Character
);
579 Set_Is_Character_Type
(Standard_Character
);
580 Set_Is_Known_Valid
(Standard_Character
);
581 Set_Size_Known_At_Compile_Time
(Standard_Character
);
583 -- Create the bounds for type Character
585 R_Node
:= New_Node
(N_Range
, Stloc
);
587 -- Low bound for type Character (Standard.Nul)
589 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
590 Set_Is_Static_Expression
(B_Node
);
591 Set_Chars
(B_Node
, No_Name
);
592 Set_Char_Literal_Value
(B_Node
, Uint_0
);
593 Set_Entity
(B_Node
, Empty
);
594 Set_Etype
(B_Node
, Standard_Character
);
595 Set_Low_Bound
(R_Node
, B_Node
);
597 -- High bound for type Character
599 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
600 Set_Is_Static_Expression
(B_Node
);
601 Set_Chars
(B_Node
, No_Name
);
602 Set_Char_Literal_Value
(B_Node
, UI_From_Int
(16#FF#
));
603 Set_Entity
(B_Node
, Empty
);
604 Set_Etype
(B_Node
, Standard_Character
);
605 Set_High_Bound
(R_Node
, B_Node
);
607 Set_Scalar_Range
(Standard_Character
, R_Node
);
608 Set_Etype
(R_Node
, Standard_Character
);
609 Set_Parent
(R_Node
, Standard_Character
);
611 -- Create type definition for type Wide_Character. Note that we do not
612 -- set the Literals field, since type Wide_Character is handled with
613 -- special routines that do not need a literal list.
615 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
616 Set_Type_Definition
(Parent
(Standard_Wide_Character
), Tdef_Node
);
618 Set_Ekind
(Standard_Wide_Character
, E_Enumeration_Type
);
619 Set_Etype
(Standard_Wide_Character
, Standard_Wide_Character
);
620 Init_Size
(Standard_Wide_Character
, Standard_Wide_Character_Size
);
622 Set_Elem_Alignment
(Standard_Wide_Character
);
623 Set_Has_Pragma_Ordered
(Standard_Wide_Character
);
624 Set_Is_Unsigned_Type
(Standard_Wide_Character
);
625 Set_Is_Character_Type
(Standard_Wide_Character
);
626 Set_Is_Known_Valid
(Standard_Wide_Character
);
627 Set_Size_Known_At_Compile_Time
(Standard_Wide_Character
);
629 -- Create the bounds for type Wide_Character
631 R_Node
:= New_Node
(N_Range
, Stloc
);
633 -- Low bound for type Wide_Character
635 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
636 Set_Is_Static_Expression
(B_Node
);
637 Set_Chars
(B_Node
, No_Name
); -- ???
638 Set_Char_Literal_Value
(B_Node
, Uint_0
);
639 Set_Entity
(B_Node
, Empty
);
640 Set_Etype
(B_Node
, Standard_Wide_Character
);
641 Set_Low_Bound
(R_Node
, B_Node
);
643 -- High bound for type Wide_Character
645 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
646 Set_Is_Static_Expression
(B_Node
);
647 Set_Chars
(B_Node
, No_Name
); -- ???
648 Set_Char_Literal_Value
(B_Node
, UI_From_Int
(16#FFFF#
));
649 Set_Entity
(B_Node
, Empty
);
650 Set_Etype
(B_Node
, Standard_Wide_Character
);
651 Set_High_Bound
(R_Node
, B_Node
);
653 Set_Scalar_Range
(Standard_Wide_Character
, R_Node
);
654 Set_Etype
(R_Node
, Standard_Wide_Character
);
655 Set_Parent
(R_Node
, Standard_Wide_Character
);
657 -- Create type definition for type Wide_Wide_Character. Note that we
658 -- do not set the Literals field, since type Wide_Wide_Character is
659 -- handled with special routines that do not need a literal list.
661 Tdef_Node
:= New_Node
(N_Enumeration_Type_Definition
, Stloc
);
662 Set_Type_Definition
(Parent
(Standard_Wide_Wide_Character
), Tdef_Node
);
664 Set_Ekind
(Standard_Wide_Wide_Character
, E_Enumeration_Type
);
665 Set_Etype
(Standard_Wide_Wide_Character
,
666 Standard_Wide_Wide_Character
);
667 Init_Size
(Standard_Wide_Wide_Character
,
668 Standard_Wide_Wide_Character_Size
);
670 Set_Elem_Alignment
(Standard_Wide_Wide_Character
);
671 Set_Has_Pragma_Ordered
(Standard_Wide_Wide_Character
);
672 Set_Is_Unsigned_Type
(Standard_Wide_Wide_Character
);
673 Set_Is_Character_Type
(Standard_Wide_Wide_Character
);
674 Set_Is_Known_Valid
(Standard_Wide_Wide_Character
);
675 Set_Size_Known_At_Compile_Time
(Standard_Wide_Wide_Character
);
676 Set_Is_Ada_2005_Only
(Standard_Wide_Wide_Character
);
678 -- Create the bounds for type Wide_Wide_Character
680 R_Node
:= New_Node
(N_Range
, Stloc
);
682 -- Low bound for type Wide_Wide_Character
684 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
685 Set_Is_Static_Expression
(B_Node
);
686 Set_Chars
(B_Node
, No_Name
); -- ???
687 Set_Char_Literal_Value
(B_Node
, Uint_0
);
688 Set_Entity
(B_Node
, Empty
);
689 Set_Etype
(B_Node
, Standard_Wide_Wide_Character
);
690 Set_Low_Bound
(R_Node
, B_Node
);
692 -- High bound for type Wide_Wide_Character
694 B_Node
:= New_Node
(N_Character_Literal
, Stloc
);
695 Set_Is_Static_Expression
(B_Node
);
696 Set_Chars
(B_Node
, No_Name
); -- ???
697 Set_Char_Literal_Value
(B_Node
, UI_From_Int
(16#
7FFF_FFFF#
));
698 Set_Entity
(B_Node
, Empty
);
699 Set_Etype
(B_Node
, Standard_Wide_Wide_Character
);
700 Set_High_Bound
(R_Node
, B_Node
);
702 Set_Scalar_Range
(Standard_Wide_Wide_Character
, R_Node
);
703 Set_Etype
(R_Node
, Standard_Wide_Wide_Character
);
704 Set_Parent
(R_Node
, Standard_Wide_Wide_Character
);
706 -- Create type definition node for type String
708 Tdef_Node
:= New_Node
(N_Unconstrained_Array_Definition
, Stloc
);
711 CompDef_Node
: Node_Id
;
713 CompDef_Node
:= New_Node
(N_Component_Definition
, Stloc
);
714 Set_Aliased_Present
(CompDef_Node
, False);
715 Set_Access_Definition
(CompDef_Node
, Empty
);
716 Set_Subtype_Indication
(CompDef_Node
, Identifier_For
(S_Character
));
717 Set_Component_Definition
(Tdef_Node
, CompDef_Node
);
720 Set_Subtype_Marks
(Tdef_Node
, New_List
);
721 Append
(Identifier_For
(S_Positive
), Subtype_Marks
(Tdef_Node
));
722 Set_Type_Definition
(Parent
(Standard_String
), Tdef_Node
);
724 Set_Ekind
(Standard_String
, E_String_Type
);
725 Set_Etype
(Standard_String
, Standard_String
);
726 Set_Component_Type
(Standard_String
, Standard_Character
);
727 Set_Component_Size
(Standard_String
, Uint_8
);
728 Init_Size_Align
(Standard_String
);
729 Set_Alignment
(Standard_String
, Uint_1
);
730 Pack_String_Type
(Standard_String
);
732 -- On targets where a storage unit is larger than a byte (such as AAMP),
733 -- pragma Pack has a real effect on the representation of type String,
734 -- and the type must be marked as having a nonstandard representation.
736 if System_Storage_Unit
> Uint_8
then
737 Set_Has_Non_Standard_Rep
(Standard_String
);
738 Set_Has_Pragma_Pack
(Standard_String
);
741 -- Set index type of String
744 (Subtype_Marks
(Type_Definition
(Parent
(Standard_String
))));
745 Set_First_Index
(Standard_String
, E_Id
);
746 Set_Entity
(E_Id
, Standard_Positive
);
747 Set_Etype
(E_Id
, Standard_Positive
);
749 -- Create type definition node for type Wide_String
751 Tdef_Node
:= New_Node
(N_Unconstrained_Array_Definition
, Stloc
);
754 CompDef_Node
: Node_Id
;
756 CompDef_Node
:= New_Node
(N_Component_Definition
, Stloc
);
757 Set_Aliased_Present
(CompDef_Node
, False);
758 Set_Access_Definition
(CompDef_Node
, Empty
);
759 Set_Subtype_Indication
(CompDef_Node
,
760 Identifier_For
(S_Wide_Character
));
761 Set_Component_Definition
(Tdef_Node
, CompDef_Node
);
764 Set_Subtype_Marks
(Tdef_Node
, New_List
);
765 Append
(Identifier_For
(S_Positive
), Subtype_Marks
(Tdef_Node
));
766 Set_Type_Definition
(Parent
(Standard_Wide_String
), Tdef_Node
);
768 Set_Ekind
(Standard_Wide_String
, E_String_Type
);
769 Set_Etype
(Standard_Wide_String
, Standard_Wide_String
);
770 Set_Component_Type
(Standard_Wide_String
, Standard_Wide_Character
);
771 Set_Component_Size
(Standard_Wide_String
, Uint_16
);
772 Init_Size_Align
(Standard_Wide_String
);
773 Pack_String_Type
(Standard_Wide_String
);
775 -- Set index type of Wide_String
778 (Subtype_Marks
(Type_Definition
(Parent
(Standard_Wide_String
))));
779 Set_First_Index
(Standard_Wide_String
, E_Id
);
780 Set_Entity
(E_Id
, Standard_Positive
);
781 Set_Etype
(E_Id
, Standard_Positive
);
783 -- Create type definition node for type Wide_Wide_String
785 Tdef_Node
:= New_Node
(N_Unconstrained_Array_Definition
, Stloc
);
788 CompDef_Node
: Node_Id
;
790 CompDef_Node
:= New_Node
(N_Component_Definition
, Stloc
);
791 Set_Aliased_Present
(CompDef_Node
, False);
792 Set_Access_Definition
(CompDef_Node
, Empty
);
793 Set_Subtype_Indication
(CompDef_Node
,
794 Identifier_For
(S_Wide_Wide_Character
));
795 Set_Component_Definition
(Tdef_Node
, CompDef_Node
);
798 Set_Subtype_Marks
(Tdef_Node
, New_List
);
799 Append
(Identifier_For
(S_Positive
), Subtype_Marks
(Tdef_Node
));
800 Set_Type_Definition
(Parent
(Standard_Wide_Wide_String
), Tdef_Node
);
802 Set_Ekind
(Standard_Wide_Wide_String
, E_String_Type
);
803 Set_Etype
(Standard_Wide_Wide_String
,
804 Standard_Wide_Wide_String
);
805 Set_Component_Type
(Standard_Wide_Wide_String
,
806 Standard_Wide_Wide_Character
);
807 Set_Component_Size
(Standard_Wide_Wide_String
, Uint_32
);
808 Init_Size_Align
(Standard_Wide_Wide_String
);
809 Set_Is_Ada_2005_Only
(Standard_Wide_Wide_String
);
810 Pack_String_Type
(Standard_Wide_Wide_String
);
812 -- Set index type of Wide_Wide_String
815 (Subtype_Marks
(Type_Definition
(Parent
(Standard_Wide_Wide_String
))));
816 Set_First_Index
(Standard_Wide_Wide_String
, E_Id
);
817 Set_Entity
(E_Id
, Standard_Positive
);
818 Set_Etype
(E_Id
, Standard_Positive
);
820 -- Setup entity for Naturalend Create_Standard;
822 Set_Ekind
(Standard_Natural
, E_Signed_Integer_Subtype
);
823 Set_Etype
(Standard_Natural
, Base_Type
(Standard_Integer
));
824 Init_Esize
(Standard_Natural
, Standard_Integer_Size
);
825 Init_RM_Size
(Standard_Natural
, Standard_Integer_Size
- 1);
826 Set_Elem_Alignment
(Standard_Natural
);
827 Set_Size_Known_At_Compile_Time
829 Set_Integer_Bounds
(Standard_Natural
,
830 Typ
=> Base_Type
(Standard_Integer
),
832 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
833 Set_Is_Constrained
(Standard_Natural
);
835 -- Setup entity for Positive
837 Set_Ekind
(Standard_Positive
, E_Signed_Integer_Subtype
);
838 Set_Etype
(Standard_Positive
, Base_Type
(Standard_Integer
));
839 Init_Esize
(Standard_Positive
, Standard_Integer_Size
);
840 Init_RM_Size
(Standard_Positive
, Standard_Integer_Size
- 1);
841 Set_Elem_Alignment
(Standard_Positive
);
843 Set_Size_Known_At_Compile_Time
(Standard_Positive
);
845 Set_Integer_Bounds
(Standard_Positive
,
846 Typ
=> Base_Type
(Standard_Integer
),
848 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
849 Set_Is_Constrained
(Standard_Positive
);
851 -- Create declaration for package ASCII
853 Decl
:= New_Node
(N_Package_Declaration
, Stloc
);
854 Append
(Decl
, Decl_S
);
856 Pspec
:= New_Node
(N_Package_Specification
, Stloc
);
857 Set_Specification
(Decl
, Pspec
);
859 Set_Defining_Unit_Name
(Pspec
, Standard_Entity
(S_ASCII
));
860 Set_Ekind
(Standard_Entity
(S_ASCII
), E_Package
);
861 Set_Visible_Declarations
(Pspec
, Decl_A
);
863 -- Create control character definitions in package ASCII. Note that
864 -- the character literal entries created here correspond to literal
865 -- values that are impossible in the source, but can be represented
866 -- internally with no difficulties.
870 for S
in S_ASCII_Names
loop
871 Decl
:= New_Node
(N_Object_Declaration
, Staloc
);
872 Set_Constant_Present
(Decl
, True);
875 A_Char
: constant Entity_Id
:= Standard_Entity
(S
);
879 Set_Sloc
(A_Char
, Staloc
);
880 Set_Ekind
(A_Char
, E_Constant
);
881 Set_Never_Set_In_Source
(A_Char
, True);
882 Set_Is_True_Constant
(A_Char
, True);
883 Set_Etype
(A_Char
, Standard_Character
);
884 Set_Scope
(A_Char
, Standard_Entity
(S_ASCII
));
885 Set_Is_Immediately_Visible
(A_Char
, False);
886 Set_Is_Public
(A_Char
, True);
887 Set_Is_Known_Valid
(A_Char
, True);
889 Append_Entity
(A_Char
, Standard_Entity
(S_ASCII
));
890 Set_Defining_Identifier
(Decl
, A_Char
);
892 Set_Object_Definition
(Decl
, Identifier_For
(S_Character
));
893 Expr_Decl
:= New_Node
(N_Character_Literal
, Staloc
);
894 Set_Expression
(Decl
, Expr_Decl
);
896 Set_Is_Static_Expression
(Expr_Decl
);
897 Set_Chars
(Expr_Decl
, No_Name
);
898 Set_Etype
(Expr_Decl
, Standard_Character
);
899 Set_Char_Literal_Value
(Expr_Decl
, UI_From_Int
(Int
(Ccode
)));
902 Append
(Decl
, Decl_A
);
904 -- Increment character code, dealing with non-contiguities
908 if Ccode
= 16#
20#
then
910 elsif Ccode
= 16#
27#
then
912 elsif Ccode
= 16#
3C#
then
914 elsif Ccode
= 16#
41#
then
919 -- Create semantic phase entities
921 Standard_Void_Type
:= New_Standard_Entity
;
922 Set_Ekind
(Standard_Void_Type
, E_Void
);
923 Set_Etype
(Standard_Void_Type
, Standard_Void_Type
);
924 Set_Scope
(Standard_Void_Type
, Standard_Standard
);
925 Make_Name
(Standard_Void_Type
, "_void_type");
927 -- The type field of packages is set to void
929 Set_Etype
(Standard_Standard
, Standard_Void_Type
);
930 Set_Etype
(Standard_ASCII
, Standard_Void_Type
);
932 -- Standard_A_String is actually used in generated code, so it has a
933 -- type name that is reasonable, but does not overlap any Ada name.
935 Standard_A_String
:= New_Standard_Entity
;
936 Set_Ekind
(Standard_A_String
, E_Access_Type
);
937 Set_Scope
(Standard_A_String
, Standard_Standard
);
938 Set_Etype
(Standard_A_String
, Standard_A_String
);
941 Init_Size
(Standard_A_String
, System_Address_Size
);
943 Init_Size
(Standard_A_String
, System_Address_Size
* 2);
946 Init_Alignment
(Standard_A_String
);
948 Set_Directly_Designated_Type
949 (Standard_A_String
, Standard_String
);
950 Make_Name
(Standard_A_String
, "access_string");
952 Standard_A_Char
:= New_Standard_Entity
;
953 Set_Ekind
(Standard_A_Char
, E_Access_Type
);
954 Set_Scope
(Standard_A_Char
, Standard_Standard
);
955 Set_Etype
(Standard_A_Char
, Standard_A_String
);
956 Init_Size
(Standard_A_Char
, System_Address_Size
);
957 Set_Elem_Alignment
(Standard_A_Char
);
959 Set_Directly_Designated_Type
(Standard_A_Char
, Standard_Character
);
960 Make_Name
(Standard_A_Char
, "access_character");
962 -- Standard_Debug_Renaming_Type is used for the special objects created
963 -- to encode the names occurring in renaming declarations for use by the
964 -- debugger (see exp_dbug.adb). The type is a zero-sized subtype of
967 Standard_Debug_Renaming_Type
:= New_Standard_Entity
;
969 Set_Ekind
(Standard_Debug_Renaming_Type
, E_Signed_Integer_Subtype
);
970 Set_Scope
(Standard_Debug_Renaming_Type
, Standard_Standard
);
971 Set_Etype
(Standard_Debug_Renaming_Type
, Base_Type
(Standard_Integer
));
972 Init_Esize
(Standard_Debug_Renaming_Type
, 0);
973 Init_RM_Size
(Standard_Debug_Renaming_Type
, 0);
974 Set_Size_Known_At_Compile_Time
(Standard_Debug_Renaming_Type
);
975 Set_Integer_Bounds
(Standard_Debug_Renaming_Type
,
976 Typ
=> Base_Type
(Standard_Debug_Renaming_Type
),
979 Set_Is_Constrained
(Standard_Debug_Renaming_Type
);
980 Set_Has_Size_Clause
(Standard_Debug_Renaming_Type
);
982 Make_Name
(Standard_Debug_Renaming_Type
, "_renaming_type");
984 -- Note on type names. The type names for the following special types
985 -- are constructed so that they will look reasonable should they ever
986 -- appear in error messages etc, although in practice the use of the
987 -- special insertion character } for types results in special handling
988 -- of these type names in any case. The blanks in these names would
989 -- trouble in Gigi, but that's OK here, since none of these types
990 -- should ever get through to Gigi! Attributes of these types are
991 -- filled out to minimize problems with cascaded errors (for example,
992 -- Any_Integer is given reasonable and consistent type and size values)
994 Any_Type
:= New_Standard_Entity
;
995 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
996 Set_Defining_Identifier
(Decl
, Any_Type
);
997 Set_Scope
(Any_Type
, Standard_Standard
);
998 Build_Signed_Integer_Type
(Any_Type
, Standard_Integer_Size
);
999 Make_Name
(Any_Type
, "any type");
1001 Any_Id
:= New_Standard_Entity
;
1002 Set_Ekind
(Any_Id
, E_Variable
);
1003 Set_Scope
(Any_Id
, Standard_Standard
);
1004 Set_Etype
(Any_Id
, Any_Type
);
1005 Init_Esize
(Any_Id
);
1006 Init_Alignment
(Any_Id
);
1007 Make_Name
(Any_Id
, "any id");
1009 Any_Access
:= New_Standard_Entity
;
1010 Set_Ekind
(Any_Access
, E_Access_Type
);
1011 Set_Scope
(Any_Access
, Standard_Standard
);
1012 Set_Etype
(Any_Access
, Any_Access
);
1013 Init_Size
(Any_Access
, System_Address_Size
);
1014 Set_Elem_Alignment
(Any_Access
);
1015 Make_Name
(Any_Access
, "an access type");
1017 Any_Character
:= New_Standard_Entity
;
1018 Set_Ekind
(Any_Character
, E_Enumeration_Type
);
1019 Set_Scope
(Any_Character
, Standard_Standard
);
1020 Set_Etype
(Any_Character
, Any_Character
);
1021 Set_Is_Unsigned_Type
(Any_Character
);
1022 Set_Is_Character_Type
(Any_Character
);
1023 Init_Esize
(Any_Character
, Standard_Character_Size
);
1024 Init_RM_Size
(Any_Character
, 8);
1025 Set_Elem_Alignment
(Any_Character
);
1026 Set_Scalar_Range
(Any_Character
, Scalar_Range
(Standard_Character
));
1027 Make_Name
(Any_Character
, "a character type");
1029 Any_Array
:= New_Standard_Entity
;
1030 Set_Ekind
(Any_Array
, E_String_Type
);
1031 Set_Scope
(Any_Array
, Standard_Standard
);
1032 Set_Etype
(Any_Array
, Any_Array
);
1033 Set_Component_Type
(Any_Array
, Any_Character
);
1034 Init_Size_Align
(Any_Array
);
1035 Make_Name
(Any_Array
, "an array type");
1037 Any_Boolean
:= New_Standard_Entity
;
1038 Set_Ekind
(Any_Boolean
, E_Enumeration_Type
);
1039 Set_Scope
(Any_Boolean
, Standard_Standard
);
1040 Set_Etype
(Any_Boolean
, Standard_Boolean
);
1041 Init_Esize
(Any_Boolean
, Standard_Character_Size
);
1042 Init_RM_Size
(Any_Boolean
, 1);
1043 Set_Elem_Alignment
(Any_Boolean
);
1044 Set_Is_Unsigned_Type
(Any_Boolean
);
1045 Set_Scalar_Range
(Any_Boolean
, Scalar_Range
(Standard_Boolean
));
1046 Make_Name
(Any_Boolean
, "a boolean type");
1048 Any_Composite
:= New_Standard_Entity
;
1049 Set_Ekind
(Any_Composite
, E_Array_Type
);
1050 Set_Scope
(Any_Composite
, Standard_Standard
);
1051 Set_Etype
(Any_Composite
, Any_Composite
);
1052 Set_Component_Size
(Any_Composite
, Uint_0
);
1053 Set_Component_Type
(Any_Composite
, Standard_Integer
);
1054 Init_Size_Align
(Any_Composite
);
1055 Make_Name
(Any_Composite
, "a composite type");
1057 Any_Discrete
:= New_Standard_Entity
;
1058 Set_Ekind
(Any_Discrete
, E_Signed_Integer_Type
);
1059 Set_Scope
(Any_Discrete
, Standard_Standard
);
1060 Set_Etype
(Any_Discrete
, Any_Discrete
);
1061 Init_Size
(Any_Discrete
, Standard_Integer_Size
);
1062 Set_Elem_Alignment
(Any_Discrete
);
1063 Make_Name
(Any_Discrete
, "a discrete type");
1065 Any_Fixed
:= New_Standard_Entity
;
1066 Set_Ekind
(Any_Fixed
, E_Ordinary_Fixed_Point_Type
);
1067 Set_Scope
(Any_Fixed
, Standard_Standard
);
1068 Set_Etype
(Any_Fixed
, Any_Fixed
);
1069 Init_Size
(Any_Fixed
, Standard_Integer_Size
);
1070 Set_Elem_Alignment
(Any_Fixed
);
1071 Make_Name
(Any_Fixed
, "a fixed-point type");
1073 Any_Integer
:= New_Standard_Entity
;
1074 Set_Ekind
(Any_Integer
, E_Signed_Integer_Type
);
1075 Set_Scope
(Any_Integer
, Standard_Standard
);
1076 Set_Etype
(Any_Integer
, Standard_Long_Long_Integer
);
1077 Init_Size
(Any_Integer
, Standard_Long_Long_Integer_Size
);
1078 Set_Elem_Alignment
(Any_Integer
);
1082 Typ
=> Base_Type
(Standard_Integer
),
1084 Hb
=> Intval
(High_Bound
(Scalar_Range
(Standard_Integer
))));
1085 Make_Name
(Any_Integer
, "an integer type");
1087 Any_Modular
:= New_Standard_Entity
;
1088 Set_Ekind
(Any_Modular
, E_Modular_Integer_Type
);
1089 Set_Scope
(Any_Modular
, Standard_Standard
);
1090 Set_Etype
(Any_Modular
, Standard_Long_Long_Integer
);
1091 Init_Size
(Any_Modular
, Standard_Long_Long_Integer_Size
);
1092 Set_Elem_Alignment
(Any_Modular
);
1093 Set_Is_Unsigned_Type
(Any_Modular
);
1094 Make_Name
(Any_Modular
, "a modular type");
1096 Any_Numeric
:= New_Standard_Entity
;
1097 Set_Ekind
(Any_Numeric
, E_Signed_Integer_Type
);
1098 Set_Scope
(Any_Numeric
, Standard_Standard
);
1099 Set_Etype
(Any_Numeric
, Standard_Long_Long_Integer
);
1100 Init_Size
(Any_Numeric
, Standard_Long_Long_Integer_Size
);
1101 Set_Elem_Alignment
(Any_Numeric
);
1102 Make_Name
(Any_Numeric
, "a numeric type");
1104 Any_Real
:= New_Standard_Entity
;
1105 Set_Ekind
(Any_Real
, E_Floating_Point_Type
);
1106 Set_Scope
(Any_Real
, Standard_Standard
);
1107 Set_Etype
(Any_Real
, Standard_Long_Long_Float
);
1108 Init_Size
(Any_Real
, Standard_Long_Long_Float_Size
);
1109 Set_Elem_Alignment
(Any_Real
);
1110 Make_Name
(Any_Real
, "a real type");
1112 Any_Scalar
:= New_Standard_Entity
;
1113 Set_Ekind
(Any_Scalar
, E_Signed_Integer_Type
);
1114 Set_Scope
(Any_Scalar
, Standard_Standard
);
1115 Set_Etype
(Any_Scalar
, Any_Scalar
);
1116 Init_Size
(Any_Scalar
, Standard_Integer_Size
);
1117 Set_Elem_Alignment
(Any_Scalar
);
1118 Make_Name
(Any_Scalar
, "a scalar type");
1120 Any_String
:= New_Standard_Entity
;
1121 Set_Ekind
(Any_String
, E_String_Type
);
1122 Set_Scope
(Any_String
, Standard_Standard
);
1123 Set_Etype
(Any_String
, Any_String
);
1124 Set_Component_Type
(Any_String
, Any_Character
);
1125 Init_Size_Align
(Any_String
);
1126 Make_Name
(Any_String
, "a string type");
1134 Low_Bound
=> Make_Integer
(Uint_0
),
1135 High_Bound
=> Make_Integer
(Uint_2
** Standard_Integer_Size
));
1136 Set_Etype
(Index
, Standard_Integer
);
1137 Set_First_Index
(Any_String
, Index
);
1140 Standard_Integer_8
:= New_Standard_Entity
;
1141 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1142 Set_Defining_Identifier
(Decl
, Standard_Integer_8
);
1143 Make_Name
(Standard_Integer_8
, "integer_8");
1144 Set_Scope
(Standard_Integer_8
, Standard_Standard
);
1145 Build_Signed_Integer_Type
(Standard_Integer_8
, 8);
1147 Standard_Integer_16
:= New_Standard_Entity
;
1148 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1149 Set_Defining_Identifier
(Decl
, Standard_Integer_16
);
1150 Make_Name
(Standard_Integer_16
, "integer_16");
1151 Set_Scope
(Standard_Integer_16
, Standard_Standard
);
1152 Build_Signed_Integer_Type
(Standard_Integer_16
, 16);
1154 Standard_Integer_32
:= New_Standard_Entity
;
1155 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1156 Set_Defining_Identifier
(Decl
, Standard_Integer_32
);
1157 Make_Name
(Standard_Integer_32
, "integer_32");
1158 Set_Scope
(Standard_Integer_32
, Standard_Standard
);
1159 Build_Signed_Integer_Type
(Standard_Integer_32
, 32);
1161 Standard_Integer_64
:= New_Standard_Entity
;
1162 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1163 Set_Defining_Identifier
(Decl
, Standard_Integer_64
);
1164 Make_Name
(Standard_Integer_64
, "integer_64");
1165 Set_Scope
(Standard_Integer_64
, Standard_Standard
);
1166 Build_Signed_Integer_Type
(Standard_Integer_64
, 64);
1168 Standard_Unsigned
:= New_Standard_Entity
;
1169 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1170 Set_Defining_Identifier
(Decl
, Standard_Unsigned
);
1171 Make_Name
(Standard_Unsigned
, "unsigned");
1173 Set_Ekind
(Standard_Unsigned
, E_Modular_Integer_Type
);
1174 Set_Scope
(Standard_Unsigned
, Standard_Standard
);
1175 Set_Etype
(Standard_Unsigned
, Standard_Unsigned
);
1176 Init_Size
(Standard_Unsigned
, Standard_Integer_Size
);
1177 Set_Elem_Alignment
(Standard_Unsigned
);
1178 Set_Modulus
(Standard_Unsigned
,
1179 Uint_2
** Standard_Integer_Size
);
1180 Set_Is_Unsigned_Type
(Standard_Unsigned
);
1181 Set_Size_Known_At_Compile_Time
1182 (Standard_Unsigned
);
1183 Set_Is_Known_Valid
(Standard_Unsigned
, True);
1185 R_Node
:= New_Node
(N_Range
, Stloc
);
1186 Set_Low_Bound
(R_Node
, Make_Integer
(Uint_0
));
1187 Set_High_Bound
(R_Node
, Make_Integer
(Modulus
(Standard_Unsigned
) - 1));
1188 Set_Etype
(Low_Bound
(R_Node
), Standard_Unsigned
);
1189 Set_Etype
(High_Bound
(R_Node
), Standard_Unsigned
);
1190 Set_Scalar_Range
(Standard_Unsigned
, R_Node
);
1192 -- Note: universal integer and universal real are constructed as fully
1193 -- formed signed numeric types, with parameters corresponding to the
1194 -- longest runtime types (Long_Long_Integer and Long_Long_Float). This
1195 -- allows Gigi to properly process references to universal types that
1196 -- are not folded at compile time.
1198 Universal_Integer
:= New_Standard_Entity
;
1199 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1200 Set_Defining_Identifier
(Decl
, Universal_Integer
);
1201 Make_Name
(Universal_Integer
, "universal_integer");
1202 Set_Scope
(Universal_Integer
, Standard_Standard
);
1203 Build_Signed_Integer_Type
1204 (Universal_Integer
, Standard_Long_Long_Integer_Size
);
1206 Universal_Real
:= New_Standard_Entity
;
1207 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1208 Set_Defining_Identifier
(Decl
, Universal_Real
);
1209 Make_Name
(Universal_Real
, "universal_real");
1210 Set_Scope
(Universal_Real
, Standard_Standard
);
1213 Standard_Long_Long_Float_Size
,
1214 Standard_Long_Long_Float_Digits
);
1216 -- Note: universal fixed, unlike universal integer and universal real,
1217 -- is never used at runtime, so it does not need to have bounds set.
1219 Universal_Fixed
:= New_Standard_Entity
;
1220 Decl
:= New_Node
(N_Full_Type_Declaration
, Stloc
);
1221 Set_Defining_Identifier
(Decl
, Universal_Fixed
);
1222 Make_Name
(Universal_Fixed
, "universal_fixed");
1223 Set_Ekind
(Universal_Fixed
, E_Ordinary_Fixed_Point_Type
);
1224 Set_Etype
(Universal_Fixed
, Universal_Fixed
);
1225 Set_Scope
(Universal_Fixed
, Standard_Standard
);
1226 Init_Size
(Universal_Fixed
, Standard_Long_Long_Integer_Size
);
1227 Set_Elem_Alignment
(Universal_Fixed
);
1228 Set_Size_Known_At_Compile_Time
1231 -- Create type declaration for Duration, using a 64-bit size. The
1232 -- delta and size values depend on the mode set in system.ads.
1234 Build_Duration
: declare
1240 -- In 32 bit mode, the size is 32 bits, and the delta and
1241 -- small values are set to 20 milliseconds (20.0**(10.0**(-3)).
1243 if Duration_32_Bits_On_Target
then
1244 Dlo
:= Intval
(Type_Low_Bound
(Standard_Integer_32
));
1245 Dhi
:= Intval
(Type_High_Bound
(Standard_Integer_32
));
1246 Delta_Val
:= UR_From_Components
(UI_From_Int
(20), Uint_3
, 10);
1248 -- In standard 64-bit mode, the size is 64-bits and the delta and
1249 -- small values are set to nanoseconds (1.0**(10.0**(-9))
1252 Dlo
:= Intval
(Type_Low_Bound
(Standard_Integer_64
));
1253 Dhi
:= Intval
(Type_High_Bound
(Standard_Integer_64
));
1254 Delta_Val
:= UR_From_Components
(Uint_1
, Uint_9
, 10);
1257 Tdef_Node
:= Make_Ordinary_Fixed_Point_Definition
(Stloc
,
1258 Delta_Expression
=> Make_Real_Literal
(Stloc
, Delta_Val
),
1259 Real_Range_Specification
=>
1260 Make_Real_Range_Specification
(Stloc
,
1261 Low_Bound
=> Make_Real_Literal
(Stloc
,
1262 Realval
=> Dlo
* Delta_Val
),
1263 High_Bound
=> Make_Real_Literal
(Stloc
,
1264 Realval
=> Dhi
* Delta_Val
)));
1266 Set_Type_Definition
(Parent
(Standard_Duration
), Tdef_Node
);
1268 Set_Ekind
(Standard_Duration
, E_Ordinary_Fixed_Point_Type
);
1269 Set_Etype
(Standard_Duration
, Standard_Duration
);
1271 if Duration_32_Bits_On_Target
then
1272 Init_Size
(Standard_Duration
, 32);
1274 Init_Size
(Standard_Duration
, 64);
1277 Set_Elem_Alignment
(Standard_Duration
);
1278 Set_Delta_Value
(Standard_Duration
, Delta_Val
);
1279 Set_Small_Value
(Standard_Duration
, Delta_Val
);
1280 Set_Scalar_Range
(Standard_Duration
,
1281 Real_Range_Specification
1282 (Type_Definition
(Parent
(Standard_Duration
))));
1284 -- Normally it does not matter that nodes in package Standard are
1285 -- not marked as analyzed. The Scalar_Range of the fixed-point
1286 -- type Standard_Duration is an exception, because of the special
1287 -- test made in Freeze.Freeze_Fixed_Point_Type.
1289 Set_Analyzed
(Scalar_Range
(Standard_Duration
));
1291 Set_Etype
(Type_High_Bound
(Standard_Duration
), Standard_Duration
);
1292 Set_Etype
(Type_Low_Bound
(Standard_Duration
), Standard_Duration
);
1294 Set_Is_Static_Expression
(Type_High_Bound
(Standard_Duration
));
1295 Set_Is_Static_Expression
(Type_Low_Bound
(Standard_Duration
));
1297 Set_Corresponding_Integer_Value
1298 (Type_High_Bound
(Standard_Duration
), Dhi
);
1300 Set_Corresponding_Integer_Value
1301 (Type_Low_Bound
(Standard_Duration
), Dlo
);
1303 Set_Size_Known_At_Compile_Time
(Standard_Duration
);
1306 -- Build standard exception type. Note that the type name here is
1307 -- actually used in the generated code, so it must be set correctly
1309 -- ??? Also note that the Import_Code component is now declared
1310 -- as a System.Standard_Library.Exception_Code to enforce run-time
1311 -- library implementation consistency. It's too early here to resort
1312 -- to rtsfind to get the proper node for that type, so we use the
1313 -- closest possible available type node at hand instead. We should
1314 -- probably be fixing this up at some point.
1316 Standard_Exception_Type
:= New_Standard_Entity
;
1317 Set_Ekind
(Standard_Exception_Type
, E_Record_Type
);
1318 Set_Etype
(Standard_Exception_Type
, Standard_Exception_Type
);
1319 Set_Scope
(Standard_Exception_Type
, Standard_Standard
);
1320 Set_Stored_Constraint
1321 (Standard_Exception_Type
, No_Elist
);
1322 Init_Size_Align
(Standard_Exception_Type
);
1323 Set_Size_Known_At_Compile_Time
1324 (Standard_Exception_Type
, True);
1325 Make_Name
(Standard_Exception_Type
, "exception");
1328 (Standard_Exception_Type
, Standard_Boolean
, "Not_Handled_By_Others");
1330 (Standard_Exception_Type
, Standard_Character
, "Lang");
1332 (Standard_Exception_Type
, Standard_Natural
, "Name_Length");
1334 (Standard_Exception_Type
, Standard_A_Char
, "Full_Name");
1336 (Standard_Exception_Type
, Standard_A_Char
, "HTable_Ptr");
1338 (Standard_Exception_Type
, Standard_Unsigned
, "Import_Code");
1340 (Standard_Exception_Type
, Standard_A_Char
, "Raise_Hook");
1342 -- Build tree for record declaration, for use by the back-end
1345 Comp_List
: List_Id
;
1349 Comp
:= First_Entity
(Standard_Exception_Type
);
1350 Comp_List
:= New_List
;
1351 while Present
(Comp
) loop
1353 Make_Component_Declaration
(Stloc
,
1354 Defining_Identifier
=> Comp
,
1355 Component_Definition
=>
1356 Make_Component_Definition
(Stloc
,
1357 Aliased_Present
=> False,
1358 Subtype_Indication
=> New_Occurrence_Of
(Etype
(Comp
),
1365 Decl
:= Make_Full_Type_Declaration
(Stloc
,
1366 Defining_Identifier
=> Standard_Exception_Type
,
1368 Make_Record_Definition
(Stloc
,
1371 Make_Component_List
(Stloc
,
1372 Component_Items
=> Comp_List
)));
1375 Append
(Decl
, Decl_S
);
1377 Layout_Type
(Standard_Exception_Type
);
1379 -- Create declarations of standard exceptions
1381 Build_Exception
(S_Constraint_Error
);
1382 Build_Exception
(S_Program_Error
);
1383 Build_Exception
(S_Storage_Error
);
1384 Build_Exception
(S_Tasking_Error
);
1386 -- Numeric_Error is a normal exception in Ada 83, but in Ada 95
1387 -- it is a renaming of Constraint_Error. Is this test too early???
1389 if Ada_Version
= Ada_83
then
1390 Build_Exception
(S_Numeric_Error
);
1393 Decl
:= New_Node
(N_Exception_Renaming_Declaration
, Stloc
);
1394 E_Id
:= Standard_Entity
(S_Numeric_Error
);
1396 Set_Ekind
(E_Id
, E_Exception
);
1397 Set_Exception_Code
(E_Id
, Uint_0
);
1398 Set_Etype
(E_Id
, Standard_Exception_Type
);
1399 Set_Is_Public
(E_Id
);
1400 Set_Renamed_Entity
(E_Id
, Standard_Entity
(S_Constraint_Error
));
1402 Set_Defining_Identifier
(Decl
, E_Id
);
1403 Append
(Decl
, Decl_S
);
1405 Ident_Node
:= New_Node
(N_Identifier
, Stloc
);
1406 Set_Chars
(Ident_Node
, Chars
(Standard_Entity
(S_Constraint_Error
)));
1407 Set_Entity
(Ident_Node
, Standard_Entity
(S_Constraint_Error
));
1408 Set_Name
(Decl
, Ident_Node
);
1411 -- Abort_Signal is an entity that does not get made visible
1413 Abort_Signal
:= New_Standard_Entity
;
1414 Set_Chars
(Abort_Signal
, Name_uAbort_Signal
);
1415 Set_Ekind
(Abort_Signal
, E_Exception
);
1416 Set_Exception_Code
(Abort_Signal
, Uint_0
);
1417 Set_Etype
(Abort_Signal
, Standard_Exception_Type
);
1418 Set_Scope
(Abort_Signal
, Standard_Standard
);
1419 Set_Is_Public
(Abort_Signal
, True);
1421 Make_Exception_Declaration
(Stloc
,
1422 Defining_Identifier
=> Abort_Signal
);
1424 -- Create defining identifiers for shift operator entities. Note
1425 -- that these entities are used only for marking shift operators
1426 -- generated internally, and hence need no structure, just a name
1427 -- and a unique identity.
1429 Standard_Op_Rotate_Left
:= New_Standard_Entity
;
1430 Set_Chars
(Standard_Op_Rotate_Left
, Name_Rotate_Left
);
1431 Set_Ekind
(Standard_Op_Rotate_Left
, E_Operator
);
1433 Standard_Op_Rotate_Right
:= New_Standard_Entity
;
1434 Set_Chars
(Standard_Op_Rotate_Right
, Name_Rotate_Right
);
1435 Set_Ekind
(Standard_Op_Rotate_Right
, E_Operator
);
1437 Standard_Op_Shift_Left
:= New_Standard_Entity
;
1438 Set_Chars
(Standard_Op_Shift_Left
, Name_Shift_Left
);
1439 Set_Ekind
(Standard_Op_Shift_Left
, E_Operator
);
1441 Standard_Op_Shift_Right
:= New_Standard_Entity
;
1442 Set_Chars
(Standard_Op_Shift_Right
, Name_Shift_Right
);
1443 Set_Ekind
(Standard_Op_Shift_Right
, E_Operator
);
1445 Standard_Op_Shift_Right_Arithmetic
:= New_Standard_Entity
;
1446 Set_Chars
(Standard_Op_Shift_Right_Arithmetic
,
1447 Name_Shift_Right_Arithmetic
);
1448 Set_Ekind
(Standard_Op_Shift_Right_Arithmetic
,
1451 -- Create standard operator declarations
1455 -- Initialize visibility table with entities in Standard
1457 for E
in Standard_Entity_Type
loop
1458 if Ekind
(Standard_Entity
(E
)) /= E_Operator
then
1460 (Chars
(Standard_Entity
(E
)), Standard_Entity
(E
));
1461 Set_Homonym
(Standard_Entity
(E
), Empty
);
1464 if E
not in S_ASCII_Names
then
1465 Set_Scope
(Standard_Entity
(E
), Standard_Standard
);
1466 Set_Is_Immediately_Visible
(Standard_Entity
(E
));
1470 -- The predefined package Standard itself does not have a scope;
1471 -- it is the only entity in the system not to have one, and this
1472 -- is what identifies the package to Gigi.
1474 Set_Scope
(Standard_Standard
, Empty
);
1476 -- Set global variables indicating last Id values and version
1478 Last_Standard_Node_Id
:= Last_Node_Id
;
1479 Last_Standard_List_Id
:= Last_List_Id
;
1481 -- The Error node has an Etype of Any_Type to help error recovery
1483 Set_Etype
(Error
, Any_Type
);
1485 -- Print representation of standard if switch set
1487 if Opt
.Print_Standard
then
1490 end Create_Standard
;
1492 ------------------------------------
1493 -- Create_Unconstrained_Base_Type --
1494 ------------------------------------
1496 procedure Create_Unconstrained_Base_Type
1500 New_Ent
: constant Entity_Id
:= New_Copy
(E
);
1504 Set_Is_Constrained
(E
, True);
1505 Set_Is_First_Subtype
(E
, True);
1506 Set_Etype
(E
, New_Ent
);
1508 Append_Entity
(New_Ent
, Standard_Standard
);
1509 Set_Is_Constrained
(New_Ent
, False);
1510 Set_Etype
(New_Ent
, New_Ent
);
1511 Set_Is_Known_Valid
(New_Ent
, True);
1513 if K
= E_Signed_Integer_Subtype
then
1514 Set_Etype
(Low_Bound
(Scalar_Range
(E
)), New_Ent
);
1515 Set_Etype
(High_Bound
(Scalar_Range
(E
)), New_Ent
);
1518 end Create_Unconstrained_Base_Type
;
1520 --------------------
1521 -- Identifier_For --
1522 --------------------
1524 function Identifier_For
(S
: Standard_Entity_Type
) return Node_Id
is
1525 Ident_Node
: Node_Id
;
1527 Ident_Node
:= New_Node
(N_Identifier
, Stloc
);
1528 Set_Chars
(Ident_Node
, Chars
(Standard_Entity
(S
)));
1532 --------------------
1533 -- Make_Component --
1534 --------------------
1536 procedure Make_Component
1541 Id
: constant Entity_Id
:= New_Standard_Entity
;
1544 Set_Ekind
(Id
, E_Component
);
1545 Set_Etype
(Id
, Typ
);
1546 Set_Scope
(Id
, Rec
);
1547 Init_Component_Location
(Id
);
1549 Set_Original_Record_Component
(Id
, Id
);
1550 Make_Name
(Id
, Nam
);
1551 Append_Entity
(Id
, Rec
);
1558 function Make_Formal
1560 Formal_Name
: String) return Entity_Id
1565 Formal
:= New_Standard_Entity
;
1567 Set_Ekind
(Formal
, E_In_Parameter
);
1568 Set_Mechanism
(Formal
, Default_Mechanism
);
1569 Set_Scope
(Formal
, Standard_Standard
);
1570 Set_Etype
(Formal
, Typ
);
1571 Make_Name
(Formal
, Formal_Name
);
1580 function Make_Integer
(V
: Uint
) return Node_Id
is
1581 N
: constant Node_Id
:= Make_Integer_Literal
(Stloc
, V
);
1583 Set_Is_Static_Expression
(N
);
1591 procedure Make_Name
(Id
: Entity_Id
; Nam
: String) is
1593 for J
in 1 .. Nam
'Length loop
1594 Name_Buffer
(J
) := Fold_Lower
(Nam
(Nam
'First + (J
- 1)));
1597 Name_Len
:= Nam
'Length;
1598 Set_Chars
(Id
, Name_Find
);
1605 function New_Operator
(Op
: Name_Id
; Typ
: Entity_Id
) return Entity_Id
is
1606 Ident_Node
: Entity_Id
;
1609 Ident_Node
:= Make_Defining_Identifier
(Stloc
, Op
);
1611 Set_Is_Pure
(Ident_Node
, True);
1612 Set_Ekind
(Ident_Node
, E_Operator
);
1613 Set_Etype
(Ident_Node
, Typ
);
1614 Set_Scope
(Ident_Node
, Standard_Standard
);
1615 Set_Homonym
(Ident_Node
, Get_Name_Entity_Id
(Op
));
1616 Set_Convention
(Ident_Node
, Convention_Intrinsic
);
1618 Set_Is_Immediately_Visible
(Ident_Node
, True);
1619 Set_Is_Intrinsic_Subprogram
(Ident_Node
, True);
1621 Set_Name_Entity_Id
(Op
, Ident_Node
);
1622 Append_Entity
(Ident_Node
, Standard_Standard
);
1626 -------------------------
1627 -- New_Standard_Entity --
1628 -------------------------
1630 function New_Standard_Entity
1631 (New_Node_Kind
: Node_Kind
:= N_Defining_Identifier
) return Entity_Id
1633 E
: constant Entity_Id
:= New_Entity
(New_Node_Kind
, Stloc
);
1636 -- All standard entities are Pure and Public
1641 -- All standard entity names are analyzed manually, and are thus
1642 -- frozen as soon as they are created.
1646 -- Set debug information required for all standard types
1648 Set_Needs_Debug_Info
(E
);
1650 -- All standard entities are built with fully qualified names, so
1651 -- set the flag to prevent an abortive attempt at requalification!
1653 Set_Has_Qualified_Name
(E
);
1655 -- Return newly created entity to be completed by caller
1658 end New_Standard_Entity
;
1660 --------------------
1661 -- Print_Standard --
1662 --------------------
1664 procedure Print_Standard
is
1666 procedure P
(Item
: String) renames Output
.Write_Line
;
1667 -- Short-hand, since we do a lot of line writes here!
1669 procedure P_Int_Range
(Size
: Pos
);
1670 -- Prints the range of an integer based on its Size
1672 procedure P_Float_Range
(Id
: Entity_Id
);
1673 -- Prints the bounds range for the given float type entity
1679 procedure P_Float_Range
(Id
: Entity_Id
) is
1681 Write_Str
(" range ");
1682 UR_Write
(Realval
(Type_Low_Bound
(Id
)));
1684 UR_Write
(Realval
(Type_High_Bound
(Id
)));
1693 procedure P_Int_Range
(Size
: Pos
) is
1695 Write_Str
(" is range -(2 **");
1696 Write_Int
(Size
- 1);
1698 Write_Str
(" .. +(2 **");
1699 Write_Int
(Size
- 1);
1700 Write_Str
(" - 1);");
1704 -- Start of processing for Print_Standard
1707 P
("-- Representation of package Standard");
1709 P
("-- This is not accurate Ada, since new base types cannot be ");
1710 P
("-- created, but the listing shows the target dependent");
1711 P
("-- characteristics of the Standard types for this compiler");
1714 P
("package Standard is");
1715 P
("pragma Pure (Standard);");
1718 P
(" type Boolean is (False, True);");
1719 P
(" for Boolean'Size use 1;");
1720 P
(" for Boolean use (False => 0, True => 1);");
1725 Write_Str
(" type Integer");
1726 P_Int_Range
(Standard_Integer_Size
);
1727 Write_Str
(" for Integer'Size use ");
1728 Write_Int
(Standard_Integer_Size
);
1732 P
(" subtype Natural is Integer range 0 .. Integer'Last;");
1733 P
(" subtype Positive is Integer range 1 .. Integer'Last;");
1736 Write_Str
(" type Short_Short_Integer");
1737 P_Int_Range
(Standard_Short_Short_Integer_Size
);
1738 Write_Str
(" for Short_Short_Integer'Size use ");
1739 Write_Int
(Standard_Short_Short_Integer_Size
);
1743 Write_Str
(" type Short_Integer");
1744 P_Int_Range
(Standard_Short_Integer_Size
);
1745 Write_Str
(" for Short_Integer'Size use ");
1746 Write_Int
(Standard_Short_Integer_Size
);
1750 Write_Str
(" type Long_Integer");
1751 P_Int_Range
(Standard_Long_Integer_Size
);
1752 Write_Str
(" for Long_Integer'Size use ");
1753 Write_Int
(Standard_Long_Integer_Size
);
1757 Write_Str
(" type Long_Long_Integer");
1758 P_Int_Range
(Standard_Long_Long_Integer_Size
);
1759 Write_Str
(" for Long_Long_Integer'Size use ");
1760 Write_Int
(Standard_Long_Long_Integer_Size
);
1764 -- Floating point types
1766 Write_Str
(" type Short_Float is digits ");
1767 Write_Int
(Standard_Short_Float_Digits
);
1769 P_Float_Range
(Standard_Short_Float
);
1770 Write_Str
(" for Short_Float'Size use ");
1771 Write_Int
(Standard_Short_Float_Size
);
1775 Write_Str
(" type Float is digits ");
1776 Write_Int
(Standard_Float_Digits
);
1778 P_Float_Range
(Standard_Float
);
1779 Write_Str
(" for Float'Size use ");
1780 Write_Int
(Standard_Float_Size
);
1784 Write_Str
(" type Long_Float is digits ");
1785 Write_Int
(Standard_Long_Float_Digits
);
1787 P_Float_Range
(Standard_Long_Float
);
1788 Write_Str
(" for Long_Float'Size use ");
1789 Write_Int
(Standard_Long_Float_Size
);
1793 Write_Str
(" type Long_Long_Float is digits ");
1794 Write_Int
(Standard_Long_Long_Float_Digits
);
1796 P_Float_Range
(Standard_Long_Long_Float
);
1797 Write_Str
(" for Long_Long_Float'Size use ");
1798 Write_Int
(Standard_Long_Long_Float_Size
);
1802 P
(" type Character is (...)");
1803 Write_Str
(" for Character'Size use ");
1804 Write_Int
(Standard_Character_Size
);
1806 P
(" -- See RM A.1(35) for details of this type");
1809 P
(" type Wide_Character is (...)");
1810 Write_Str
(" for Wide_Character'Size use ");
1811 Write_Int
(Standard_Wide_Character_Size
);
1813 P
(" -- See RM A.1(36) for details of this type");
1816 P
(" type Wide_Wide_Character is (...)");
1817 Write_Str
(" for Wide_Wide_Character'Size use ");
1818 Write_Int
(Standard_Wide_Wide_Character_Size
);
1820 P
(" -- See RM A.1(36) for details of this type");
1822 P
(" type String is array (Positive range <>) of Character;");
1823 P
(" pragma Pack (String);");
1826 P
(" type Wide_String is array (Positive range <>)" &
1827 " of Wide_Character;");
1828 P
(" pragma Pack (Wide_String);");
1831 P
(" type Wide_Wide_String is array (Positive range <>)" &
1832 " of Wide_Wide_Character;");
1833 P
(" pragma Pack (Wide_Wide_String);");
1836 -- Here it's OK to use the Duration type of the host compiler since
1837 -- the implementation of Duration in GNAT is target independent.
1839 if Duration_32_Bits_On_Target
then
1840 P
(" type Duration is delta 0.020");
1841 P
(" range -((2 ** 31 - 1) * 0.020) ..");
1842 P
(" +((2 ** 31 - 1) * 0.020);");
1843 P
(" for Duration'Small use 0.020;");
1845 P
(" type Duration is delta 0.000000001");
1846 P
(" range -((2 ** 63 - 1) * 0.000000001) ..");
1847 P
(" +((2 ** 63 - 1) * 0.000000001);");
1848 P
(" for Duration'Small use 0.000000001;");
1853 P
(" Constraint_Error : exception;");
1854 P
(" Program_Error : exception;");
1855 P
(" Storage_Error : exception;");
1856 P
(" Tasking_Error : exception;");
1857 P
(" Numeric_Error : exception renames Constraint_Error;");
1860 P
("end Standard;");
1863 ----------------------
1864 -- Set_Float_Bounds --
1865 ----------------------
1867 procedure Set_Float_Bounds
(Id
: Entity_Id
) is
1869 -- Low bound of literal value
1872 -- High bound of literal value
1875 -- Range specification
1877 Radix
: constant Uint
:= Machine_Radix_Value
(Id
);
1878 Mantissa
: constant Uint
:= Machine_Mantissa_Value
(Id
);
1879 Emax
: constant Uint
:= Machine_Emax_Value
(Id
);
1880 Significand
: constant Uint
:= Radix
** Mantissa
- 1;
1881 Exponent
: constant Uint
:= Emax
- Mantissa
;
1884 -- Note: for the call from Cstand to initially create the types in
1885 -- Standard, Float_Rep will never be VAX_Native. Circuitry in Sem_Vfpt
1886 -- will adjust these types appropriately VAX_Native if a pragma
1887 -- Float_Representation (VAX_Float) is used.
1889 H
:= Make_Float_Literal
(Stloc
, Radix
, Significand
, Exponent
);
1890 L
:= Make_Float_Literal
(Stloc
, Radix
, -Significand
, Exponent
);
1893 Set_Is_Static_Expression
(L
);
1896 Set_Is_Static_Expression
(H
);
1898 R
:= New_Node
(N_Range
, Stloc
);
1899 Set_Low_Bound
(R
, L
);
1900 Set_High_Bound
(R
, H
);
1901 Set_Includes_Infinities
(R
, True);
1902 Set_Scalar_Range
(Id
, R
);
1905 end Set_Float_Bounds
;
1907 ------------------------
1908 -- Set_Integer_Bounds --
1909 ------------------------
1911 procedure Set_Integer_Bounds
1917 L
: Node_Id
; -- Low bound of literal value
1918 H
: Node_Id
; -- High bound of literal value
1919 R
: Node_Id
; -- Range specification
1922 L
:= Make_Integer
(Lb
);
1923 H
:= Make_Integer
(Hb
);
1928 R
:= New_Node
(N_Range
, Stloc
);
1929 Set_Low_Bound
(R
, L
);
1930 Set_High_Bound
(R
, H
);
1931 Set_Scalar_Range
(Id
, R
);
1934 Set_Is_Unsigned_Type
(Id
, Lb
>= 0);
1935 end Set_Integer_Bounds
;