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 --                                                                          --
  10 --            Copyright (C) 2001 Free Software Foundation, Inc.             --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 with Atree;    use Atree;
  29 with Casing;   use Casing;
  30 with Checks;   use Checks;
  31 with Einfo;    use Einfo;
  32 with Exp_Util; use Exp_Util;
  33 with Namet;    use Namet;
  34 with Nmake;    use Nmake;
  35 with Nlists;   use Nlists;
  36 with Opt;      use Opt;
  37 with Rtsfind;  use Rtsfind;
  38 with Sem_Res;  use Sem_Res;
  39 with Sinfo;    use Sinfo;
  40 with Snames;   use Snames;
  41 with Stand;    use Stand;
  42 with Stringt;  use Stringt;
  43 with Tbuild;   use Tbuild;
  44 with Ttypes;   use Ttypes;
  45 with Uintp;    use Uintp;
  46
  47 package body Exp_Imgv is
  48
  49    ------------------------------------
  50    -- Build_Enumeration_Image_Tables --
  51    ------------------------------------
  52
  53    procedure Build_Enumeration_Image_Tables (E : Entity_Id; N : Node_Id) is
  54       Loc  : constant Source_Ptr := Sloc (E);
  55       Str  : String_Id;
  56       Ind  : List_Id;
  57       Lit  : Entity_Id;
  58       Nlit : Nat;
  59       Len  : Nat;
  60       Estr : Entity_Id;
  61       Eind : Entity_Id;
  62       Ityp : Node_Id;
  63
  64    begin
  65       --  Nothing to do for other than a root enumeration type
  66
  67       if E /= Root_Type (E) then
  68          return;
  69
  70       --  Nothing to do if pragma Discard_Names applies
  71
  72       elsif Discard_Names (E) then
  73          return;
  74       end if;
  75
  76       --  Otherwise tables need constructing
  77
  78       Start_String;
  79       Ind := New_List;
  80       Lit := First_Literal (E);
  81       Len := 1;
  82       Nlit := 0;
  83
  84       loop
  85          Append_To (Ind,
  86            Make_Integer_Literal (Loc, UI_From_Int (Len)));
  87
  88          exit when No (Lit);
  89          Nlit := Nlit + 1;
  90
  91          Get_Unqualified_Decoded_Name_String (Chars (Lit));
  92
  93          if Name_Buffer (1) /= ''' then
  94             Set_Casing (All_Upper_Case);
  95          end if;
  96
  97          Store_String_Chars (Name_Buffer (1 .. Name_Len));
  98          Len := Len + Int (Name_Len);
  99          Next_Literal (Lit);
 100       end loop;
 101
 102       if Len < Int (2 ** (8 - 1)) then
 103          Ityp := Standard_Integer_8;
 104       elsif Len < Int (2 ** (16 - 1)) then
 105          Ityp := Standard_Integer_16;
 106       else
 107          Ityp := Standard_Integer_32;
 108       end if;
 109
 110       Str := End_String;
 111
 112       Estr :=
 113         Make_Defining_Identifier (Loc,
 114           Chars => New_External_Name (Chars (E), 'S'));
 115
 116       Eind :=
 117         Make_Defining_Identifier (Loc,
 118           Chars => New_External_Name (Chars (E), 'I'));
 119
 120       Set_Lit_Strings (E, Estr);
 121       Set_Lit_Indexes (E, Eind);
 122
 123       Insert_Actions (N,
 124         New_List (
 125           Make_Object_Declaration (Loc,
 126             Defining_Identifier => Estr,
 127             Constant_Present    => True,
 128             Object_Definition   =>
 129               New_Occurrence_Of (Standard_String, Loc),
 130             Expression          =>
 131               Make_String_Literal (Loc,
 132                 Strval => Str)),
 133
 134           Make_Object_Declaration (Loc,
 135             Defining_Identifier => Eind,
 136             Constant_Present    => True,
 137
 138             Object_Definition =>
 139               Make_Constrained_Array_Definition (Loc,
 140                 Discrete_Subtype_Definitions => New_List (
 141                   Make_Range (Loc,
 142                     Low_Bound  => Make_Integer_Literal (Loc, 0),
 143                     High_Bound => Make_Integer_Literal (Loc, Nlit))),
 144                 Subtype_Indication => New_Occurrence_Of (Ityp, Loc)),
 145
 146             Expression          =>
 147               Make_Aggregate (Loc,
 148                 Expressions => Ind))),
 149         Suppress => All_Checks);
 150
 151    end Build_Enumeration_Image_Tables;
 152
 153    ----------------------------
 154    -- Expand_Image_Attribute --
 155    ----------------------------
 156
 157    --  For all non-enumeration types, and for enumeration types declared
 158    --  in packages Standard or System, typ'Image (Val) expands into:
 159
 160    --     Image_xx (tp (Expr) [, pm])
 161
 162    --  The name xx and type conversion tp (Expr) (called tv below) depend on
 163    --  the root type of Expr. The argument pm is an extra type dependent
 164    --  parameter only used in some cases as follows:
 165
 166    --    For types whose root type is Character
 167    --      xx = Character
 168    --      tv = Character (Expr)
 169
 170    --    For types whose root type is Boolean
 171    --      xx = Boolean
 172    --      tv = Boolean (Expr)
 173
 174    --    For signed integer types with size <= Integer'Size
 175    --      xx = Integer
 176    --      tv = Integer (Expr)
 177
 178    --    For other signed integer types
 179    --      xx = Long_Long_Integer
 180    --      tv = Long_Long_Integer (Expr)
 181
 182    --    For modular types with modulus <= System.Unsigned_Types.Unsigned
 183    --      xx = Unsigned
 184    --      tv = System.Unsigned_Types.Unsigned (Expr)
 185
 186    --    For other modular integer types
 187    --      xx = Long_Long_Unsigned
 188    --      tv = System.Unsigned_Types.Long_Long_Unsigned (Expr)
 189
 190    --    For types whose root type is Wide_Character
 191    --      xx = Wide_Character
 192    --      tv = Wide_Character (Expr)
 193    --      pm = Wide_Character_Encoding_Method
 194
 195    --    For floating-point types
 196    --      xx = Floating_Point
 197    --      tv = Long_Long_Float (Expr)
 198    --      pm = typ'Digits
 199
 200    --    For ordinary fixed-point types
 201    --      xx = Ordinary_Fixed_Point
 202    --      tv = Long_Long_Float (Expr)
 203    --      pm = typ'Aft
 204
 205    --    For decimal fixed-point types with size = Integer'Size
 206    --      xx = Decimal
 207    --      tv = Integer (Expr)
 208    --      pm = typ'Scale
 209
 210    --    For decimal fixed-point types with size > Integer'Size
 211    --      xx = Long_Long_Decimal
 212    --      tv = Long_Long_Integer (Expr)
 213    --      pm = typ'Scale
 214
 215    --    Note: for the decimal fixed-point type cases, the conversion is
 216    --    done literally without scaling (i.e. the actual expression that
 217    --    is generated is Image_xx (tp?(Expr) [, pm])
 218
 219    --  For enumeration types other than those declared packages Standard
 220    --  or System, typ'Image (X) expands into:
 221
 222    --    Image_Enumeration_NN (typ'Pos (X), typS, typI'Address)
 223
 224    --  where typS and typI are the entities constructed as described in
 225    --  the spec for the procedure Build_Enumeration_Image_Tables and NN
 226    --  is 32/16/8 depending on the element type of Lit_Indexes.
 227
 228    procedure Expand_Image_Attribute (N : Node_Id) is
 229       Loc      : constant Source_Ptr := Sloc (N);
 230       Exprs    : constant List_Id    := Expressions (N);
 231       Pref     : constant Node_Id    := Prefix (N);
 232       Ptyp     : constant Entity_Id  := Entity (Pref);
 233       Rtyp     : constant Entity_Id  := Root_Type (Ptyp);
 234       Expr     : constant Node_Id    := Relocate_Node (First (Exprs));
 235       Imid     : RE_Id;
 236       Tent     : Entity_Id;
 237       Arglist  : List_Id;
 238       Func     : RE_Id;
 239       Ttyp     : Entity_Id;
 240       Func_Ent : Entity_Id;
 241
 242    begin
 243       if Rtyp = Standard_Boolean then
 244          Imid := RE_Image_Boolean;
 245          Tent := Rtyp;
 246
 247       elsif Rtyp = Standard_Character then
 248          Imid := RE_Image_Character;
 249          Tent := Rtyp;
 250
 251       elsif Rtyp = Standard_Wide_Character then
 252          Imid := RE_Image_Wide_Character;
 253          Tent := Rtyp;
 254
 255       elsif Is_Signed_Integer_Type (Rtyp) then
 256          if Esize (Rtyp) <= Esize (Standard_Integer) then
 257             Imid := RE_Image_Integer;
 258             Tent := Standard_Integer;
 259          else
 260             Imid := RE_Image_Long_Long_Integer;
 261             Tent := Standard_Long_Long_Integer;
 262          end if;
 263
 264       elsif Is_Modular_Integer_Type (Rtyp) then
 265          if Modulus (Rtyp) <= Modulus (RTE (RE_Unsigned)) then
 266             Imid := RE_Image_Unsigned;
 267             Tent := RTE (RE_Unsigned);
 268          else
 269             Imid := RE_Image_Long_Long_Unsigned;
 270             Tent := RTE (RE_Long_Long_Unsigned);
 271          end if;
 272
 273       elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
 274          if UI_To_Int (Esize (Rtyp)) <= Standard_Integer_Size then
 275             Imid := RE_Image_Decimal;
 276             Tent := Standard_Integer;
 277          else
 278             Imid := RE_Image_Long_Long_Decimal;
 279             Tent := Standard_Long_Long_Integer;
 280          end if;
 281
 282       elsif Is_Ordinary_Fixed_Point_Type (Rtyp) then
 283          Imid := RE_Image_Ordinary_Fixed_Point;
 284          Tent := Standard_Long_Long_Float;
 285
 286       elsif Is_Floating_Point_Type (Rtyp) then
 287          Imid := RE_Image_Floating_Point;
 288          Tent := Standard_Long_Long_Float;
 289
 290       --  Only other possibility is user defined enumeration type
 291
 292       else
 293          if Discard_Names (First_Subtype (Ptyp))
 294            or else No (Lit_Strings (Root_Type (Ptyp)))
 295          then
 296             --  When pragma Discard_Names applies to the first subtype,
 297             --  then build (Pref'Pos)'Img.
 298
 299             Rewrite (N,
 300               Make_Attribute_Reference (Loc,
 301                 Prefix =>
 302                    Make_Attribute_Reference (Loc,
 303                      Prefix         => Pref,
 304                      Attribute_Name => Name_Pos,
 305                      Expressions    => New_List (Expr)),
 306                 Attribute_Name =>
 307                   Name_Img));
 308             Analyze_And_Resolve (N, Standard_String);
 309
 310          else
 311             --  Here we get the Image of an enumeration type
 312
 313             Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
 314
 315             if Ttyp = Standard_Integer_8 then
 316                Func := RE_Image_Enumeration_8;
 317             elsif Ttyp = Standard_Integer_16  then
 318                Func := RE_Image_Enumeration_16;
 319             else
 320                Func := RE_Image_Enumeration_32;
 321             end if;
 322
 323             --  Apply a validity check, since it is a bit drastic to
 324             --  get a completely junk image value for an invalid value.
 325
 326             if not Expr_Known_Valid (Expr) then
 327                Insert_Valid_Check (Expr);
 328             end if;
 329
 330             Rewrite (N,
 331               Make_Function_Call (Loc,
 332                 Name => New_Occurrence_Of (RTE (Func), Loc),
 333                 Parameter_Associations => New_List (
 334                   Make_Attribute_Reference (Loc,
 335                     Attribute_Name => Name_Pos,
 336                     Prefix         => New_Occurrence_Of (Ptyp, Loc),
 337                     Expressions    => New_List (Expr)),
 338                   New_Occurrence_Of (Lit_Strings (Rtyp), Loc),
 339                   Make_Attribute_Reference (Loc,
 340                     Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
 341                     Attribute_Name => Name_Address))));
 342
 343             Analyze_And_Resolve (N, Standard_String);
 344          end if;
 345
 346          return;
 347       end if;
 348
 349       --  If we fall through, we have one of the cases that is handled by
 350       --  calling one of the System.Img_xx routines and Imid is set to the
 351       --  RE_Id for the function to be called.
 352
 353       Func_Ent := RTE (Imid);
 354
 355       --  If the function entity is empty, that means we have a case in
 356       --  no run time mode where the operation is not allowed, and an
 357       --  appropriate diagnostic has already been issued.
 358
 359       if No (Func_Ent) then
 360          return;
 361       end if;
 362
 363       --  Otherwise prepare arguments for run-time call
 364
 365       Arglist := New_List (Convert_To (Tent, Relocate_Node (Expr)));
 366
 367       --  For floating-point types, append Digits argument
 368
 369       if Is_Floating_Point_Type (Rtyp) then
 370          Append_To (Arglist,
 371            Make_Attribute_Reference (Loc,
 372              Prefix         => New_Reference_To (Ptyp, Loc),
 373              Attribute_Name => Name_Digits));
 374
 375       --  For ordinary fixed-point types, append Aft parameter
 376
 377       elsif Is_Ordinary_Fixed_Point_Type (Rtyp) then
 378          Append_To (Arglist,
 379            Make_Attribute_Reference (Loc,
 380              Prefix         => New_Reference_To (Ptyp, Loc),
 381              Attribute_Name => Name_Aft));
 382
 383       --  For wide character, append encoding method
 384
 385       elsif Rtyp = Standard_Wide_Character then
 386          Append_To (Arglist,
 387            Make_Integer_Literal (Loc,
 388              Intval => Int (Wide_Character_Encoding_Method)));
 389
 390       --  For decimal, append Scale and also set to do literal conversion
 391
 392       elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
 393          Append_To (Arglist,
 394            Make_Attribute_Reference (Loc,
 395              Prefix => New_Reference_To (Ptyp, Loc),
 396              Attribute_Name => Name_Scale));
 397
 398          Set_Conversion_OK (First (Arglist));
 399          Set_Etype (First (Arglist), Tent);
 400       end if;
 401
 402       Rewrite (N,
 403         Make_Function_Call (Loc,
 404           Name => New_Reference_To (Func_Ent, Loc),
 405           Parameter_Associations => Arglist));
 406
 407       Analyze_And_Resolve (N, Standard_String);
 408    end Expand_Image_Attribute;
 409
 410    ----------------------------
 411    -- Expand_Value_Attribute --
 412    ----------------------------
 413
 414    --  For scalar types derived from Boolean, Character and integer types
 415    --  in package Standard, typ'Value (X) expands into:
 416
 417    --    btyp (Value_xx (X))
 418
 419    --  where btyp is he base type of the prefix, and
 420
 421    --    For types whose root type is Character
 422    --      xx = Character
 423
 424    --    For types whose root type is Boolean
 425    --      xx = Boolean
 426
 427    --    For signed integer types with size <= Integer'Size
 428    --      xx = Integer
 429
 430    --    For other signed integer types
 431    --      xx = Long_Long_Integer
 432
 433    --    For modular types with modulus <= System.Unsigned_Types.Unsigned
 434    --      xx = Unsigned
 435
 436    --    For other modular integer types
 437    --      xx = Long_Long_Unsigned
 438
 439    --    For floating-point types and ordinary fixed-point types
 440    --      xx = Real
 441
 442    --  For types derived from Wide_Character, typ'Value (X) expands into
 443
 444    --    Value_Wide_Character (X, Wide_Character_Encoding_Method)
 445
 446    --  For decimal types with size <= Integer'Size, typ'Value (X)
 447    --  expands into
 448
 449    --    btyp?(Value_Decimal (X, typ'Scale));
 450
 451    --  For all other decimal types, typ'Value (X) expands into
 452
 453    --    btyp?(Value_Long_Long_Decimal (X, typ'Scale))
 454
 455    --  For enumeration types other than those derived from types Boolean,
 456    --  Character, and Wide_Character in Standard, typ'Value (X) expands to:
 457
 458    --    Enum'Val (Value_Enumeration_NN (typS, typI'Address, Num, X))
 459
 460    --  where typS and typI and the Lit_Strings and Lit_Indexes entities
 461    --  from T's root type entitym and Num is Enum'Pos (Enum'Last). The
 462    --  Value_Enumeration_NN function will search the tables looking for
 463    --  X and return the position number in the table if found which is
 464    --  used to provide the result of 'Value (using Enum'Val). If the
 465    --  value is not found Constraint_Error is raised. The suffix _NN
 466    --  depends on the element type of typI.
 467
 468    procedure Expand_Value_Attribute (N : Node_Id) is
 469       Loc   : constant Source_Ptr := Sloc (N);
 470       Typ   : constant Entity_Id  := Etype (N);
 471       Btyp  : constant Entity_Id  := Base_Type (Typ);
 472       Rtyp  : constant Entity_Id  := Root_Type (Typ);
 473       Exprs : constant List_Id    := Expressions (N);
 474       Vid   : RE_Id;
 475       Args  : List_Id;
 476       Func  : RE_Id;
 477       Ttyp  : Entity_Id;
 478
 479    begin
 480       Args := Exprs;
 481
 482       if Rtyp = Standard_Character then
 483          Vid := RE_Value_Character;
 484
 485       elsif Rtyp = Standard_Boolean then
 486          Vid := RE_Value_Boolean;
 487
 488       elsif Rtyp = Standard_Wide_Character then
 489          Vid := RE_Value_Wide_Character;
 490          Append_To (Args,
 491            Make_Integer_Literal (Loc,
 492              Intval => Int (Wide_Character_Encoding_Method)));
 493
 494       elsif     Rtyp = Base_Type (Standard_Short_Short_Integer)
 495         or else Rtyp = Base_Type (Standard_Short_Integer)
 496         or else Rtyp = Base_Type (Standard_Integer)
 497       then
 498          Vid := RE_Value_Integer;
 499
 500       elsif Is_Signed_Integer_Type (Rtyp) then
 501          Vid := RE_Value_Long_Long_Integer;
 502
 503       elsif Is_Modular_Integer_Type (Rtyp) then
 504          if Modulus (Rtyp) <= Modulus (RTE (RE_Unsigned)) then
 505             Vid := RE_Value_Unsigned;
 506          else
 507             Vid := RE_Value_Long_Long_Unsigned;
 508          end if;
 509
 510       elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
 511          if UI_To_Int (Esize (Rtyp)) <= Standard_Integer_Size then
 512             Vid := RE_Value_Decimal;
 513          else
 514             Vid := RE_Value_Long_Long_Decimal;
 515          end if;
 516
 517          Append_To (Args,
 518            Make_Attribute_Reference (Loc,
 519              Prefix => New_Reference_To (Typ, Loc),
 520              Attribute_Name => Name_Scale));
 521
 522          Rewrite (N,
 523            OK_Convert_To (Btyp,
 524              Make_Function_Call (Loc,
 525                Name => New_Reference_To (RTE (Vid), Loc),
 526                Parameter_Associations => Args)));
 527
 528          Set_Etype (N, Btyp);
 529          Analyze_And_Resolve (N, Btyp);
 530          return;
 531
 532       elsif Is_Real_Type (Rtyp) then
 533          Vid := RE_Value_Real;
 534
 535       --  Only other possibility is user defined enumeration type
 536
 537       else
 538          pragma Assert (Is_Enumeration_Type (Rtyp));
 539
 540          --  Case of pragma Discard_Names, transform the Value
 541          --  attribute to Btyp'Val (Long_Long_Integer'Value (Args))
 542
 543          if Discard_Names (First_Subtype (Typ))
 544            or else No (Lit_Strings (Rtyp))
 545          then
 546             Rewrite (N,
 547               Make_Attribute_Reference (Loc,
 548                 Prefix => New_Reference_To (Btyp, Loc),
 549                 Attribute_Name => Name_Val,
 550                 Expressions => New_List (
 551                   Make_Attribute_Reference (Loc,
 552                     Prefix =>
 553                       New_Occurrence_Of (Standard_Long_Long_Integer, Loc),
 554                     Attribute_Name => Name_Value,
 555                     Expressions => Args))));
 556
 557             Analyze_And_Resolve (N, Btyp);
 558
 559          --  Here for normal case where we have enumeration tables, this
 560          --  is where we build
 561
 562          --    T'Val (Value_Enumeration_NN (typS, typI'Address, Num, X))
 563
 564          else
 565             Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
 566
 567             if Ttyp = Standard_Integer_8 then
 568                Func := RE_Value_Enumeration_8;
 569             elsif Ttyp = Standard_Integer_16  then
 570                Func := RE_Value_Enumeration_16;
 571             else
 572                Func := RE_Value_Enumeration_32;
 573             end if;
 574
 575             Prepend_To (Args,
 576               Make_Attribute_Reference (Loc,
 577                 Prefix => New_Occurrence_Of (Rtyp, Loc),
 578                 Attribute_Name => Name_Pos,
 579                 Expressions => New_List (
 580                   Make_Attribute_Reference (Loc,
 581                     Prefix => New_Occurrence_Of (Rtyp, Loc),
 582                     Attribute_Name => Name_Last))));
 583
 584             Prepend_To (Args,
 585               Make_Attribute_Reference (Loc,
 586                 Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
 587                 Attribute_Name => Name_Address));
 588
 589             Prepend_To (Args,
 590               New_Occurrence_Of (Lit_Strings (Rtyp), Loc));
 591
 592             Rewrite (N,
 593               Make_Attribute_Reference (Loc,
 594                 Prefix => New_Reference_To (Typ, Loc),
 595                 Attribute_Name => Name_Val,
 596                 Expressions => New_List (
 597                   Make_Function_Call (Loc,
 598                     Name =>
 599                       New_Reference_To (RTE (Func), Loc),
 600                     Parameter_Associations => Args))));
 601
 602             Analyze_And_Resolve (N, Btyp);
 603          end if;
 604
 605          return;
 606       end if;
 607
 608       --  Fall through for all cases except user defined enumeration type
 609       --  and decimal types, with Vid set to the Id of the entity for the
 610       --  Value routine and Args set to the list of parameters for the call.
 611
 612       Rewrite (N,
 613         Convert_To (Btyp,
 614           Make_Function_Call (Loc,
 615             Name => New_Reference_To (RTE (Vid), Loc),
 616             Parameter_Associations => Args)));
 617
 618       Analyze_And_Resolve (N, Btyp);
 619    end Expand_Value_Attribute;
 620
 621    ----------------------------
 622    -- Expand_Width_Attribute --
 623    ----------------------------
 624
 625    --  The processing here also handles the case of Wide_Width. With the
 626    --  exceptions noted, the processing is identical
 627
 628    --  For scalar types derived from Boolean, character and integer types
 629    --  in package Standard. Note that the Width attribute is computed at
 630    --  compile time for all cases except those involving non-static sub-
 631    --  types. For such subtypes, typ'Width and typ'Wide_Width expands into:
 632
 633    --    Result_Type (xx (yy (Ptyp'First), yy (Ptyp'Last)))
 634
 635    --  where
 636
 637    --    For types whose root type is Character
 638    --      xx = Width_Character (Wide_Width_Character for Wide_Width case)
 639    --      yy = Character
 640
 641    --    For types whose root type is Boolean
 642    --      xx = Width_Boolean
 643    --      yy = Boolean
 644
 645    --    For signed integer types
 646    --      xx = Width_Long_Long_Integer
 647    --      yy = Long_Long_Integer
 648
 649    --    For modular integer types
 650    --      xx = Width_Long_Long_Unsigned
 651    --      yy = Long_Long_Unsigned
 652
 653    --  For types derived from Wide_Character, typ'Width expands into
 654
 655    --    Result_Type (Width_Wide_Character (
 656    --      Wide_Character (typ'First),
 657    --      Wide_Character (typ'Last),
 658    --      Wide_Character_Encoding_Method);
 659
 660    --  and typ'Wide_Width expands into:
 661
 662    --    Result_Type (Wide_Width_Wide_Character (
 663    --      Wide_Character (typ'First),
 664    --      Wide_Character (typ'Last));
 665
 666    --  For real types, typ'Width and typ'Wide_Width expand into
 667
 668    --    if Ptyp'First > Ptyp'Last then 0 else btyp'Width end if
 669
 670    --  where btyp is the base type. This looks recursive but it isn't
 671    --  because the base type is always static, and hence the expression
 672    --  in the else is reduced to an integer literal.
 673
 674    --  For user defined enumeration types, typ'Width expands into
 675
 676    --    Result_Type (Width_Enumeration_NN
 677    --                  (typS,
 678    --                   typI'Address,
 679    --                   typ'Pos (typ'First),
 680    --                   typ'Pos (Typ'Last)));
 681
 682    --  and typ'Wide_Width expands into:
 683
 684    --    Result_Type (Wide_Width_Enumeration_NN
 685    --                  (typS,
 686    --                   typI,
 687    --                   typ'Pos (typ'First),
 688    --                   typ'Pos (Typ'Last))
 689    --                   Wide_Character_Encoding_Method);
 690
 691    --  where typS and typI are the enumeration image strings and
 692    --  indexes table, as described in Build_Enumeration_Image_Tables.
 693    --  NN is 8/16/32 for depending on the element type for typI.
 694
 695    procedure Expand_Width_Attribute (N : Node_Id; Wide : Boolean) is
 696       Loc     : constant Source_Ptr := Sloc (N);
 697       Typ     : constant Entity_Id  := Etype (N);
 698       Pref    : constant Node_Id    := Prefix (N);
 699       Ptyp    : constant Entity_Id  := Etype (Pref);
 700       Rtyp    : constant Entity_Id  := Root_Type (Ptyp);
 701       XX      : RE_Id;
 702       YY      : Entity_Id;
 703       Arglist : List_Id;
 704       Ttyp    : Entity_Id;
 705
 706    begin
 707       --  Types derived from Standard.Boolean
 708
 709       if Rtyp = Standard_Boolean then
 710          XX := RE_Width_Boolean;
 711          YY := Rtyp;
 712
 713       --  Types derived from Standard.Character
 714
 715       elsif Rtyp = Standard_Character then
 716          if not Wide then
 717             XX := RE_Width_Character;
 718          else
 719             XX := RE_Wide_Width_Character;
 720          end if;
 721
 722          YY := Rtyp;
 723
 724       --  Types derived from Standard.Wide_Character
 725
 726       elsif Rtyp = Standard_Wide_Character then
 727          if not Wide then
 728             XX := RE_Width_Wide_Character;
 729          else
 730             XX := RE_Wide_Width_Wide_Character;
 731          end if;
 732
 733          YY := Rtyp;
 734
 735       --  Signed integer types
 736
 737       elsif Is_Signed_Integer_Type (Rtyp) then
 738          XX := RE_Width_Long_Long_Integer;
 739          YY := Standard_Long_Long_Integer;
 740
 741       --  Modular integer types
 742
 743       elsif Is_Modular_Integer_Type (Rtyp) then
 744          XX := RE_Width_Long_Long_Unsigned;
 745          YY := RTE (RE_Long_Long_Unsigned);
 746
 747       --  Real types
 748
 749       elsif Is_Real_Type (Rtyp) then
 750
 751          Rewrite (N,
 752            Make_Conditional_Expression (Loc,
 753              Expressions => New_List (
 754
 755                Make_Op_Gt (Loc,
 756                  Left_Opnd =>
 757                    Make_Attribute_Reference (Loc,
 758                      Prefix => New_Reference_To (Ptyp, Loc),
 759                      Attribute_Name => Name_First),
 760
 761                  Right_Opnd =>
 762                    Make_Attribute_Reference (Loc,
 763                      Prefix => New_Reference_To (Ptyp, Loc),
 764                      Attribute_Name => Name_Last)),
 765
 766                Make_Integer_Literal (Loc, 0),
 767
 768                Make_Attribute_Reference (Loc,
 769                  Prefix => New_Reference_To (Base_Type (Ptyp), Loc),
 770                  Attribute_Name => Name_Width))));
 771
 772          Analyze_And_Resolve (N, Typ);
 773          return;
 774
 775       --  User defined enumeration types
 776
 777       else
 778          pragma Assert (Is_Enumeration_Type (Rtyp));
 779
 780          Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
 781
 782          if not Wide then
 783             if Ttyp = Standard_Integer_8 then
 784                XX := RE_Width_Enumeration_8;
 785             elsif Ttyp = Standard_Integer_16  then
 786                XX := RE_Width_Enumeration_16;
 787             else
 788                XX := RE_Width_Enumeration_32;
 789             end if;
 790
 791          else
 792             if Ttyp = Standard_Integer_8 then
 793                XX := RE_Wide_Width_Enumeration_8;
 794             elsif Ttyp = Standard_Integer_16  then
 795                XX := RE_Wide_Width_Enumeration_16;
 796             else
 797                XX := RE_Wide_Width_Enumeration_32;
 798             end if;
 799          end if;
 800
 801          Arglist :=
 802            New_List (
 803              New_Occurrence_Of (Lit_Strings (Rtyp), Loc),
 804
 805              Make_Attribute_Reference (Loc,
 806                Prefix => New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
 807                Attribute_Name => Name_Address),
 808
 809              Make_Attribute_Reference (Loc,
 810                Prefix => New_Reference_To (Ptyp, Loc),
 811                Attribute_Name => Name_Pos,
 812
 813                Expressions => New_List (
 814                  Make_Attribute_Reference (Loc,
 815                    Prefix => New_Reference_To (Ptyp, Loc),
 816                    Attribute_Name => Name_First))),
 817
 818              Make_Attribute_Reference (Loc,
 819                Prefix => New_Reference_To (Ptyp, Loc),
 820                Attribute_Name => Name_Pos,
 821
 822                Expressions => New_List (
 823                  Make_Attribute_Reference (Loc,
 824                    Prefix => New_Reference_To (Ptyp, Loc),
 825                    Attribute_Name => Name_Last))));
 826
 827          --  For enumeration'Wide_Width, add encoding method parameter
 828
 829          if Wide then
 830             Append_To (Arglist,
 831               Make_Integer_Literal (Loc,
 832                 Intval => Int (Wide_Character_Encoding_Method)));
 833          end if;
 834
 835          Rewrite (N,
 836            Convert_To (Typ,
 837              Make_Function_Call (Loc,
 838                Name => New_Reference_To (RTE (XX), Loc),
 839                Parameter_Associations => Arglist)));
 840
 841          Analyze_And_Resolve (N, Typ);
 842          return;
 843       end if;
 844
 845       --  If we fall through XX and YY are set
 846
 847       Arglist := New_List (
 848         Convert_To (YY,
 849           Make_Attribute_Reference (Loc,
 850             Prefix => New_Reference_To (Ptyp, Loc),
 851             Attribute_Name => Name_First)),
 852
 853         Convert_To (YY,
 854           Make_Attribute_Reference (Loc,
 855             Prefix => New_Reference_To (Ptyp, Loc),
 856             Attribute_Name => Name_Last)));
 857
 858       --  For Wide_Character'Width, add encoding method parameter
 859
 860       if Rtyp = Standard_Wide_Character and then Wide then
 861          Append_To (Arglist,
 862            Make_Integer_Literal (Loc,
 863              Intval => Int (Wide_Character_Encoding_Method)));
 864       end if;
 865
 866       Rewrite (N,
 867         Convert_To (Typ,
 868           Make_Function_Call (Loc,
 869             Name => New_Reference_To (RTE (XX), Loc),
 870             Parameter_Associations => Arglist)));
 871
 872       Analyze_And_Resolve (N, Typ);
 873    end Expand_Width_Attribute;
 874
 875 end Exp_Imgv;