1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Atree
; use Atree
;
28 with Casing
; use Casing
;
29 with Checks
; use Checks
;
30 with Einfo
; use Einfo
;
31 with Exp_Util
; use Exp_Util
;
32 with Namet
; use Namet
;
33 with Nmake
; use Nmake
;
34 with Nlists
; use Nlists
;
36 with Rtsfind
; use Rtsfind
;
37 with Sem_Res
; use Sem_Res
;
38 with Sinfo
; use Sinfo
;
39 with Snames
; use Snames
;
40 with Stand
; use Stand
;
41 with Stringt
; use Stringt
;
42 with Tbuild
; use Tbuild
;
43 with Ttypes
; use Ttypes
;
44 with Uintp
; use Uintp
;
46 package body Exp_Imgv
is
48 ------------------------------------
49 -- Build_Enumeration_Image_Tables --
50 ------------------------------------
52 procedure Build_Enumeration_Image_Tables
(E
: Entity_Id
; N
: Node_Id
) is
53 Loc
: constant Source_Ptr
:= Sloc
(E
);
64 -- Nothing to do for other than a root enumeration type
66 if E
/= Root_Type
(E
) then
69 -- Nothing to do if pragma Discard_Names applies
71 elsif Discard_Names
(E
) then
75 -- Otherwise tables need constructing
79 Lit
:= First_Literal
(E
);
85 Make_Integer_Literal
(Loc
, UI_From_Int
(Len
)));
90 Get_Unqualified_Decoded_Name_String
(Chars
(Lit
));
92 if Name_Buffer
(1) /= ''' then
93 Set_Casing
(All_Upper_Case
);
96 Store_String_Chars
(Name_Buffer
(1 .. Name_Len
));
97 Len
:= Len
+ Int
(Name_Len
);
101 if Len
< Int
(2 ** (8 - 1)) then
102 Ityp
:= Standard_Integer_8
;
103 elsif Len
< Int
(2 ** (16 - 1)) then
104 Ityp
:= Standard_Integer_16
;
106 Ityp
:= Standard_Integer_32
;
112 Make_Defining_Identifier
(Loc
,
113 Chars
=> New_External_Name
(Chars
(E
), 'S'));
116 Make_Defining_Identifier
(Loc
,
117 Chars
=> New_External_Name
(Chars
(E
), 'I'));
119 Set_Lit_Strings
(E
, Estr
);
120 Set_Lit_Indexes
(E
, Eind
);
124 Make_Object_Declaration
(Loc
,
125 Defining_Identifier
=> Estr
,
126 Constant_Present
=> True,
128 New_Occurrence_Of
(Standard_String
, Loc
),
130 Make_String_Literal
(Loc
,
133 Make_Object_Declaration
(Loc
,
134 Defining_Identifier
=> Eind
,
135 Constant_Present
=> True,
138 Make_Constrained_Array_Definition
(Loc
,
139 Discrete_Subtype_Definitions
=> New_List
(
141 Low_Bound
=> Make_Integer_Literal
(Loc
, 0),
142 High_Bound
=> Make_Integer_Literal
(Loc
, Nlit
))),
143 Subtype_Indication
=> New_Occurrence_Of
(Ityp
, Loc
)),
147 Expressions
=> Ind
))),
148 Suppress
=> All_Checks
);
150 end Build_Enumeration_Image_Tables
;
152 ----------------------------
153 -- Expand_Image_Attribute --
154 ----------------------------
156 -- For all non-enumeration types, and for enumeration types declared
157 -- in packages Standard or System, typ'Image (Val) expands into:
159 -- Image_xx (tp (Expr) [, pm])
161 -- The name xx and type conversion tp (Expr) (called tv below) depend on
162 -- the root type of Expr. The argument pm is an extra type dependent
163 -- parameter only used in some cases as follows:
165 -- For types whose root type is Character
167 -- tv = Character (Expr)
169 -- For types whose root type is Boolean
171 -- tv = Boolean (Expr)
173 -- For signed integer types with size <= Integer'Size
175 -- tv = Integer (Expr)
177 -- For other signed integer types
178 -- xx = Long_Long_Integer
179 -- tv = Long_Long_Integer (Expr)
181 -- For modular types with modulus <= System.Unsigned_Types.Unsigned
183 -- tv = System.Unsigned_Types.Unsigned (Expr)
185 -- For other modular integer types
186 -- xx = Long_Long_Unsigned
187 -- tv = System.Unsigned_Types.Long_Long_Unsigned (Expr)
189 -- For types whose root type is Wide_Character
190 -- xx = Wide_Character
191 -- tv = Wide_Character (Expr)
192 -- pm = Wide_Character_Encoding_Method
194 -- For floating-point types
195 -- xx = Floating_Point
196 -- tv = Long_Long_Float (Expr)
199 -- For ordinary fixed-point types
200 -- xx = Ordinary_Fixed_Point
201 -- tv = Long_Long_Float (Expr)
204 -- For decimal fixed-point types with size = Integer'Size
206 -- tv = Integer (Expr)
209 -- For decimal fixed-point types with size > Integer'Size
210 -- xx = Long_Long_Decimal
211 -- tv = Long_Long_Integer (Expr)
214 -- Note: for the decimal fixed-point type cases, the conversion is
215 -- done literally without scaling (i.e. the actual expression that
216 -- is generated is Image_xx (tp?(Expr) [, pm])
218 -- For enumeration types other than those declared packages Standard
219 -- or System, typ'Image (X) expands into:
221 -- Image_Enumeration_NN (typ'Pos (X), typS, typI'Address)
223 -- where typS and typI are the entities constructed as described in
224 -- the spec for the procedure Build_Enumeration_Image_Tables and NN
225 -- is 32/16/8 depending on the element type of Lit_Indexes.
227 procedure Expand_Image_Attribute
(N
: Node_Id
) is
228 Loc
: constant Source_Ptr
:= Sloc
(N
);
229 Exprs
: constant List_Id
:= Expressions
(N
);
230 Pref
: constant Node_Id
:= Prefix
(N
);
231 Ptyp
: constant Entity_Id
:= Entity
(Pref
);
232 Rtyp
: constant Entity_Id
:= Root_Type
(Ptyp
);
233 Expr
: constant Node_Id
:= Relocate_Node
(First
(Exprs
));
239 Func_Ent
: Entity_Id
;
242 if Rtyp
= Standard_Boolean
then
243 Imid
:= RE_Image_Boolean
;
246 elsif Rtyp
= Standard_Character
then
247 Imid
:= RE_Image_Character
;
250 elsif Rtyp
= Standard_Wide_Character
then
251 Imid
:= RE_Image_Wide_Character
;
254 elsif Is_Signed_Integer_Type
(Rtyp
) then
255 if Esize
(Rtyp
) <= Esize
(Standard_Integer
) then
256 Imid
:= RE_Image_Integer
;
257 Tent
:= Standard_Integer
;
259 Imid
:= RE_Image_Long_Long_Integer
;
260 Tent
:= Standard_Long_Long_Integer
;
263 elsif Is_Modular_Integer_Type
(Rtyp
) then
264 if Modulus
(Rtyp
) <= Modulus
(RTE
(RE_Unsigned
)) then
265 Imid
:= RE_Image_Unsigned
;
266 Tent
:= RTE
(RE_Unsigned
);
268 Imid
:= RE_Image_Long_Long_Unsigned
;
269 Tent
:= RTE
(RE_Long_Long_Unsigned
);
272 elsif Is_Decimal_Fixed_Point_Type
(Rtyp
) then
273 if UI_To_Int
(Esize
(Rtyp
)) <= Standard_Integer_Size
then
274 Imid
:= RE_Image_Decimal
;
275 Tent
:= Standard_Integer
;
277 Imid
:= RE_Image_Long_Long_Decimal
;
278 Tent
:= Standard_Long_Long_Integer
;
281 elsif Is_Ordinary_Fixed_Point_Type
(Rtyp
) then
282 Imid
:= RE_Image_Ordinary_Fixed_Point
;
283 Tent
:= Standard_Long_Long_Float
;
285 elsif Is_Floating_Point_Type
(Rtyp
) then
286 Imid
:= RE_Image_Floating_Point
;
287 Tent
:= Standard_Long_Long_Float
;
289 -- Only other possibility is user defined enumeration type
292 if Discard_Names
(First_Subtype
(Ptyp
))
293 or else No
(Lit_Strings
(Root_Type
(Ptyp
)))
295 -- When pragma Discard_Names applies to the first subtype,
296 -- then build (Pref'Pos)'Img.
299 Make_Attribute_Reference
(Loc
,
301 Make_Attribute_Reference
(Loc
,
303 Attribute_Name
=> Name_Pos
,
304 Expressions
=> New_List
(Expr
)),
307 Analyze_And_Resolve
(N
, Standard_String
);
310 -- Here we get the Image of an enumeration type
312 Ttyp
:= Component_Type
(Etype
(Lit_Indexes
(Rtyp
)));
314 if Ttyp
= Standard_Integer_8
then
315 Func
:= RE_Image_Enumeration_8
;
316 elsif Ttyp
= Standard_Integer_16
then
317 Func
:= RE_Image_Enumeration_16
;
319 Func
:= RE_Image_Enumeration_32
;
322 -- Apply a validity check, since it is a bit drastic to
323 -- get a completely junk image value for an invalid value.
325 if not Expr_Known_Valid
(Expr
) then
326 Insert_Valid_Check
(Expr
);
330 Make_Function_Call
(Loc
,
331 Name
=> New_Occurrence_Of
(RTE
(Func
), Loc
),
332 Parameter_Associations
=> New_List
(
333 Make_Attribute_Reference
(Loc
,
334 Attribute_Name
=> Name_Pos
,
335 Prefix
=> New_Occurrence_Of
(Ptyp
, Loc
),
336 Expressions
=> New_List
(Expr
)),
337 New_Occurrence_Of
(Lit_Strings
(Rtyp
), Loc
),
338 Make_Attribute_Reference
(Loc
,
339 Prefix
=> New_Occurrence_Of
(Lit_Indexes
(Rtyp
), Loc
),
340 Attribute_Name
=> Name_Address
))));
342 Analyze_And_Resolve
(N
, Standard_String
);
348 -- If we fall through, we have one of the cases that is handled by
349 -- calling one of the System.Img_xx routines and Imid is set to the
350 -- RE_Id for the function to be called.
352 Func_Ent
:= RTE
(Imid
);
354 -- If the function entity is empty, that means we have a case in
355 -- no run time mode where the operation is not allowed, and an
356 -- appropriate diagnostic has already been issued.
358 if No
(Func_Ent
) then
362 -- Otherwise prepare arguments for run-time call
364 Arglist
:= New_List
(Convert_To
(Tent
, Relocate_Node
(Expr
)));
366 -- For floating-point types, append Digits argument
368 if Is_Floating_Point_Type
(Rtyp
) then
370 Make_Attribute_Reference
(Loc
,
371 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
372 Attribute_Name
=> Name_Digits
));
374 -- For ordinary fixed-point types, append Aft parameter
376 elsif Is_Ordinary_Fixed_Point_Type
(Rtyp
) then
378 Make_Attribute_Reference
(Loc
,
379 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
380 Attribute_Name
=> Name_Aft
));
382 -- For wide character, append encoding method
384 elsif Rtyp
= Standard_Wide_Character
then
386 Make_Integer_Literal
(Loc
,
387 Intval
=> Int
(Wide_Character_Encoding_Method
)));
389 -- For decimal, append Scale and also set to do literal conversion
391 elsif Is_Decimal_Fixed_Point_Type
(Rtyp
) then
393 Make_Attribute_Reference
(Loc
,
394 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
395 Attribute_Name
=> Name_Scale
));
397 Set_Conversion_OK
(First
(Arglist
));
398 Set_Etype
(First
(Arglist
), Tent
);
402 Make_Function_Call
(Loc
,
403 Name
=> New_Reference_To
(Func_Ent
, Loc
),
404 Parameter_Associations
=> Arglist
));
406 Analyze_And_Resolve
(N
, Standard_String
);
407 end Expand_Image_Attribute
;
409 ----------------------------
410 -- Expand_Value_Attribute --
411 ----------------------------
413 -- For scalar types derived from Boolean, Character and integer types
414 -- in package Standard, typ'Value (X) expands into:
416 -- btyp (Value_xx (X))
418 -- where btyp is he base type of the prefix, and
420 -- For types whose root type is Character
423 -- For types whose root type is Boolean
426 -- For signed integer types with size <= Integer'Size
429 -- For other signed integer types
430 -- xx = Long_Long_Integer
432 -- For modular types with modulus <= System.Unsigned_Types.Unsigned
435 -- For other modular integer types
436 -- xx = Long_Long_Unsigned
438 -- For floating-point types and ordinary fixed-point types
441 -- For types derived from Wide_Character, typ'Value (X) expands into
443 -- Value_Wide_Character (X, Wide_Character_Encoding_Method)
445 -- For decimal types with size <= Integer'Size, typ'Value (X)
448 -- btyp?(Value_Decimal (X, typ'Scale));
450 -- For all other decimal types, typ'Value (X) expands into
452 -- btyp?(Value_Long_Long_Decimal (X, typ'Scale))
454 -- For enumeration types other than those derived from types Boolean,
455 -- Character, and Wide_Character in Standard, typ'Value (X) expands to:
457 -- Enum'Val (Value_Enumeration_NN (typS, typI'Address, Num, X))
459 -- where typS and typI and the Lit_Strings and Lit_Indexes entities
460 -- from T's root type entitym and Num is Enum'Pos (Enum'Last). The
461 -- Value_Enumeration_NN function will search the tables looking for
462 -- X and return the position number in the table if found which is
463 -- used to provide the result of 'Value (using Enum'Val). If the
464 -- value is not found Constraint_Error is raised. The suffix _NN
465 -- depends on the element type of typI.
467 procedure Expand_Value_Attribute
(N
: Node_Id
) is
468 Loc
: constant Source_Ptr
:= Sloc
(N
);
469 Typ
: constant Entity_Id
:= Etype
(N
);
470 Btyp
: constant Entity_Id
:= Base_Type
(Typ
);
471 Rtyp
: constant Entity_Id
:= Root_Type
(Typ
);
472 Exprs
: constant List_Id
:= Expressions
(N
);
481 if Rtyp
= Standard_Character
then
482 Vid
:= RE_Value_Character
;
484 elsif Rtyp
= Standard_Boolean
then
485 Vid
:= RE_Value_Boolean
;
487 elsif Rtyp
= Standard_Wide_Character
then
488 Vid
:= RE_Value_Wide_Character
;
490 Make_Integer_Literal
(Loc
,
491 Intval
=> Int
(Wide_Character_Encoding_Method
)));
493 elsif Rtyp
= Base_Type
(Standard_Short_Short_Integer
)
494 or else Rtyp
= Base_Type
(Standard_Short_Integer
)
495 or else Rtyp
= Base_Type
(Standard_Integer
)
497 Vid
:= RE_Value_Integer
;
499 elsif Is_Signed_Integer_Type
(Rtyp
) then
500 Vid
:= RE_Value_Long_Long_Integer
;
502 elsif Is_Modular_Integer_Type
(Rtyp
) then
503 if Modulus
(Rtyp
) <= Modulus
(RTE
(RE_Unsigned
)) then
504 Vid
:= RE_Value_Unsigned
;
506 Vid
:= RE_Value_Long_Long_Unsigned
;
509 elsif Is_Decimal_Fixed_Point_Type
(Rtyp
) then
510 if UI_To_Int
(Esize
(Rtyp
)) <= Standard_Integer_Size
then
511 Vid
:= RE_Value_Decimal
;
513 Vid
:= RE_Value_Long_Long_Decimal
;
517 Make_Attribute_Reference
(Loc
,
518 Prefix
=> New_Reference_To
(Typ
, Loc
),
519 Attribute_Name
=> Name_Scale
));
523 Make_Function_Call
(Loc
,
524 Name
=> New_Reference_To
(RTE
(Vid
), Loc
),
525 Parameter_Associations
=> Args
)));
528 Analyze_And_Resolve
(N
, Btyp
);
531 elsif Is_Real_Type
(Rtyp
) then
532 Vid
:= RE_Value_Real
;
534 -- Only other possibility is user defined enumeration type
537 pragma Assert
(Is_Enumeration_Type
(Rtyp
));
539 -- Case of pragma Discard_Names, transform the Value
540 -- attribute to Btyp'Val (Long_Long_Integer'Value (Args))
542 if Discard_Names
(First_Subtype
(Typ
))
543 or else No
(Lit_Strings
(Rtyp
))
546 Make_Attribute_Reference
(Loc
,
547 Prefix
=> New_Reference_To
(Btyp
, Loc
),
548 Attribute_Name
=> Name_Val
,
549 Expressions
=> New_List
(
550 Make_Attribute_Reference
(Loc
,
552 New_Occurrence_Of
(Standard_Long_Long_Integer
, Loc
),
553 Attribute_Name
=> Name_Value
,
554 Expressions
=> Args
))));
556 Analyze_And_Resolve
(N
, Btyp
);
558 -- Here for normal case where we have enumeration tables, this
561 -- T'Val (Value_Enumeration_NN (typS, typI'Address, Num, X))
564 Ttyp
:= Component_Type
(Etype
(Lit_Indexes
(Rtyp
)));
566 if Ttyp
= Standard_Integer_8
then
567 Func
:= RE_Value_Enumeration_8
;
568 elsif Ttyp
= Standard_Integer_16
then
569 Func
:= RE_Value_Enumeration_16
;
571 Func
:= RE_Value_Enumeration_32
;
575 Make_Attribute_Reference
(Loc
,
576 Prefix
=> New_Occurrence_Of
(Rtyp
, Loc
),
577 Attribute_Name
=> Name_Pos
,
578 Expressions
=> New_List
(
579 Make_Attribute_Reference
(Loc
,
580 Prefix
=> New_Occurrence_Of
(Rtyp
, Loc
),
581 Attribute_Name
=> Name_Last
))));
584 Make_Attribute_Reference
(Loc
,
585 Prefix
=> New_Occurrence_Of
(Lit_Indexes
(Rtyp
), Loc
),
586 Attribute_Name
=> Name_Address
));
589 New_Occurrence_Of
(Lit_Strings
(Rtyp
), Loc
));
592 Make_Attribute_Reference
(Loc
,
593 Prefix
=> New_Reference_To
(Typ
, Loc
),
594 Attribute_Name
=> Name_Val
,
595 Expressions
=> New_List
(
596 Make_Function_Call
(Loc
,
598 New_Reference_To
(RTE
(Func
), Loc
),
599 Parameter_Associations
=> Args
))));
601 Analyze_And_Resolve
(N
, Btyp
);
607 -- Fall through for all cases except user defined enumeration type
608 -- and decimal types, with Vid set to the Id of the entity for the
609 -- Value routine and Args set to the list of parameters for the call.
613 Make_Function_Call
(Loc
,
614 Name
=> New_Reference_To
(RTE
(Vid
), Loc
),
615 Parameter_Associations
=> Args
)));
617 Analyze_And_Resolve
(N
, Btyp
);
618 end Expand_Value_Attribute
;
620 ----------------------------
621 -- Expand_Width_Attribute --
622 ----------------------------
624 -- The processing here also handles the case of Wide_Width. With the
625 -- exceptions noted, the processing is identical
627 -- For scalar types derived from Boolean, character and integer types
628 -- in package Standard. Note that the Width attribute is computed at
629 -- compile time for all cases except those involving non-static sub-
630 -- types. For such subtypes, typ'Width and typ'Wide_Width expands into:
632 -- Result_Type (xx (yy (Ptyp'First), yy (Ptyp'Last)))
636 -- For types whose root type is Character
637 -- xx = Width_Character (Wide_Width_Character for Wide_Width case)
640 -- For types whose root type is Boolean
641 -- xx = Width_Boolean
644 -- For signed integer types
645 -- xx = Width_Long_Long_Integer
646 -- yy = Long_Long_Integer
648 -- For modular integer types
649 -- xx = Width_Long_Long_Unsigned
650 -- yy = Long_Long_Unsigned
652 -- For types derived from Wide_Character, typ'Width expands into
654 -- Result_Type (Width_Wide_Character (
655 -- Wide_Character (typ'First),
656 -- Wide_Character (typ'Last),
657 -- Wide_Character_Encoding_Method);
659 -- and typ'Wide_Width expands into:
661 -- Result_Type (Wide_Width_Wide_Character (
662 -- Wide_Character (typ'First),
663 -- Wide_Character (typ'Last));
665 -- For real types, typ'Width and typ'Wide_Width expand into
667 -- if Ptyp'First > Ptyp'Last then 0 else btyp'Width end if
669 -- where btyp is the base type. This looks recursive but it isn't
670 -- because the base type is always static, and hence the expression
671 -- in the else is reduced to an integer literal.
673 -- For user defined enumeration types, typ'Width expands into
675 -- Result_Type (Width_Enumeration_NN
678 -- typ'Pos (typ'First),
679 -- typ'Pos (Typ'Last)));
681 -- and typ'Wide_Width expands into:
683 -- Result_Type (Wide_Width_Enumeration_NN
686 -- typ'Pos (typ'First),
687 -- typ'Pos (Typ'Last))
688 -- Wide_Character_Encoding_Method);
690 -- where typS and typI are the enumeration image strings and
691 -- indexes table, as described in Build_Enumeration_Image_Tables.
692 -- NN is 8/16/32 for depending on the element type for typI.
694 procedure Expand_Width_Attribute
(N
: Node_Id
; Wide
: Boolean) is
695 Loc
: constant Source_Ptr
:= Sloc
(N
);
696 Typ
: constant Entity_Id
:= Etype
(N
);
697 Pref
: constant Node_Id
:= Prefix
(N
);
698 Ptyp
: constant Entity_Id
:= Etype
(Pref
);
699 Rtyp
: constant Entity_Id
:= Root_Type
(Ptyp
);
706 -- Types derived from Standard.Boolean
708 if Rtyp
= Standard_Boolean
then
709 XX
:= RE_Width_Boolean
;
712 -- Types derived from Standard.Character
714 elsif Rtyp
= Standard_Character
then
716 XX
:= RE_Width_Character
;
718 XX
:= RE_Wide_Width_Character
;
723 -- Types derived from Standard.Wide_Character
725 elsif Rtyp
= Standard_Wide_Character
then
727 XX
:= RE_Width_Wide_Character
;
729 XX
:= RE_Wide_Width_Wide_Character
;
734 -- Signed integer types
736 elsif Is_Signed_Integer_Type
(Rtyp
) then
737 XX
:= RE_Width_Long_Long_Integer
;
738 YY
:= Standard_Long_Long_Integer
;
740 -- Modular integer types
742 elsif Is_Modular_Integer_Type
(Rtyp
) then
743 XX
:= RE_Width_Long_Long_Unsigned
;
744 YY
:= RTE
(RE_Long_Long_Unsigned
);
748 elsif Is_Real_Type
(Rtyp
) then
751 Make_Conditional_Expression
(Loc
,
752 Expressions
=> New_List
(
756 Make_Attribute_Reference
(Loc
,
757 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
758 Attribute_Name
=> Name_First
),
761 Make_Attribute_Reference
(Loc
,
762 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
763 Attribute_Name
=> Name_Last
)),
765 Make_Integer_Literal
(Loc
, 0),
767 Make_Attribute_Reference
(Loc
,
768 Prefix
=> New_Reference_To
(Base_Type
(Ptyp
), Loc
),
769 Attribute_Name
=> Name_Width
))));
771 Analyze_And_Resolve
(N
, Typ
);
774 -- User defined enumeration types
777 pragma Assert
(Is_Enumeration_Type
(Rtyp
));
779 Ttyp
:= Component_Type
(Etype
(Lit_Indexes
(Rtyp
)));
782 if Ttyp
= Standard_Integer_8
then
783 XX
:= RE_Width_Enumeration_8
;
784 elsif Ttyp
= Standard_Integer_16
then
785 XX
:= RE_Width_Enumeration_16
;
787 XX
:= RE_Width_Enumeration_32
;
791 if Ttyp
= Standard_Integer_8
then
792 XX
:= RE_Wide_Width_Enumeration_8
;
793 elsif Ttyp
= Standard_Integer_16
then
794 XX
:= RE_Wide_Width_Enumeration_16
;
796 XX
:= RE_Wide_Width_Enumeration_32
;
802 New_Occurrence_Of
(Lit_Strings
(Rtyp
), Loc
),
804 Make_Attribute_Reference
(Loc
,
805 Prefix
=> New_Occurrence_Of
(Lit_Indexes
(Rtyp
), Loc
),
806 Attribute_Name
=> Name_Address
),
808 Make_Attribute_Reference
(Loc
,
809 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
810 Attribute_Name
=> Name_Pos
,
812 Expressions
=> New_List
(
813 Make_Attribute_Reference
(Loc
,
814 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
815 Attribute_Name
=> Name_First
))),
817 Make_Attribute_Reference
(Loc
,
818 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
819 Attribute_Name
=> Name_Pos
,
821 Expressions
=> New_List
(
822 Make_Attribute_Reference
(Loc
,
823 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
824 Attribute_Name
=> Name_Last
))));
826 -- For enumeration'Wide_Width, add encoding method parameter
830 Make_Integer_Literal
(Loc
,
831 Intval
=> Int
(Wide_Character_Encoding_Method
)));
836 Make_Function_Call
(Loc
,
837 Name
=> New_Reference_To
(RTE
(XX
), Loc
),
838 Parameter_Associations
=> Arglist
)));
840 Analyze_And_Resolve
(N
, Typ
);
844 -- If we fall through XX and YY are set
846 Arglist
:= New_List
(
848 Make_Attribute_Reference
(Loc
,
849 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
850 Attribute_Name
=> Name_First
)),
853 Make_Attribute_Reference
(Loc
,
854 Prefix
=> New_Reference_To
(Ptyp
, Loc
),
855 Attribute_Name
=> Name_Last
)));
857 -- For Wide_Character'Width, add encoding method parameter
859 if Rtyp
= Standard_Wide_Character
and then Wide
then
861 Make_Integer_Literal
(Loc
,
862 Intval
=> Int
(Wide_Character_Encoding_Method
)));
867 Make_Function_Call
(Loc
,
868 Name
=> New_Reference_To
(RTE
(XX
), Loc
),
869 Parameter_Associations
=> Arglist
)));
871 Analyze_And_Resolve
(N
, Typ
);
872 end Expand_Width_Attribute
;