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