?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
[AArch64] Remove simd_type
[official-gcc.git] / gcc / ada / exp_imgv.adb
blob5da403bb35d60f50c10993eed28edfb4d6f285ad
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E X P _ I M G V --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2012, Free Software Foundation, Inc. --
10 -- --
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. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 with Atree; use Atree;
27 with Casing; use Casing;
28 with Checks; use Checks;
29 with Einfo; use Einfo;
30 with Exp_Util; use Exp_Util;
31 with Lib; use Lib;
32 with Namet; use Namet;
33 with Nmake; use Nmake;
34 with Nlists; use Nlists;
35 with Opt; use Opt;
36 with Rtsfind; use Rtsfind;
37 with Sem_Aux; use Sem_Aux;
38 with Sem_Res; use Sem_Res;
39 with Sinfo; use Sinfo;
40 with Snames; use Snames;
41 with Stand; use Stand;
42 with Stringt; use Stringt;
43 with Tbuild; use Tbuild;
44 with Ttypes; use Ttypes;
45 with Uintp; use Uintp;
46 with Urealp; use Urealp;
47
48 package body Exp_Imgv is
49
50 function Has_Decimal_Small (E : Entity_Id) return Boolean;
51 -- Applies to all entities. True for a Decimal_Fixed_Point_Type, or an
52 -- Ordinary_Fixed_Point_Type with a small that is a negative power of ten.
53 -- Shouldn't this be in einfo.adb or sem_aux.adb???
54
55 ------------------------------------
56 -- Build_Enumeration_Image_Tables --
57 ------------------------------------
58
59 procedure Build_Enumeration_Image_Tables (E : Entity_Id; N : Node_Id) is
60 Loc : constant Source_Ptr := Sloc (E);
61 Str : String_Id;
62 Ind : List_Id;
63 Lit : Entity_Id;
64 Nlit : Nat;
65 Len : Nat;
66 Estr : Entity_Id;
67 Eind : Entity_Id;
68 Ityp : Node_Id;
69
70 begin
71 -- Nothing to do for other than a root enumeration type
72
73 if E /= Root_Type (E) then
74 return;
75
76 -- Nothing to do if pragma Discard_Names applies
77
78 elsif Discard_Names (E) then
79 return;
80 end if;
81
82 -- Otherwise tables need constructing
83
84 Start_String;
85 Ind := New_List;
86 Lit := First_Literal (E);
87 Len := 1;
88 Nlit := 0;
89
90 loop
91 Append_To (Ind,
92 Make_Integer_Literal (Loc, UI_From_Int (Len)));
93
94 exit when No (Lit);
95 Nlit := Nlit + 1;
96
97 Get_Unqualified_Decoded_Name_String (Chars (Lit));
98
99 if Name_Buffer (1) /= ''' then
100 Set_Casing (All_Upper_Case);
101 end if;
102
103 Store_String_Chars (Name_Buffer (1 .. Name_Len));
104 Len := Len + Int (Name_Len);
105 Next_Literal (Lit);
106 end loop;
107
108 if Len < Int (2 ** (8 - 1)) then
109 Ityp := Standard_Integer_8;
110 elsif Len < Int (2 ** (16 - 1)) then
111 Ityp := Standard_Integer_16;
112 else
113 Ityp := Standard_Integer_32;
114 end if;
115
116 Str := End_String;
117
118 Estr :=
119 Make_Defining_Identifier (Loc,
120 Chars => New_External_Name (Chars (E), 'S'));
121
122 Eind :=
123 Make_Defining_Identifier (Loc,
124 Chars => New_External_Name (Chars (E), 'N'));
125
126 Set_Lit_Strings (E, Estr);
127 Set_Lit_Indexes (E, Eind);
128
129 Insert_Actions (N,
130 New_List (
131 Make_Object_Declaration (Loc,
132 Defining_Identifier => Estr,
133 Constant_Present => True,
134 Object_Definition =>
135 New_Occurrence_Of (Standard_String, Loc),
136 Expression =>
137 Make_String_Literal (Loc,
138 Strval => Str)),
139
140 Make_Object_Declaration (Loc,
141 Defining_Identifier => Eind,
142 Constant_Present => True,
143
144 Object_Definition =>
145 Make_Constrained_Array_Definition (Loc,
146 Discrete_Subtype_Definitions => New_List (
147 Make_Range (Loc,
148 Low_Bound => Make_Integer_Literal (Loc, 0),
149 High_Bound => Make_Integer_Literal (Loc, Nlit))),
150 Component_Definition =>
151 Make_Component_Definition (Loc,
152 Aliased_Present => False,
153 Subtype_Indication => New_Occurrence_Of (Ityp, Loc))),
154
155 Expression =>
156 Make_Aggregate (Loc,
157 Expressions => Ind))),
158 Suppress => All_Checks);
159 end Build_Enumeration_Image_Tables;
160
161 ----------------------------
162 -- Expand_Image_Attribute --
163 ----------------------------
164
165 -- For all cases other than user defined enumeration types, the scheme
166 -- is as follows. First we insert the following code:
167
168 -- Snn : String (1 .. rt'Width);
169 -- Pnn : Natural;
170 -- Image_xx (tv, Snn, Pnn [,pm]);
171 --
172 -- and then Expr is replaced by Snn (1 .. Pnn)
173
174 -- In the above expansion:
175
176 -- rt is the root type of the expression
177 -- tv is the expression with the value, usually a type conversion
178 -- pm is an extra parameter present in some cases
179
180 -- The following table shows tv, xx, and (if used) pm for the various
181 -- possible types of the argument:
182
183 -- For types whose root type is Character
184 -- xx = Character
185 -- tv = Character (Expr)
186
187 -- For types whose root type is Boolean
188 -- xx = Boolean
189 -- tv = Boolean (Expr)
190
191 -- For signed integer types with size <= Integer'Size
192 -- xx = Integer
193 -- tv = Integer (Expr)
194
195 -- For other signed integer types
196 -- xx = Long_Long_Integer
197 -- tv = Long_Long_Integer (Expr)
198
199 -- For modular types with modulus <= System.Unsigned_Types.Unsigned
200 -- xx = Unsigned
201 -- tv = System.Unsigned_Types.Unsigned (Expr)
202
203 -- For other modular integer types
204 -- xx = Long_Long_Unsigned
205 -- tv = System.Unsigned_Types.Long_Long_Unsigned (Expr)
206
207 -- For types whose root type is Wide_Character
208 -- xx = Wide_Character
209 -- tv = Wide_Character (Expr)
210 -- pm = Boolean, true if Ada 2005 mode, False otherwise
211
212 -- For types whose root type is Wide_Wide_Character
213 -- xx = Wide_Wide_Character
214 -- tv = Wide_Wide_Character (Expr)
215
216 -- For floating-point types
217 -- xx = Floating_Point
218 -- tv = Long_Long_Float (Expr)
219 -- pm = typ'Digits (typ = subtype of expression)
220
221 -- For ordinary fixed-point types
222 -- xx = Ordinary_Fixed_Point
223 -- tv = Long_Long_Float (Expr)
224 -- pm = typ'Aft (typ = subtype of expression)
225
226 -- For decimal fixed-point types with size = Integer'Size
227 -- xx = Decimal
228 -- tv = Integer (Expr)
229 -- pm = typ'Scale (typ = subtype of expression)
230
231 -- For decimal fixed-point types with size > Integer'Size
232 -- xx = Long_Long_Decimal
233 -- tv = Long_Long_Integer?(Expr) [convert with no scaling]
234 -- pm = typ'Scale (typ = subtype of expression)
235
236 -- For enumeration types other than those declared packages Standard
237 -- or System, Snn, Pnn, are expanded as above, but the call looks like:
238
239 -- Image_Enumeration_NN (rt'Pos (X), Snn, Pnn, typS, typI'Address)
240
241 -- where rt is the root type of the expression, and typS and typI are
242 -- the entities constructed as described in the spec for the procedure
243 -- Build_Enumeration_Image_Tables and NN is 32/16/8 depending on the
244 -- element type of Lit_Indexes. The rewriting of the expression to
245 -- Snn (1 .. Pnn) then occurs as in the other cases. A special case is
246 -- when pragma Discard_Names applies, in which case we replace expr by:
247
248 -- (rt'Pos (expr))'Img
249
250 -- So that the result is a space followed by the decimal value for the
251 -- position of the enumeration value in the enumeration type.
252
253 procedure Expand_Image_Attribute (N : Node_Id) is
254 Loc : constant Source_Ptr := Sloc (N);
255 Exprs : constant List_Id := Expressions (N);
256 Pref : constant Node_Id := Prefix (N);
257 Ptyp : constant Entity_Id := Entity (Pref);
258 Rtyp : constant Entity_Id := Root_Type (Ptyp);
259 Expr : constant Node_Id := Relocate_Node (First (Exprs));
260 Imid : RE_Id;
261 Tent : Entity_Id;
262 Ttyp : Entity_Id;
263 Proc_Ent : Entity_Id;
264 Enum_Case : Boolean;
265
266 Arg_List : List_Id;
267 -- List of arguments for run-time procedure call
268
269 Ins_List : List_Id;
270 -- List of actions to be inserted
271
272 Snn : constant Entity_Id := Make_Temporary (Loc, 'S');
273 Pnn : constant Entity_Id := Make_Temporary (Loc, 'P');
274
275 begin
276 -- Build declarations of Snn and Pnn to be inserted
277
278 Ins_List := New_List (
279
280 -- Snn : String (1 .. typ'Width);
281
282 Make_Object_Declaration (Loc,
283 Defining_Identifier => Snn,
284 Object_Definition =>
285 Make_Subtype_Indication (Loc,
286 Subtype_Mark => New_Occurrence_Of (Standard_String, Loc),
287 Constraint =>
288 Make_Index_Or_Discriminant_Constraint (Loc,
289 Constraints => New_List (
290 Make_Range (Loc,
291 Low_Bound => Make_Integer_Literal (Loc, 1),
292 High_Bound =>
293 Make_Attribute_Reference (Loc,
294 Prefix => New_Occurrence_Of (Rtyp, Loc),
295 Attribute_Name => Name_Width)))))),
296
297 -- Pnn : Natural;
298
299 Make_Object_Declaration (Loc,
300 Defining_Identifier => Pnn,
301 Object_Definition => New_Occurrence_Of (Standard_Natural, Loc)));
302
303 -- Set Imid (RE_Id of procedure to call), and Tent, target for the
304 -- type conversion of the first argument for all possibilities.
305
306 Enum_Case := False;
307
308 if Rtyp = Standard_Boolean then
309 Imid := RE_Image_Boolean;
310 Tent := Rtyp;
311
312 -- For standard character, we have to select the version which handles
313 -- soft hyphen correctly, based on the version of Ada in use (ugly!)
314
315 elsif Rtyp = Standard_Character then
316 if Ada_Version < Ada_2005 then
317 Imid := RE_Image_Character;
318 else
319 Imid := RE_Image_Character_05;
320 end if;
321
322 Tent := Rtyp;
323
324 elsif Rtyp = Standard_Wide_Character then
325 Imid := RE_Image_Wide_Character;
326 Tent := Rtyp;
327
328 elsif Rtyp = Standard_Wide_Wide_Character then
329 Imid := RE_Image_Wide_Wide_Character;
330 Tent := Rtyp;
331
332 elsif Is_Signed_Integer_Type (Rtyp) then
333 if Esize (Rtyp) <= Esize (Standard_Integer) then
334 Imid := RE_Image_Integer;
335 Tent := Standard_Integer;
336 else
337 Imid := RE_Image_Long_Long_Integer;
338 Tent := Standard_Long_Long_Integer;
339 end if;
340
341 elsif Is_Modular_Integer_Type (Rtyp) then
342 if Modulus (Rtyp) <= Modulus (RTE (RE_Unsigned)) then
343 Imid := RE_Image_Unsigned;
344 Tent := RTE (RE_Unsigned);
345 else
346 Imid := RE_Image_Long_Long_Unsigned;
347 Tent := RTE (RE_Long_Long_Unsigned);
348 end if;
349
350 elsif Is_Fixed_Point_Type (Rtyp) and then Has_Decimal_Small (Rtyp) then
351 if UI_To_Int (Esize (Rtyp)) <= Standard_Integer_Size then
352 Imid := RE_Image_Decimal;
353 Tent := Standard_Integer;
354 else
355 Imid := RE_Image_Long_Long_Decimal;
356 Tent := Standard_Long_Long_Integer;
357 end if;
358
359 elsif Is_Ordinary_Fixed_Point_Type (Rtyp) then
360 Imid := RE_Image_Ordinary_Fixed_Point;
361 Tent := Standard_Long_Long_Float;
362
363 elsif Is_Floating_Point_Type (Rtyp) then
364 Imid := RE_Image_Floating_Point;
365 Tent := Standard_Long_Long_Float;
366
367 -- Only other possibility is user defined enumeration type
368
369 else
370 if Discard_Names (First_Subtype (Ptyp))
371 or else No (Lit_Strings (Root_Type (Ptyp)))
372 then
373 -- When pragma Discard_Names applies to the first subtype, build
374 -- (Pref'Pos (Expr))'Img.
375
376 Rewrite (N,
377 Make_Attribute_Reference (Loc,
378 Prefix =>
379 Make_Attribute_Reference (Loc,
380 Prefix => Pref,
381 Attribute_Name => Name_Pos,
382 Expressions => New_List (Expr)),
383 Attribute_Name =>
384 Name_Img));
385 Analyze_And_Resolve (N, Standard_String);
386 return;
387
388 else
389 -- Here for enumeration type case
390
391 Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
392
393 if Ttyp = Standard_Integer_8 then
394 Imid := RE_Image_Enumeration_8;
395
396 elsif Ttyp = Standard_Integer_16 then
397 Imid := RE_Image_Enumeration_16;
398
399 else
400 Imid := RE_Image_Enumeration_32;
401 end if;
402
403 -- Apply a validity check, since it is a bit drastic to get a
404 -- completely junk image value for an invalid value.
405
406 if not Expr_Known_Valid (Expr) then
407 Insert_Valid_Check (Expr);
408 end if;
409
410 Enum_Case := True;
411 end if;
412 end if;
413
414 -- Build first argument for call
415
416 if Enum_Case then
417 Arg_List := New_List (
418 Make_Attribute_Reference (Loc,
419 Attribute_Name => Name_Pos,
420 Prefix => New_Occurrence_Of (Ptyp, Loc),
421 Expressions => New_List (Expr)));
422
423 else
424 Arg_List := New_List (Convert_To (Tent, Expr));
425 end if;
426
427 -- Append Snn, Pnn arguments
428
429 Append_To (Arg_List, New_Occurrence_Of (Snn, Loc));
430 Append_To (Arg_List, New_Occurrence_Of (Pnn, Loc));
431
432 -- Get entity of procedure to call
433
434 Proc_Ent := RTE (Imid);
435
436 -- If the procedure entity is empty, that means we have a case in
437 -- no run time mode where the operation is not allowed, and an
438 -- appropriate diagnostic has already been issued.
439
440 if No (Proc_Ent) then
441 return;
442 end if;
443
444 -- Otherwise complete preparation of arguments for run-time call
445
446 -- Add extra arguments for Enumeration case
447
448 if Enum_Case then
449 Append_To (Arg_List, New_Occurrence_Of (Lit_Strings (Rtyp), Loc));
450 Append_To (Arg_List,
451 Make_Attribute_Reference (Loc,
452 Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
453 Attribute_Name => Name_Address));
454
455 -- For floating-point types, append Digits argument
456
457 elsif Is_Floating_Point_Type (Rtyp) then
458 Append_To (Arg_List,
459 Make_Attribute_Reference (Loc,
460 Prefix => New_Reference_To (Ptyp, Loc),
461 Attribute_Name => Name_Digits));
462
463 -- For ordinary fixed-point types, append Aft parameter
464
465 elsif Is_Ordinary_Fixed_Point_Type (Rtyp) then
466 Append_To (Arg_List,
467 Make_Attribute_Reference (Loc,
468 Prefix => New_Reference_To (Ptyp, Loc),
469 Attribute_Name => Name_Aft));
470
471 if Has_Decimal_Small (Rtyp) then
472 Set_Conversion_OK (First (Arg_List));
473 Set_Etype (First (Arg_List), Tent);
474 end if;
475
476 -- For decimal, append Scale and also set to do literal conversion
477
478 elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
479 Append_To (Arg_List,
480 Make_Attribute_Reference (Loc,
481 Prefix => New_Reference_To (Ptyp, Loc),
482 Attribute_Name => Name_Scale));
483
484 Set_Conversion_OK (First (Arg_List));
485 Set_Etype (First (Arg_List), Tent);
486
487 -- For Wide_Character, append Ada 2005 indication
488
489 elsif Rtyp = Standard_Wide_Character then
490 Append_To (Arg_List,
491 New_Reference_To (Boolean_Literals (Ada_Version >= Ada_2005), Loc));
492 end if;
493
494 -- Now append the procedure call to the insert list
495
496 Append_To (Ins_List,
497 Make_Procedure_Call_Statement (Loc,
498 Name => New_Reference_To (Proc_Ent, Loc),
499 Parameter_Associations => Arg_List));
500
501 -- Insert declarations of Snn, Pnn, and the procedure call. We suppress
502 -- checks because we are sure that everything is in range at this stage.
503
504 Insert_Actions (N, Ins_List, Suppress => All_Checks);
505
506 -- Final step is to rewrite the expression as a slice and analyze,
507 -- again with no checks, since we are sure that everything is OK.
508
509 Rewrite (N,
510 Make_Slice (Loc,
511 Prefix => New_Occurrence_Of (Snn, Loc),
512 Discrete_Range =>
513 Make_Range (Loc,
514 Low_Bound => Make_Integer_Literal (Loc, 1),
515 High_Bound => New_Occurrence_Of (Pnn, Loc))));
516
517 Analyze_And_Resolve (N, Standard_String, Suppress => All_Checks);
518 end Expand_Image_Attribute;
519
520 ----------------------------
521 -- Expand_Value_Attribute --
522 ----------------------------
523
524 -- For scalar types derived from Boolean, Character and integer types
525 -- in package Standard, typ'Value (X) expands into:
526
527 -- btyp (Value_xx (X))
528
529 -- where btyp is he base type of the prefix
530
531 -- For types whose root type is Character
532 -- xx = Character
533
534 -- For types whose root type is Wide_Character
535 -- xx = Wide_Character
536
537 -- For types whose root type is Wide_Wide_Character
538 -- xx = Wide_Wide_Character
539
540 -- For types whose root type is Boolean
541 -- xx = Boolean
542
543 -- For signed integer types with size <= Integer'Size
544 -- xx = Integer
545
546 -- For other signed integer types
547 -- xx = Long_Long_Integer
548
549 -- For modular types with modulus <= System.Unsigned_Types.Unsigned
550 -- xx = Unsigned
551
552 -- For other modular integer types
553 -- xx = Long_Long_Unsigned
554
555 -- For floating-point types and ordinary fixed-point types
556 -- xx = Real
557
558 -- For Wide_[Wide_]Character types, typ'Value (X) expands into:
559
560 -- btyp (Value_xx (X, EM))
561
562 -- where btyp is the base type of the prefix, and EM is the encoding method
563
564 -- For decimal types with size <= Integer'Size, typ'Value (X)
565 -- expands into
566
567 -- btyp?(Value_Decimal (X, typ'Scale));
568
569 -- For all other decimal types, typ'Value (X) expands into
570
571 -- btyp?(Value_Long_Long_Decimal (X, typ'Scale))
572
573 -- For enumeration types other than those derived from types Boolean,
574 -- Character, Wide_[Wide_]Character in Standard, typ'Value (X) expands to:
575
576 -- Enum'Val (Value_Enumeration_NN (typS, typI'Address, Num, X))
577
578 -- where typS and typI and the Lit_Strings and Lit_Indexes entities
579 -- from T's root type entity, and Num is Enum'Pos (Enum'Last). The
580 -- Value_Enumeration_NN function will search the tables looking for
581 -- X and return the position number in the table if found which is
582 -- used to provide the result of 'Value (using Enum'Val). If the
583 -- value is not found Constraint_Error is raised. The suffix _NN
584 -- depends on the element type of typI.
585
586 procedure Expand_Value_Attribute (N : Node_Id) is
587 Loc : constant Source_Ptr := Sloc (N);
588 Typ : constant Entity_Id := Etype (N);
589 Btyp : constant Entity_Id := Base_Type (Typ);
590 Rtyp : constant Entity_Id := Root_Type (Typ);
591 Exprs : constant List_Id := Expressions (N);
592 Vid : RE_Id;
593 Args : List_Id;
594 Func : RE_Id;
595 Ttyp : Entity_Id;
596
597 begin
598 Args := Exprs;
599
600 if Rtyp = Standard_Character then
601 Vid := RE_Value_Character;
602
603 elsif Rtyp = Standard_Boolean then
604 Vid := RE_Value_Boolean;
605
606 elsif Rtyp = Standard_Wide_Character then
607 Vid := RE_Value_Wide_Character;
608
609 Append_To (Args,
610 Make_Integer_Literal (Loc,
611 Intval => Int (Wide_Character_Encoding_Method)));
612
613 elsif Rtyp = Standard_Wide_Wide_Character then
614 Vid := RE_Value_Wide_Wide_Character;
615
616 Append_To (Args,
617 Make_Integer_Literal (Loc,
618 Intval => Int (Wide_Character_Encoding_Method)));
619
620 elsif Rtyp = Base_Type (Standard_Short_Short_Integer)
621 or else Rtyp = Base_Type (Standard_Short_Integer)
622 or else Rtyp = Base_Type (Standard_Integer)
623 then
624 Vid := RE_Value_Integer;
625
626 elsif Is_Signed_Integer_Type (Rtyp) then
627 Vid := RE_Value_Long_Long_Integer;
628
629 elsif Is_Modular_Integer_Type (Rtyp) then
630 if Modulus (Rtyp) <= Modulus (RTE (RE_Unsigned)) then
631 Vid := RE_Value_Unsigned;
632 else
633 Vid := RE_Value_Long_Long_Unsigned;
634 end if;
635
636 elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
637 if UI_To_Int (Esize (Rtyp)) <= Standard_Integer_Size then
638 Vid := RE_Value_Decimal;
639 else
640 Vid := RE_Value_Long_Long_Decimal;
641 end if;
642
643 Append_To (Args,
644 Make_Attribute_Reference (Loc,
645 Prefix => New_Reference_To (Typ, Loc),
646 Attribute_Name => Name_Scale));
647
648 Rewrite (N,
649 OK_Convert_To (Btyp,
650 Make_Function_Call (Loc,
651 Name => New_Reference_To (RTE (Vid), Loc),
652 Parameter_Associations => Args)));
653
654 Set_Etype (N, Btyp);
655 Analyze_And_Resolve (N, Btyp);
656 return;
657
658 elsif Is_Real_Type (Rtyp) then
659 Vid := RE_Value_Real;
660
661 -- Only other possibility is user defined enumeration type
662
663 else
664 pragma Assert (Is_Enumeration_Type (Rtyp));
665
666 -- Case of pragma Discard_Names, transform the Value
667 -- attribute to Btyp'Val (Long_Long_Integer'Value (Args))
668
669 if Discard_Names (First_Subtype (Typ))
670 or else No (Lit_Strings (Rtyp))
671 then
672 Rewrite (N,
673 Make_Attribute_Reference (Loc,
674 Prefix => New_Reference_To (Btyp, Loc),
675 Attribute_Name => Name_Val,
676 Expressions => New_List (
677 Make_Attribute_Reference (Loc,
678 Prefix =>
679 New_Occurrence_Of (Standard_Long_Long_Integer, Loc),
680 Attribute_Name => Name_Value,
681 Expressions => Args))));
682
683 Analyze_And_Resolve (N, Btyp);
684
685 -- Here for normal case where we have enumeration tables, this
686 -- is where we build
687
688 -- T'Val (Value_Enumeration_NN (typS, typI'Address, Num, X))
689
690 else
691 Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
692
693 if Ttyp = Standard_Integer_8 then
694 Func := RE_Value_Enumeration_8;
695 elsif Ttyp = Standard_Integer_16 then
696 Func := RE_Value_Enumeration_16;
697 else
698 Func := RE_Value_Enumeration_32;
699 end if;
700
701 Prepend_To (Args,
702 Make_Attribute_Reference (Loc,
703 Prefix => New_Occurrence_Of (Rtyp, Loc),
704 Attribute_Name => Name_Pos,
705 Expressions => New_List (
706 Make_Attribute_Reference (Loc,
707 Prefix => New_Occurrence_Of (Rtyp, Loc),
708 Attribute_Name => Name_Last))));
709
710 Prepend_To (Args,
711 Make_Attribute_Reference (Loc,
712 Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
713 Attribute_Name => Name_Address));
714
715 Prepend_To (Args,
716 New_Occurrence_Of (Lit_Strings (Rtyp), Loc));
717
718 Rewrite (N,
719 Make_Attribute_Reference (Loc,
720 Prefix => New_Reference_To (Typ, Loc),
721 Attribute_Name => Name_Val,
722 Expressions => New_List (
723 Make_Function_Call (Loc,
724 Name =>
725 New_Reference_To (RTE (Func), Loc),
726 Parameter_Associations => Args))));
727
728 Analyze_And_Resolve (N, Btyp);
729 end if;
730
731 return;
732 end if;
733
734 -- Fall through for all cases except user defined enumeration type
735 -- and decimal types, with Vid set to the Id of the entity for the
736 -- Value routine and Args set to the list of parameters for the call.
737
738 -- Compiling package Ada.Tags under No_Run_Time_Mode we disable the
739 -- expansion of the attribute into the function call statement to avoid
740 -- generating spurious errors caused by the use of Integer_Address'Value
741 -- in our implementation of Ada.Tags.Internal_Tag
742
743 -- Seems like a bit of a kludge, there should be a better way ???
744
745 -- There is a better way, you should also test RTE_Available ???
746
747 if No_Run_Time_Mode
748 and then Rtyp = RTE (RE_Integer_Address)
749 and then RTU_Loaded (Ada_Tags)
750 and then Cunit_Entity (Current_Sem_Unit)
751 = Body_Entity (RTU_Entity (Ada_Tags))
752 then
753 Rewrite (N,
754 Unchecked_Convert_To (Rtyp,
755 Make_Integer_Literal (Loc, Uint_0)));
756 else
757 Rewrite (N,
758 Convert_To (Btyp,
759 Make_Function_Call (Loc,
760 Name => New_Reference_To (RTE (Vid), Loc),
761 Parameter_Associations => Args)));
762 end if;
763
764 Analyze_And_Resolve (N, Btyp);
765 end Expand_Value_Attribute;
766
767 ---------------------------------
768 -- Expand_Wide_Image_Attribute --
769 ---------------------------------
770
771 -- We expand typ'Wide_Image (X) as follows. First we insert this code:
772
773 -- Rnn : Wide_String (1 .. rt'Wide_Width);
774 -- Lnn : Natural;
775 -- String_To_Wide_String
776 -- (typ'Image (Expr), Rnn, Lnn, Wide_Character_Encoding_Method);
777
778 -- where rt is the root type of the prefix type
779
780 -- Now we replace the Wide_Image reference by
781
782 -- Rnn (1 .. Lnn)
783
784 -- This works in all cases because String_To_Wide_String converts any
785 -- wide character escape sequences resulting from the Image call to the
786 -- proper Wide_Character equivalent
787
788 -- not quite right for typ = Wide_Character ???
789
790 procedure Expand_Wide_Image_Attribute (N : Node_Id) is
791 Loc : constant Source_Ptr := Sloc (N);
792 Rtyp : constant Entity_Id := Root_Type (Entity (Prefix (N)));
793 Rnn : constant Entity_Id := Make_Temporary (Loc, 'S');
794 Lnn : constant Entity_Id := Make_Temporary (Loc, 'P');
795
796 begin
797 Insert_Actions (N, New_List (
798
799 -- Rnn : Wide_String (1 .. base_typ'Width);
800
801 Make_Object_Declaration (Loc,
802 Defining_Identifier => Rnn,
803 Object_Definition =>
804 Make_Subtype_Indication (Loc,
805 Subtype_Mark =>
806 New_Occurrence_Of (Standard_Wide_String, Loc),
807 Constraint =>
808 Make_Index_Or_Discriminant_Constraint (Loc,
809 Constraints => New_List (
810 Make_Range (Loc,
811 Low_Bound => Make_Integer_Literal (Loc, 1),
812 High_Bound =>
813 Make_Attribute_Reference (Loc,
814 Prefix => New_Occurrence_Of (Rtyp, Loc),
815 Attribute_Name => Name_Wide_Width)))))),
816
817 -- Lnn : Natural;
818
819 Make_Object_Declaration (Loc,
820 Defining_Identifier => Lnn,
821 Object_Definition => New_Occurrence_Of (Standard_Natural, Loc)),
822
823 -- String_To_Wide_String
824 -- (typ'Image (X), Rnn, Lnn, Wide_Character_Encoding_Method);
825
826 Make_Procedure_Call_Statement (Loc,
827 Name =>
828 New_Reference_To (RTE (RE_String_To_Wide_String), Loc),
829
830 Parameter_Associations => New_List (
831 Make_Attribute_Reference (Loc,
832 Prefix => Prefix (N),
833 Attribute_Name => Name_Image,
834 Expressions => Expressions (N)),
835 New_Reference_To (Rnn, Loc),
836 New_Reference_To (Lnn, Loc),
837 Make_Integer_Literal (Loc,
838 Intval => Int (Wide_Character_Encoding_Method))))),
839
840 -- Suppress checks because we know everything is properly in range
841
842 Suppress => All_Checks);
843
844 -- Final step is to rewrite the expression as a slice and analyze,
845 -- again with no checks, since we are sure that everything is OK.
846
847 Rewrite (N,
848 Make_Slice (Loc,
849 Prefix => New_Occurrence_Of (Rnn, Loc),
850 Discrete_Range =>
851 Make_Range (Loc,
852 Low_Bound => Make_Integer_Literal (Loc, 1),
853 High_Bound => New_Occurrence_Of (Lnn, Loc))));
854
855 Analyze_And_Resolve (N, Standard_Wide_String, Suppress => All_Checks);
856 end Expand_Wide_Image_Attribute;
857
858 --------------------------------------
859 -- Expand_Wide_Wide_Image_Attribute --
860 --------------------------------------
861
862 -- We expand typ'Wide_Wide_Image (X) as follows. First we insert this code:
863
864 -- Rnn : Wide_Wide_String (1 .. rt'Wide_Wide_Width);
865 -- Lnn : Natural;
866 -- String_To_Wide_Wide_String
867 -- (typ'Image (Expr), Rnn, Lnn, Wide_Character_Encoding_Method);
868
869 -- where rt is the root type of the prefix type
870
871 -- Now we replace the Wide_Wide_Image reference by
872
873 -- Rnn (1 .. Lnn)
874
875 -- This works in all cases because String_To_Wide_Wide_String converts any
876 -- wide character escape sequences resulting from the Image call to the
877 -- proper Wide_Wide_Character equivalent
878
879 -- not quite right for typ = Wide_Wide_Character ???
880
881 procedure Expand_Wide_Wide_Image_Attribute (N : Node_Id) is
882 Loc : constant Source_Ptr := Sloc (N);
883 Rtyp : constant Entity_Id := Root_Type (Entity (Prefix (N)));
884
885 Rnn : constant Entity_Id := Make_Temporary (Loc, 'S');
886 Lnn : constant Entity_Id := Make_Temporary (Loc, 'P');
887
888 begin
889 Insert_Actions (N, New_List (
890
891 -- Rnn : Wide_Wide_String (1 .. rt'Wide_Wide_Width);
892
893 Make_Object_Declaration (Loc,
894 Defining_Identifier => Rnn,
895 Object_Definition =>
896 Make_Subtype_Indication (Loc,
897 Subtype_Mark =>
898 New_Occurrence_Of (Standard_Wide_Wide_String, Loc),
899 Constraint =>
900 Make_Index_Or_Discriminant_Constraint (Loc,
901 Constraints => New_List (
902 Make_Range (Loc,
903 Low_Bound => Make_Integer_Literal (Loc, 1),
904 High_Bound =>
905 Make_Attribute_Reference (Loc,
906 Prefix => New_Occurrence_Of (Rtyp, Loc),
907 Attribute_Name => Name_Wide_Wide_Width)))))),
908
909 -- Lnn : Natural;
910
911 Make_Object_Declaration (Loc,
912 Defining_Identifier => Lnn,
913 Object_Definition => New_Occurrence_Of (Standard_Natural, Loc)),
914
915 -- String_To_Wide_Wide_String
916 -- (typ'Image (X), Rnn, Lnn, Wide_Character_Encoding_Method);
917
918 Make_Procedure_Call_Statement (Loc,
919 Name =>
920 New_Reference_To (RTE (RE_String_To_Wide_Wide_String), Loc),
921
922 Parameter_Associations => New_List (
923 Make_Attribute_Reference (Loc,
924 Prefix => Prefix (N),
925 Attribute_Name => Name_Image,
926 Expressions => Expressions (N)),
927 New_Reference_To (Rnn, Loc),
928 New_Reference_To (Lnn, Loc),
929 Make_Integer_Literal (Loc,
930 Intval => Int (Wide_Character_Encoding_Method))))),
931
932 -- Suppress checks because we know everything is properly in range
933
934 Suppress => All_Checks);
935
936 -- Final step is to rewrite the expression as a slice and analyze,
937 -- again with no checks, since we are sure that everything is OK.
938
939 Rewrite (N,
940 Make_Slice (Loc,
941 Prefix => New_Occurrence_Of (Rnn, Loc),
942 Discrete_Range =>
943 Make_Range (Loc,
944 Low_Bound => Make_Integer_Literal (Loc, 1),
945 High_Bound => New_Occurrence_Of (Lnn, Loc))));
946
947 Analyze_And_Resolve
948 (N, Standard_Wide_Wide_String, Suppress => All_Checks);
949 end Expand_Wide_Wide_Image_Attribute;
950
951 ----------------------------
952 -- Expand_Width_Attribute --
953 ----------------------------
954
955 -- The processing here also handles the case of Wide_[Wide_]Width. With the
956 -- exceptions noted, the processing is identical
957
958 -- For scalar types derived from Boolean, character and integer types
959 -- in package Standard. Note that the Width attribute is computed at
960 -- compile time for all cases except those involving non-static sub-
961 -- types. For such subtypes, typ'[Wide_[Wide_]]Width expands into:
962
963 -- Result_Type (xx (yy (Ptyp'First), yy (Ptyp'Last)))
964
965 -- where
966
967 -- For types whose root type is Character
968 -- xx = Width_Character
969 -- yy = Character
970
971 -- For types whose root type is Wide_Character
972 -- xx = Wide_Width_Character
973 -- yy = Character
974
975 -- For types whose root type is Wide_Wide_Character
976 -- xx = Wide_Wide_Width_Character
977 -- yy = Character
978
979 -- For types whose root type is Boolean
980 -- xx = Width_Boolean
981 -- yy = Boolean
982
983 -- For signed integer types
984 -- xx = Width_Long_Long_Integer
985 -- yy = Long_Long_Integer
986
987 -- For modular integer types
988 -- xx = Width_Long_Long_Unsigned
989 -- yy = Long_Long_Unsigned
990
991 -- For types derived from Wide_Character, typ'Width expands into
992
993 -- Result_Type (Width_Wide_Character (
994 -- Wide_Character (typ'First),
995 -- Wide_Character (typ'Last),
996
997 -- and typ'Wide_Width expands into:
998
999 -- Result_Type (Wide_Width_Wide_Character (
1000 -- Wide_Character (typ'First),
1001 -- Wide_Character (typ'Last));
1002
1003 -- and typ'Wide_Wide_Width expands into
1004
1005 -- Result_Type (Wide_Wide_Width_Wide_Character (
1006 -- Wide_Character (typ'First),
1007 -- Wide_Character (typ'Last));
1008
1009 -- For types derived from Wide_Wide_Character, typ'Width expands into
1010
1011 -- Result_Type (Width_Wide_Wide_Character (
1012 -- Wide_Wide_Character (typ'First),
1013 -- Wide_Wide_Character (typ'Last),
1014
1015 -- and typ'Wide_Width expands into:
1016
1017 -- Result_Type (Wide_Width_Wide_Wide_Character (
1018 -- Wide_Wide_Character (typ'First),
1019 -- Wide_Wide_Character (typ'Last));
1020
1021 -- and typ'Wide_Wide_Width expands into
1022
1023 -- Result_Type (Wide_Wide_Width_Wide_Wide_Char (
1024 -- Wide_Wide_Character (typ'First),
1025 -- Wide_Wide_Character (typ'Last));
1026
1027 -- For real types, typ'Width and typ'Wide_[Wide_]Width expand into
1028
1029 -- if Ptyp'First > Ptyp'Last then 0 else btyp'Width end if
1030
1031 -- where btyp is the base type. This looks recursive but it isn't
1032 -- because the base type is always static, and hence the expression
1033 -- in the else is reduced to an integer literal.
1034
1035 -- For user defined enumeration types, typ'Width expands into
1036
1037 -- Result_Type (Width_Enumeration_NN
1038 -- (typS,
1039 -- typI'Address,
1040 -- typ'Pos (typ'First),
1041 -- typ'Pos (Typ'Last)));
1042
1043 -- and typ'Wide_Width expands into:
1044
1045 -- Result_Type (Wide_Width_Enumeration_NN
1046 -- (typS,
1047 -- typI,
1048 -- typ'Pos (typ'First),
1049 -- typ'Pos (Typ'Last))
1050 -- Wide_Character_Encoding_Method);
1051
1052 -- and typ'Wide_Wide_Width expands into:
1053
1054 -- Result_Type (Wide_Wide_Width_Enumeration_NN
1055 -- (typS,
1056 -- typI,
1057 -- typ'Pos (typ'First),
1058 -- typ'Pos (Typ'Last))
1059 -- Wide_Character_Encoding_Method);
1060
1061 -- where typS and typI are the enumeration image strings and indexes
1062 -- table, as described in Build_Enumeration_Image_Tables. NN is 8/16/32
1063 -- for depending on the element type for typI.
1064
1065 -- Finally if Discard_Names is in effect for an enumeration type, then
1066 -- a special if expression is built that yields the space needed for the
1067 -- decimal representation of the largest pos value in the subtype. See
1068 -- code below for details.
1069
1070 procedure Expand_Width_Attribute (N : Node_Id; Attr : Atype := Normal) is
1071 Loc : constant Source_Ptr := Sloc (N);
1072 Typ : constant Entity_Id := Etype (N);
1073 Pref : constant Node_Id := Prefix (N);
1074 Ptyp : constant Entity_Id := Etype (Pref);
1075 Rtyp : constant Entity_Id := Root_Type (Ptyp);
1076 Arglist : List_Id;
1077 Ttyp : Entity_Id;
1078 XX : RE_Id;
1079 YY : Entity_Id;
1080
1081 begin
1082 -- Types derived from Standard.Boolean
1083
1084 if Rtyp = Standard_Boolean then
1085 XX := RE_Width_Boolean;
1086 YY := Rtyp;
1087
1088 -- Types derived from Standard.Character
1089
1090 elsif Rtyp = Standard_Character then
1091 case Attr is
1092 when Normal => XX := RE_Width_Character;
1093 when Wide => XX := RE_Wide_Width_Character;
1094 when Wide_Wide => XX := RE_Wide_Wide_Width_Character;
1095 end case;
1096
1097 YY := Rtyp;
1098
1099 -- Types derived from Standard.Wide_Character
1100
1101 elsif Rtyp = Standard_Wide_Character then
1102 case Attr is
1103 when Normal => XX := RE_Width_Wide_Character;
1104 when Wide => XX := RE_Wide_Width_Wide_Character;
1105 when Wide_Wide => XX := RE_Wide_Wide_Width_Wide_Character;
1106 end case;
1107
1108 YY := Rtyp;
1109
1110 -- Types derived from Standard.Wide_Wide_Character
1111
1112 elsif Rtyp = Standard_Wide_Wide_Character then
1113 case Attr is
1114 when Normal => XX := RE_Width_Wide_Wide_Character;
1115 when Wide => XX := RE_Wide_Width_Wide_Wide_Character;
1116 when Wide_Wide => XX := RE_Wide_Wide_Width_Wide_Wide_Char;
1117 end case;
1118
1119 YY := Rtyp;
1120
1121 -- Signed integer types
1122
1123 elsif Is_Signed_Integer_Type (Rtyp) then
1124 XX := RE_Width_Long_Long_Integer;
1125 YY := Standard_Long_Long_Integer;
1126
1127 -- Modular integer types
1128
1129 elsif Is_Modular_Integer_Type (Rtyp) then
1130 XX := RE_Width_Long_Long_Unsigned;
1131 YY := RTE (RE_Long_Long_Unsigned);
1132
1133 -- Real types
1134
1135 elsif Is_Real_Type (Rtyp) then
1136 Rewrite (N,
1137 Make_If_Expression (Loc,
1138 Expressions => New_List (
1139
1140 Make_Op_Gt (Loc,
1141 Left_Opnd =>
1142 Make_Attribute_Reference (Loc,
1143 Prefix => New_Reference_To (Ptyp, Loc),
1144 Attribute_Name => Name_First),
1145
1146 Right_Opnd =>
1147 Make_Attribute_Reference (Loc,
1148 Prefix => New_Reference_To (Ptyp, Loc),
1149 Attribute_Name => Name_Last)),
1150
1151 Make_Integer_Literal (Loc, 0),
1152
1153 Make_Attribute_Reference (Loc,
1154 Prefix => New_Reference_To (Base_Type (Ptyp), Loc),
1155 Attribute_Name => Name_Width))));
1156
1157 Analyze_And_Resolve (N, Typ);
1158 return;
1159
1160 -- User defined enumeration types
1161
1162 else
1163 pragma Assert (Is_Enumeration_Type (Rtyp));
1164
1165 -- Whenever pragma Discard_Names is in effect, the value we need
1166 -- is the value needed to accomodate the largest integer pos value
1167 -- in the range of the subtype + 1 for the space at the start. We
1168 -- build:
1169
1170 -- Tnn : constant Integer := Rtyp'Pos (Ptyp'Last)
1171
1172 -- and replace the expression by
1173
1174 -- (if Ptyp'Range_Length = 0 then 0
1175 -- else (if Tnn < 10 then 2
1176 -- else (if Tnn < 100 then 3
1177 -- ...
1178 -- else n)))...
1179
1180 -- where n is equal to Rtyp'Pos (Ptyp'Last) + 1
1181
1182 -- Note: The above processing is in accordance with the intent of
1183 -- the RM, which is that Width should be related to the impl-defined
1184 -- behavior of Image. It is not clear what this means if Image is
1185 -- not defined (as in the configurable run-time case for GNAT) and
1186 -- gives an error at compile time.
1187
1188 -- We choose in this case to just go ahead and implement Width the
1189 -- same way, returning what Image would have returned if it has been
1190 -- available in the configurable run-time library.
1191
1192 if Discard_Names (Rtyp) then
1193 declare
1194 Tnn : constant Entity_Id := Make_Temporary (Loc, 'T');
1195 Cexpr : Node_Id;
1196 P : Int;
1197 M : Int;
1198 K : Int;
1199
1200 begin
1201 Insert_Action (N,
1202 Make_Object_Declaration (Loc,
1203 Defining_Identifier => Tnn,
1204 Constant_Present => True,
1205 Object_Definition =>
1206 New_Occurrence_Of (Standard_Integer, Loc),
1207 Expression =>
1208 Make_Attribute_Reference (Loc,
1209 Prefix => New_Occurrence_Of (Rtyp, Loc),
1210 Attribute_Name => Name_Pos,
1211 Expressions => New_List (
1212 Convert_To (Rtyp,
1213 Make_Attribute_Reference (Loc,
1214 Prefix => New_Occurrence_Of (Ptyp, Loc),
1215 Attribute_Name => Name_Last))))));
1216
1217 -- OK, now we need to build the if expression. First get the
1218 -- value of M, the largest possible value needed.
1219
1220 P := UI_To_Int
1221 (Enumeration_Pos (Entity (Type_High_Bound (Rtyp))));
1222
1223 K := 1;
1224 M := 1;
1225 while M < P loop
1226 M := M * 10;
1227 K := K + 1;
1228 end loop;
1229
1230 -- Build inner else
1231
1232 Cexpr := Make_Integer_Literal (Loc, K);
1233
1234 -- Wrap in inner if's until counted down to 2
1235
1236 while K > 2 loop
1237 M := M / 10;
1238 K := K - 1;
1239
1240 Cexpr :=
1241 Make_If_Expression (Loc,
1242 Expressions => New_List (
1243 Make_Op_Lt (Loc,
1244 Left_Opnd => New_Occurrence_Of (Tnn, Loc),
1245 Right_Opnd => Make_Integer_Literal (Loc, M)),
1246 Make_Integer_Literal (Loc, K),
1247 Cexpr));
1248 end loop;
1249
1250 -- Add initial comparison for null range and we are done, so
1251 -- rewrite the attribute occurrence with this expression.
1252
1253 Rewrite (N,
1254 Convert_To (Typ,
1255 Make_If_Expression (Loc,
1256 Expressions => New_List (
1257 Make_Op_Eq (Loc,
1258 Left_Opnd =>
1259 Make_Attribute_Reference (Loc,
1260 Prefix => New_Occurrence_Of (Ptyp, Loc),
1261 Attribute_Name => Name_Range_Length),
1262 Right_Opnd => Make_Integer_Literal (Loc, 0)),
1263 Make_Integer_Literal (Loc, 0),
1264 Cexpr))));
1265
1266 Analyze_And_Resolve (N, Typ);
1267 return;
1268 end;
1269 end if;
1270
1271 -- Normal case, not Discard_Names
1272
1273 Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
1274
1275 case Attr is
1276 when Normal =>
1277 if Ttyp = Standard_Integer_8 then
1278 XX := RE_Width_Enumeration_8;
1279 elsif Ttyp = Standard_Integer_16 then
1280 XX := RE_Width_Enumeration_16;
1281 else
1282 XX := RE_Width_Enumeration_32;
1283 end if;
1284
1285 when Wide =>
1286 if Ttyp = Standard_Integer_8 then
1287 XX := RE_Wide_Width_Enumeration_8;
1288 elsif Ttyp = Standard_Integer_16 then
1289 XX := RE_Wide_Width_Enumeration_16;
1290 else
1291 XX := RE_Wide_Width_Enumeration_32;
1292 end if;
1293
1294 when Wide_Wide =>
1295 if Ttyp = Standard_Integer_8 then
1296 XX := RE_Wide_Wide_Width_Enumeration_8;
1297 elsif Ttyp = Standard_Integer_16 then
1298 XX := RE_Wide_Wide_Width_Enumeration_16;
1299 else
1300 XX := RE_Wide_Wide_Width_Enumeration_32;
1301 end if;
1302 end case;
1303
1304 Arglist :=
1305 New_List (
1306 New_Occurrence_Of (Lit_Strings (Rtyp), Loc),
1307
1308 Make_Attribute_Reference (Loc,
1309 Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
1310 Attribute_Name => Name_Address),
1311
1312 Make_Attribute_Reference (Loc,
1313 Prefix => New_Reference_To (Ptyp, Loc),
1314 Attribute_Name => Name_Pos,
1315
1316 Expressions => New_List (
1317 Make_Attribute_Reference (Loc,
1318 Prefix => New_Reference_To (Ptyp, Loc),
1319 Attribute_Name => Name_First))),
1320
1321 Make_Attribute_Reference (Loc,
1322 Prefix => New_Reference_To (Ptyp, Loc),
1323 Attribute_Name => Name_Pos,
1324
1325 Expressions => New_List (
1326 Make_Attribute_Reference (Loc,
1327 Prefix => New_Reference_To (Ptyp, Loc),
1328 Attribute_Name => Name_Last))));
1329
1330 Rewrite (N,
1331 Convert_To (Typ,
1332 Make_Function_Call (Loc,
1333 Name => New_Reference_To (RTE (XX), Loc),
1334 Parameter_Associations => Arglist)));
1335
1336 Analyze_And_Resolve (N, Typ);
1337 return;
1338 end if;
1339
1340 -- If we fall through XX and YY are set
1341
1342 Arglist := New_List (
1343 Convert_To (YY,
1344 Make_Attribute_Reference (Loc,
1345 Prefix => New_Reference_To (Ptyp, Loc),
1346 Attribute_Name => Name_First)),
1347
1348 Convert_To (YY,
1349 Make_Attribute_Reference (Loc,
1350 Prefix => New_Reference_To (Ptyp, Loc),
1351 Attribute_Name => Name_Last)));
1352
1353 Rewrite (N,
1354 Convert_To (Typ,
1355 Make_Function_Call (Loc,
1356 Name => New_Reference_To (RTE (XX), Loc),
1357 Parameter_Associations => Arglist)));
1358
1359 Analyze_And_Resolve (N, Typ);
1360 end Expand_Width_Attribute;
1361
1362 -----------------------
1363 -- Has_Decimal_Small --
1364 -----------------------
1365
1366 function Has_Decimal_Small (E : Entity_Id) return Boolean is
1367 begin
1368 return Is_Decimal_Fixed_Point_Type (E)
1369 or else
1370 (Is_Ordinary_Fixed_Point_Type (E)
1371 and then Ureal_10**Aft_Value (E) * Small_Value (E) = Ureal_1);
1372 end Has_Decimal_Small;
1373
1374 end Exp_Imgv;
Mirror of the offical gcc git repository hosted at gcc.gnu.org