gcc/ada/exp_imgv.adb

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