1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2005 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), 'N'));
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 Component_Definition =>
144 Make_Component_Definition (Loc,
145 Aliased_Present => False,
146 Subtype_Indication => New_Occurrence_Of (Ityp, Loc))),
150 Expressions => Ind))),
151 Suppress => All_Checks);
153 end Build_Enumeration_Image_Tables;
155 ----------------------------
156 -- Expand_Image_Attribute --
157 ----------------------------
159 -- For all non-enumeration types, and for enumeration types declared
160 -- in packages Standard or System, typ'Image (Val) expands into:
162 -- Image_xx (tp (Expr) [, pm])
164 -- The name xx and type conversion tp (Expr) (called tv below) depend on
165 -- the root type of Expr. The argument pm is an extra type dependent
166 -- parameter only used in some cases as follows:
168 -- For types whose root type is Character
170 -- tv = Character (Expr)
172 -- For types whose root type is Boolean
174 -- tv = Boolean (Expr)
176 -- For signed integer types with size <= Integer'Size
178 -- tv = Integer (Expr)
180 -- For other signed integer types
181 -- xx = Long_Long_Integer
182 -- tv = Long_Long_Integer (Expr)
184 -- For modular types with modulus <= System.Unsigned_Types.Unsigned
186 -- tv = System.Unsigned_Types.Unsigned (Expr)
188 -- For other modular integer types
189 -- xx = Long_Long_Unsigned
190 -- tv = System.Unsigned_Types.Long_Long_Unsigned (Expr)
192 -- For types whose root type is Wide_Character
193 -- xx = Wide_Character
194 -- tv = Wide_Character (Expr)
195 -- pm = Wide_Character_Encoding_Method
197 -- For types whose root type is Wide_Wide_Character
198 -- xx = Wide_Wide_haracter
199 -- tv = Wide_Wide_Character (Expr)
200 -- pm = Wide_Character_Encoding_Method
202 -- For floating-point types
203 -- xx = Floating_Point
204 -- tv = Long_Long_Float (Expr)
207 -- For ordinary fixed-point types
208 -- xx = Ordinary_Fixed_Point
209 -- tv = Long_Long_Float (Expr)
212 -- For decimal fixed-point types with size = Integer'Size
214 -- tv = Integer (Expr)
217 -- For decimal fixed-point types with size > Integer'Size
218 -- xx = Long_Long_Decimal
219 -- tv = Long_Long_Integer (Expr)
222 -- Note: for the decimal fixed-point type cases, the conversion is
223 -- done literally without scaling (i.e. the actual expression that
224 -- is generated is Image_xx (tp?(Expr) [, pm])
226 -- For enumeration types other than those declared packages Standard
227 -- or System, typ'Image (X) expands into:
229 -- Image_Enumeration_NN (typ'Pos (X), typS, typI'Address)
231 -- where typS and typI are the entities constructed as described in
232 -- the spec for the procedure Build_Enumeration_Image_Tables and NN
233 -- is 32/16/8 depending on the element type of Lit_Indexes.
235 procedure Expand_Image_Attribute (N : Node_Id) is
236 Loc : constant Source_Ptr := Sloc (N);
237 Exprs : constant List_Id := Expressions (N);
238 Pref : constant Node_Id := Prefix (N);
239 Ptyp : constant Entity_Id := Entity (Pref);
240 Rtyp : constant Entity_Id := Root_Type (Ptyp);
241 Expr : constant Node_Id := Relocate_Node (First (Exprs));
247 Func_Ent : Entity_Id;
250 if Rtyp = Standard_Boolean then
251 Imid := RE_Image_Boolean;
254 elsif Rtyp = Standard_Character then
255 Imid := RE_Image_Character;
258 elsif Rtyp = Standard_Wide_Character then
259 Imid := RE_Image_Wide_Character;
262 elsif Rtyp = Standard_Wide_Wide_Character then
263 Imid := RE_Image_Wide_Wide_Character;
266 elsif Is_Signed_Integer_Type (Rtyp) then
267 if Esize (Rtyp) <= Esize (Standard_Integer) then
268 Imid := RE_Image_Integer;
269 Tent := Standard_Integer;
271 Imid := RE_Image_Long_Long_Integer;
272 Tent := Standard_Long_Long_Integer;
275 elsif Is_Modular_Integer_Type (Rtyp) then
276 if Modulus (Rtyp) <= Modulus (RTE (RE_Unsigned)) then
277 Imid := RE_Image_Unsigned;
278 Tent := RTE (RE_Unsigned);
280 Imid := RE_Image_Long_Long_Unsigned;
281 Tent := RTE (RE_Long_Long_Unsigned);
284 elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
285 if UI_To_Int (Esize (Rtyp)) <= Standard_Integer_Size then
286 Imid := RE_Image_Decimal;
287 Tent := Standard_Integer;
289 Imid := RE_Image_Long_Long_Decimal;
290 Tent := Standard_Long_Long_Integer;
293 elsif Is_Ordinary_Fixed_Point_Type (Rtyp) then
294 Imid := RE_Image_Ordinary_Fixed_Point;
295 Tent := Standard_Long_Long_Float;
297 elsif Is_Floating_Point_Type (Rtyp) then
298 Imid := RE_Image_Floating_Point;
299 Tent := Standard_Long_Long_Float;
301 -- Only other possibility is user defined enumeration type
304 if Discard_Names (First_Subtype (Ptyp))
305 or else No (Lit_Strings (Root_Type (Ptyp)))
307 -- When pragma Discard_Names applies to the first subtype,
308 -- then build (Pref'Pos)'Img.
311 Make_Attribute_Reference (Loc,
313 Make_Attribute_Reference (Loc,
315 Attribute_Name => Name_Pos,
316 Expressions => New_List (Expr)),
319 Analyze_And_Resolve (N, Standard_String);
322 -- Here we get the Image of an enumeration type
324 Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
326 if Ttyp = Standard_Integer_8 then
327 Func := RE_Image_Enumeration_8;
328 elsif Ttyp = Standard_Integer_16 then
329 Func := RE_Image_Enumeration_16;
331 Func := RE_Image_Enumeration_32;
334 -- Apply a validity check, since it is a bit drastic to
335 -- get a completely junk image value for an invalid value.
337 if not Expr_Known_Valid (Expr) then
338 Insert_Valid_Check (Expr);
342 Make_Function_Call (Loc,
343 Name => New_Occurrence_Of (RTE (Func), Loc),
344 Parameter_Associations => New_List (
345 Make_Attribute_Reference (Loc,
346 Attribute_Name => Name_Pos,
347 Prefix => New_Occurrence_Of (Ptyp, Loc),
348 Expressions => New_List (Expr)),
349 New_Occurrence_Of (Lit_Strings (Rtyp), Loc),
350 Make_Attribute_Reference (Loc,
351 Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
352 Attribute_Name => Name_Address))));
354 Analyze_And_Resolve (N, Standard_String);
360 -- If we fall through, we have one of the cases that is handled by
361 -- calling one of the System.Img_xx routines and Imid is set to the
362 -- RE_Id for the function to be called.
364 Func_Ent := RTE (Imid);
366 -- If the function entity is empty, that means we have a case in
367 -- no run time mode where the operation is not allowed, and an
368 -- appropriate diagnostic has already been issued.
370 if No (Func_Ent) then
374 -- Otherwise prepare arguments for run-time call
376 Arglist := New_List (Convert_To (Tent, Relocate_Node (Expr)));
378 -- For floating-point types, append Digits argument
380 if Is_Floating_Point_Type (Rtyp) then
382 Make_Attribute_Reference (Loc,
383 Prefix => New_Reference_To (Ptyp, Loc),
384 Attribute_Name => Name_Digits));
386 -- For ordinary fixed-point types, append Aft parameter
388 elsif Is_Ordinary_Fixed_Point_Type (Rtyp) then
390 Make_Attribute_Reference (Loc,
391 Prefix => New_Reference_To (Ptyp, Loc),
392 Attribute_Name => Name_Aft));
394 -- For wide [wide] character, append encoding method
396 elsif Rtyp = Standard_Wide_Character
397 or else Rtyp = Standard_Wide_Wide_Character
400 Make_Integer_Literal (Loc,
401 Intval => Int (Wide_Character_Encoding_Method)));
403 -- For decimal, append Scale and also set to do literal conversion
405 elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
407 Make_Attribute_Reference (Loc,
408 Prefix => New_Reference_To (Ptyp, Loc),
409 Attribute_Name => Name_Scale));
411 Set_Conversion_OK (First (Arglist));
412 Set_Etype (First (Arglist), Tent);
416 Make_Function_Call (Loc,
417 Name => New_Reference_To (Func_Ent, Loc),
418 Parameter_Associations => Arglist));
420 Analyze_And_Resolve (N, Standard_String);
421 end Expand_Image_Attribute;
423 ----------------------------
424 -- Expand_Value_Attribute --
425 ----------------------------
427 -- For scalar types derived from Boolean, Character and integer types
428 -- in package Standard, typ'Value (X) expands into:
430 -- btyp (Value_xx (X))
432 -- where btyp is he base type of the prefix, and
434 -- For types whose root type is Character
437 -- For types whose root type is Boolean
440 -- For signed integer types with size <= Integer'Size
443 -- For other signed integer types
444 -- xx = Long_Long_Integer
446 -- For modular types with modulus <= System.Unsigned_Types.Unsigned
449 -- For other modular integer types
450 -- xx = Long_Long_Unsigned
452 -- For floating-point types and ordinary fixed-point types
455 -- For types derived from Wide_Character, typ'Value (X) expands into
457 -- Value_Wide_Character (X, Wide_Character_Encoding_Method)
459 -- For types derived from Wide_Wide_Character, typ'Value (X) expands into
461 -- Value_Wide_Wide_Character (X, Wide_Character_Encoding_Method)
463 -- For decimal types with size <= Integer'Size, typ'Value (X)
466 -- btyp?(Value_Decimal (X, typ'Scale));
468 -- For all other decimal types, typ'Value (X) expands into
470 -- btyp?(Value_Long_Long_Decimal (X, typ'Scale))
472 -- For enumeration types other than those derived from types Boolean,
473 -- Character, Wide_[Wide_]Character in Standard, typ'Value (X) expands to:
475 -- Enum'Val (Value_Enumeration_NN (typS, typI'Address, Num, X))
477 -- where typS and typI and the Lit_Strings and Lit_Indexes entities
478 -- from T's root type entitym and Num is Enum'Pos (Enum'Last). The
479 -- Value_Enumeration_NN function will search the tables looking for
480 -- X and return the position number in the table if found which is
481 -- used to provide the result of 'Value (using Enum'Val). If the
482 -- value is not found Constraint_Error is raised. The suffix _NN
483 -- depends on the element type of typI.
485 procedure Expand_Value_Attribute (N : Node_Id) is
486 Loc : constant Source_Ptr := Sloc (N);
487 Typ : constant Entity_Id := Etype (N);
488 Btyp : constant Entity_Id := Base_Type (Typ);
489 Rtyp : constant Entity_Id := Root_Type (Typ);
490 Exprs : constant List_Id := Expressions (N);
499 if Rtyp = Standard_Character then
500 Vid := RE_Value_Character;
502 elsif Rtyp = Standard_Boolean then
503 Vid := RE_Value_Boolean;
505 elsif Rtyp = Standard_Wide_Character then
506 Vid := RE_Value_Wide_Character;
508 Make_Integer_Literal (Loc,
509 Intval => Int (Wide_Character_Encoding_Method)));
511 elsif Rtyp = Standard_Wide_Wide_Character then
512 Vid := RE_Value_Wide_Wide_Character;
514 Make_Integer_Literal (Loc,
515 Intval => Int (Wide_Character_Encoding_Method)));
517 elsif Rtyp = Base_Type (Standard_Short_Short_Integer)
518 or else Rtyp = Base_Type (Standard_Short_Integer)
519 or else Rtyp = Base_Type (Standard_Integer)
521 Vid := RE_Value_Integer;
523 elsif Is_Signed_Integer_Type (Rtyp) then
524 Vid := RE_Value_Long_Long_Integer;
526 elsif Is_Modular_Integer_Type (Rtyp) then
527 if Modulus (Rtyp) <= Modulus (RTE (RE_Unsigned)) then
528 Vid := RE_Value_Unsigned;
530 Vid := RE_Value_Long_Long_Unsigned;
533 elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
534 if UI_To_Int (Esize (Rtyp)) <= Standard_Integer_Size then
535 Vid := RE_Value_Decimal;
537 Vid := RE_Value_Long_Long_Decimal;
541 Make_Attribute_Reference (Loc,
542 Prefix => New_Reference_To (Typ, Loc),
543 Attribute_Name => Name_Scale));
547 Make_Function_Call (Loc,
548 Name => New_Reference_To (RTE (Vid), Loc),
549 Parameter_Associations => Args)));
552 Analyze_And_Resolve (N, Btyp);
555 elsif Is_Real_Type (Rtyp) then
556 Vid := RE_Value_Real;
558 -- Only other possibility is user defined enumeration type
561 pragma Assert (Is_Enumeration_Type (Rtyp));
563 -- Case of pragma Discard_Names, transform the Value
564 -- attribute to Btyp'Val (Long_Long_Integer'Value (Args))
566 if Discard_Names (First_Subtype (Typ))
567 or else No (Lit_Strings (Rtyp))
570 Make_Attribute_Reference (Loc,
571 Prefix => New_Reference_To (Btyp, Loc),
572 Attribute_Name => Name_Val,
573 Expressions => New_List (
574 Make_Attribute_Reference (Loc,
576 New_Occurrence_Of (Standard_Long_Long_Integer, Loc),
577 Attribute_Name => Name_Value,
578 Expressions => Args))));
580 Analyze_And_Resolve (N, Btyp);
582 -- Here for normal case where we have enumeration tables, this
585 -- T'Val (Value_Enumeration_NN (typS, typI'Address, Num, X))
588 Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
590 if Ttyp = Standard_Integer_8 then
591 Func := RE_Value_Enumeration_8;
592 elsif Ttyp = Standard_Integer_16 then
593 Func := RE_Value_Enumeration_16;
595 Func := RE_Value_Enumeration_32;
599 Make_Attribute_Reference (Loc,
600 Prefix => New_Occurrence_Of (Rtyp, Loc),
601 Attribute_Name => Name_Pos,
602 Expressions => New_List (
603 Make_Attribute_Reference (Loc,
604 Prefix => New_Occurrence_Of (Rtyp, Loc),
605 Attribute_Name => Name_Last))));
608 Make_Attribute_Reference (Loc,
609 Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
610 Attribute_Name => Name_Address));
613 New_Occurrence_Of (Lit_Strings (Rtyp), Loc));
616 Make_Attribute_Reference (Loc,
617 Prefix => New_Reference_To (Typ, Loc),
618 Attribute_Name => Name_Val,
619 Expressions => New_List (
620 Make_Function_Call (Loc,
622 New_Reference_To (RTE (Func), Loc),
623 Parameter_Associations => Args))));
625 Analyze_And_Resolve (N, Btyp);
631 -- Fall through for all cases except user defined enumeration type
632 -- and decimal types, with Vid set to the Id of the entity for the
633 -- Value routine and Args set to the list of parameters for the call.
637 Make_Function_Call (Loc,
638 Name => New_Reference_To (RTE (Vid), Loc),
639 Parameter_Associations => Args)));
641 Analyze_And_Resolve (N, Btyp);
642 end Expand_Value_Attribute;
644 ----------------------------
645 -- Expand_Width_Attribute --
646 ----------------------------
648 -- The processing here also handles the case of Wide_[Wide_]Width. With the
649 -- exceptions noted, the processing is identical
651 -- For scalar types derived from Boolean, character and integer types
652 -- in package Standard. Note that the Width attribute is computed at
653 -- compile time for all cases except those involving non-static sub-
654 -- types. For such subtypes, typ'[Wide_[Wide_]]Width expands into:
656 -- Result_Type (xx (yy (Ptyp'First), yy (Ptyp'Last)))
660 -- For types whose root type is Character
661 -- xx = Width_Character
664 -- For types whose root type is Wide_Character
665 -- xx = Wide_Width_Character
668 -- For types whose root type is Wide_Wide_Character
669 -- xx = Wide_Wide_Width_Character
672 -- For types whose root type is Boolean
673 -- xx = Width_Boolean
676 -- For signed integer types
677 -- xx = Width_Long_Long_Integer
678 -- yy = Long_Long_Integer
680 -- For modular integer types
681 -- xx = Width_Long_Long_Unsigned
682 -- yy = Long_Long_Unsigned
684 -- For types derived from Wide_Character, typ'Width expands into
686 -- Result_Type (Width_Wide_Character (
687 -- Wide_Character (typ'First),
688 -- Wide_Character (typ'Last),
689 -- Wide_Character_Encoding_Method);
691 -- and typ'Wide_Width expands into:
693 -- Result_Type (Wide_Width_Wide_Character (
694 -- Wide_Character (typ'First),
695 -- Wide_Character (typ'Last));
696 -- Wide_Character_Encoding_Method);
698 -- and typ'Wide_Wide_Width expands into
700 -- Result_Type (Wide_Wide_Width_Wide_Character (
701 -- Wide_Character (typ'First),
702 -- Wide_Character (typ'Last));
703 -- Wide_Character_Encoding_Method);
705 -- For types derived from Wide_Wide_Character, typ'Width expands into
707 -- Result_Type (Width_Wide_Wide_Character (
708 -- Wide_Wide_Character (typ'First),
709 -- Wide_Wide_Character (typ'Last),
710 -- Wide_Character_Encoding_Method);
712 -- and typ'Wide_Width expands into:
714 -- Result_Type (Wide_Width_Wide_Wide_Character (
715 -- Wide_Wide_Character (typ'First),
716 -- Wide_Wide_Character (typ'Last));
717 -- Wide_Character_Encoding_Method);
719 -- and typ'Wide_Wide_Width expands into
721 -- Result_Type (Wide_Wide_Width_Wide_Wide_Char (
722 -- Wide_Wide_Character (typ'First),
723 -- Wide_Wide_Character (typ'Last));
724 -- Wide_Character_Encoding_Method);
726 -- For real types, typ'Width and typ'Wide_[Wide_]Width expand into
728 -- if Ptyp'First > Ptyp'Last then 0 else btyp'Width end if
730 -- where btyp is the base type. This looks recursive but it isn't
731 -- because the base type is always static, and hence the expression
732 -- in the else is reduced to an integer literal.
734 -- For user defined enumeration types, typ'Width expands into
736 -- Result_Type (Width_Enumeration_NN
739 -- typ'Pos (typ'First),
740 -- typ'Pos (Typ'Last)));
742 -- and typ'Wide_Width expands into:
744 -- Result_Type (Wide_Width_Enumeration_NN
747 -- typ'Pos (typ'First),
748 -- typ'Pos (Typ'Last))
749 -- Wide_Character_Encoding_Method);
751 -- and typ'Wide_Wide_Width expands into:
753 -- Result_Type (Wide_Wide_Width_Enumeration_NN
756 -- typ'Pos (typ'First),
757 -- typ'Pos (Typ'Last))
758 -- Wide_Character_Encoding_Method);
760 -- where typS and typI are the enumeration image strings and
761 -- indexes table, as described in Build_Enumeration_Image_Tables.
762 -- NN is 8/16/32 for depending on the element type for typI.
764 procedure Expand_Width_Attribute (N : Node_Id; Attr : Atype := Normal) is
765 Loc : constant Source_Ptr := Sloc (N);
766 Typ : constant Entity_Id := Etype (N);
767 Pref : constant Node_Id := Prefix (N);
768 Ptyp : constant Entity_Id := Etype (Pref);
769 Rtyp : constant Entity_Id := Root_Type (Ptyp);
776 -- Types derived from Standard.Boolean
778 if Rtyp = Standard_Boolean then
779 XX := RE_Width_Boolean;
782 -- Types derived from Standard.Character
784 elsif Rtyp = Standard_Character then
786 when Normal => XX := RE_Width_Character;
787 when Wide => XX := RE_Wide_Width_Character;
788 when Wide_Wide => XX := RE_Wide_Wide_Width_Character;
793 -- Types derived from Standard.Wide_Character
795 elsif Rtyp = Standard_Wide_Character then
797 when Normal => XX := RE_Width_Wide_Character;
798 when Wide => XX := RE_Wide_Width_Wide_Character;
799 when Wide_Wide => XX := RE_Wide_Wide_Width_Wide_Character;
804 -- Types derived from Standard.Wide_Wide_Character
806 elsif Rtyp = Standard_Wide_Wide_Character then
808 when Normal => XX := RE_Width_Wide_Wide_Character;
809 when Wide => XX := RE_Wide_Width_Wide_Wide_Character;
810 when Wide_Wide => XX := RE_Wide_Wide_Width_Wide_Wide_Char;
815 -- Signed integer types
817 elsif Is_Signed_Integer_Type (Rtyp) then
818 XX := RE_Width_Long_Long_Integer;
819 YY := Standard_Long_Long_Integer;
821 -- Modular integer types
823 elsif Is_Modular_Integer_Type (Rtyp) then
824 XX := RE_Width_Long_Long_Unsigned;
825 YY := RTE (RE_Long_Long_Unsigned);
829 elsif Is_Real_Type (Rtyp) then
832 Make_Conditional_Expression (Loc,
833 Expressions => New_List (
837 Make_Attribute_Reference (Loc,
838 Prefix => New_Reference_To (Ptyp, Loc),
839 Attribute_Name => Name_First),
842 Make_Attribute_Reference (Loc,
843 Prefix => New_Reference_To (Ptyp, Loc),
844 Attribute_Name => Name_Last)),
846 Make_Integer_Literal (Loc, 0),
848 Make_Attribute_Reference (Loc,
849 Prefix => New_Reference_To (Base_Type (Ptyp), Loc),
850 Attribute_Name => Name_Width))));
852 Analyze_And_Resolve (N, Typ);
855 -- User defined enumeration types
858 pragma Assert (Is_Enumeration_Type (Rtyp));
860 Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
864 if Ttyp = Standard_Integer_8 then
865 XX := RE_Width_Enumeration_8;
866 elsif Ttyp = Standard_Integer_16 then
867 XX := RE_Width_Enumeration_16;
869 XX := RE_Width_Enumeration_32;
873 if Ttyp = Standard_Integer_8 then
874 XX := RE_Wide_Width_Enumeration_8;
875 elsif Ttyp = Standard_Integer_16 then
876 XX := RE_Wide_Width_Enumeration_16;
878 XX := RE_Wide_Width_Enumeration_32;
882 if Ttyp = Standard_Integer_8 then
883 XX := RE_Wide_Wide_Width_Enumeration_8;
884 elsif Ttyp = Standard_Integer_16 then
885 XX := RE_Wide_Wide_Width_Enumeration_16;
887 XX := RE_Wide_Wide_Width_Enumeration_32;
893 New_Occurrence_Of (Lit_Strings (Rtyp), Loc),
895 Make_Attribute_Reference (Loc,
896 Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
897 Attribute_Name => Name_Address),
899 Make_Attribute_Reference (Loc,
900 Prefix => New_Reference_To (Ptyp, Loc),
901 Attribute_Name => Name_Pos,
903 Expressions => New_List (
904 Make_Attribute_Reference (Loc,
905 Prefix => New_Reference_To (Ptyp, Loc),
906 Attribute_Name => Name_First))),
908 Make_Attribute_Reference (Loc,
909 Prefix => New_Reference_To (Ptyp, Loc),
910 Attribute_Name => Name_Pos,
912 Expressions => New_List (
913 Make_Attribute_Reference (Loc,
914 Prefix => New_Reference_To (Ptyp, Loc),
915 Attribute_Name => Name_Last))));
917 -- For enumeration'Wide_[Wide_]Width, add encoding method parameter
919 if Attr /= Normal then
921 Make_Integer_Literal (Loc,
922 Intval => Int (Wide_Character_Encoding_Method)));
927 Make_Function_Call (Loc,
928 Name => New_Reference_To (RTE (XX), Loc),
929 Parameter_Associations => Arglist)));
931 Analyze_And_Resolve (N, Typ);
935 -- If we fall through XX and YY are set
937 Arglist := New_List (
939 Make_Attribute_Reference (Loc,
940 Prefix => New_Reference_To (Ptyp, Loc),
941 Attribute_Name => Name_First)),
944 Make_Attribute_Reference (Loc,
945 Prefix => New_Reference_To (Ptyp, Loc),
946 Attribute_Name => Name_Last)));
948 -- For Wide_[Wide_]Character'Width, add encoding method parameter
950 if (Rtyp = Standard_Wide_Character
952 Rtyp = Standard_Wide_Wide_Character)
953 and then Attr /= Normal then
955 Make_Integer_Literal (Loc,
956 Intval => Int (Wide_Character_Encoding_Method)));
961 Make_Function_Call (Loc,
962 Name => New_Reference_To (RTE (XX), Loc),
963 Parameter_Associations => Arglist)));
965 Analyze_And_Resolve (N, Typ);
966 end Expand_Width_Attribute;