OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [exp_imgv.adb] - Blame information for rev 826

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.