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