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