gcc/ada/repinfo.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              R E P I N F O                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.1 $
  10 --                                                                          --
  11 --          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- As a special exception,  if other files  instantiate  generics from this --
  25 -- unit, or you link  this unit with other files  to produce an executable, --
  26 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27 -- covered  by the  GNU  General  Public  License.  This exception does not --
  28 -- however invalidate  any other reasons why  the executable file  might be --
  29 -- covered by the  GNU Public License.                                      --
  30 --                                                                          --
  31 -- GNAT was originally developed  by the GNAT team at  New York University. --
  32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  33 --                                                                          --
  34 ------------------------------------------------------------------------------
  35
  36 with Alloc;    use Alloc;
  37 with Atree;    use Atree;
  38 with Casing;   use Casing;
  39 with Debug;    use Debug;
  40 with Einfo;    use Einfo;
  41 with Lib;      use Lib;
  42 with Namet;    use Namet;
  43 with Opt;      use Opt;
  44 with Output;   use Output;
  45 with Sinfo;    use Sinfo;
  46 with Sinput;   use Sinput;
  47 with Table;    use Table;
  48 with Uname;    use Uname;
  49 with Urealp;   use Urealp;
  50
  51 package body Repinfo is
  52
  53    SSU : constant := 8;
  54    --  Value for Storage_Unit, we do not want to get this from TTypes, since
  55    --  this introduces problematic dependencies in ASIS, and in any case this
  56    --  value is assumed to be 8 for the implementation of the DDA.
  57    --  This is wrong for AAMP???
  58
  59    ---------------------------------------
  60    -- Representation of gcc Expressions --
  61    ---------------------------------------
  62
  63    --    This table is used only if Frontend_Layout_On_Target is False,
  64    --    so that gigi lays out dynamic size/offset fields using encoded
  65    --    gcc expressions.
  66
  67    --    A table internal to this unit is used to hold the values of
  68    --    back annotated expressions. This table is written out by -gnatt
  69    --    and read back in for ASIS processing.
  70
  71    --    Node values are stored as Uint values which are the negative of
  72    --    the node index in this table. Constants appear as non-negative
  73    --    Uint values.
  74
  75    type Exp_Node is record
  76       Expr : TCode;
  77       Op1  : Node_Ref_Or_Val;
  78       Op2  : Node_Ref_Or_Val;
  79       Op3  : Node_Ref_Or_Val;
  80    end record;
  81
  82    package Rep_Table is new Table.Table (
  83       Table_Component_Type => Exp_Node,
  84       Table_Index_Type     => Nat,
  85       Table_Low_Bound      => 1,
  86       Table_Initial        => Alloc.Rep_Table_Initial,
  87       Table_Increment      => Alloc.Rep_Table_Increment,
  88       Table_Name           => "BE_Rep_Table");
  89
  90    --------------------------------------------------------------
  91    -- Representation of Front-End Dynamic Size/Offset Entities --
  92    --------------------------------------------------------------
  93
  94    package Dynamic_SO_Entity_Table is new Table.Table (
  95       Table_Component_Type => Entity_Id,
  96       Table_Index_Type     => Nat,
  97       Table_Low_Bound      => 1,
  98       Table_Initial        => Alloc.Rep_Table_Initial,
  99       Table_Increment      => Alloc.Rep_Table_Increment,
 100       Table_Name           => "FE_Rep_Table");
 101
 102    -----------------------
 103    -- Local Subprograms --
 104    -----------------------
 105
 106    Unit_Casing : Casing_Type;
 107    --  Identifier casing for current unit
 108
 109    procedure Spaces (N : Natural);
 110    --  Output given number of spaces
 111
 112    function Back_End_Layout return Boolean;
 113    --  Test for layout mode, True = back end, False = front end. This
 114    --  function is used rather than checking the configuration parameter
 115    --  because we do not want Repinfo to depend on Targparm (for ASIS)
 116
 117    procedure List_Entities (Ent : Entity_Id);
 118    --  This procedure lists the entities associated with the entity E,
 119    --  starting with the First_Entity and using the Next_Entity link.
 120    --  If a nested package is found, entities within the package are
 121    --  recursively processed.
 122
 123    procedure List_Name (Ent : Entity_Id);
 124    --  List name of entity Ent in appropriate case. The name is listed with
 125    --  full qualification up to but not including the compilation unit name.
 126
 127    procedure List_Array_Info (Ent : Entity_Id);
 128    --  List representation info for array type Ent
 129
 130    procedure List_Object_Info (Ent : Entity_Id);
 131    --  List representation info for object Ent
 132
 133    procedure List_Record_Info (Ent : Entity_Id);
 134    --  List representation info for record type Ent
 135
 136    procedure List_Type_Info (Ent : Entity_Id);
 137    --  List type info for type Ent
 138
 139    function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean;
 140    --  Returns True if Val represents a variable value, and False if it
 141    --  represents a value that is fixed at compile time.
 142
 143    procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False);
 144    --  Given a representation value, write it out. No_Uint values or values
 145    --  dependent on discriminants are written as two question marks. If the
 146    --  flag Paren is set, then the output is surrounded in parentheses if
 147    --  it is other than a simple value.
 148
 149    ---------------------
 150    -- Back_End_Layout --
 151    ---------------------
 152
 153    function Back_End_Layout return Boolean is
 154    begin
 155       --  We have back end layout if the back end has made any entries in
 156       --  the table of GCC expressions, otherwise we have front end layout.
 157
 158       return Rep_Table.Last > 0;
 159    end Back_End_Layout;
 160
 161    ------------------------
 162    -- Create_Discrim_Ref --
 163    ------------------------
 164
 165    function Create_Discrim_Ref
 166      (Discr : Entity_Id)
 167       return  Node_Ref
 168    is
 169       N : constant Uint := Discriminant_Number (Discr);
 170       T : Nat;
 171
 172    begin
 173       Rep_Table.Increment_Last;
 174       T := Rep_Table.Last;
 175       Rep_Table.Table (T).Expr := Discrim_Val;
 176       Rep_Table.Table (T).Op1  := N;
 177       Rep_Table.Table (T).Op2  := No_Uint;
 178       Rep_Table.Table (T).Op3  := No_Uint;
 179       return UI_From_Int (-T);
 180    end Create_Discrim_Ref;
 181
 182    ---------------------------
 183    -- Create_Dynamic_SO_Ref --
 184    ---------------------------
 185
 186    function Create_Dynamic_SO_Ref
 187      (E    : Entity_Id)
 188       return Dynamic_SO_Ref
 189    is
 190       T : Nat;
 191
 192    begin
 193       Dynamic_SO_Entity_Table.Increment_Last;
 194       T := Dynamic_SO_Entity_Table.Last;
 195       Dynamic_SO_Entity_Table.Table (T) := E;
 196       return UI_From_Int (-T);
 197    end Create_Dynamic_SO_Ref;
 198
 199    -----------------
 200    -- Create_Node --
 201    -----------------
 202
 203    function Create_Node
 204      (Expr : TCode;
 205       Op1  : Node_Ref_Or_Val;
 206       Op2  : Node_Ref_Or_Val := No_Uint;
 207       Op3  : Node_Ref_Or_Val := No_Uint)
 208       return  Node_Ref
 209    is
 210       T : Nat;
 211
 212    begin
 213       Rep_Table.Increment_Last;
 214       T := Rep_Table.Last;
 215       Rep_Table.Table (T).Expr := Expr;
 216       Rep_Table.Table (T).Op1  := Op1;
 217       Rep_Table.Table (T).Op2  := Op2;
 218       Rep_Table.Table (T).Op3  := Op3;
 219
 220       return UI_From_Int (-T);
 221    end Create_Node;
 222
 223    ---------------------------
 224    -- Get_Dynamic_SO_Entity --
 225    ---------------------------
 226
 227    function Get_Dynamic_SO_Entity
 228      (U    : Dynamic_SO_Ref)
 229       return Entity_Id
 230    is
 231    begin
 232       return Dynamic_SO_Entity_Table.Table (-UI_To_Int (U));
 233    end Get_Dynamic_SO_Entity;
 234
 235    -----------------------
 236    -- Is_Dynamic_SO_Ref --
 237    -----------------------
 238
 239    function Is_Dynamic_SO_Ref (U : SO_Ref) return Boolean is
 240    begin
 241       return U < Uint_0;
 242    end Is_Dynamic_SO_Ref;
 243
 244    ----------------------
 245    -- Is_Static_SO_Ref --
 246    ----------------------
 247
 248    function Is_Static_SO_Ref (U : SO_Ref) return Boolean is
 249    begin
 250       return U >= Uint_0;
 251    end Is_Static_SO_Ref;
 252
 253    ---------
 254    -- lgx --
 255    ---------
 256
 257    procedure lgx (U : Node_Ref_Or_Val) is
 258    begin
 259       List_GCC_Expression (U);
 260       Write_Eol;
 261    end lgx;
 262
 263    ----------------------
 264    -- List_Array_Info --
 265    ----------------------
 266
 267    procedure List_Array_Info (Ent : Entity_Id) is
 268    begin
 269       List_Type_Info (Ent);
 270
 271       Write_Str ("for ");
 272       List_Name (Ent);
 273       Write_Str ("'Component_Size use ");
 274       Write_Val (Component_Size (Ent));
 275       Write_Line (";");
 276    end List_Array_Info;
 277
 278    -------------------
 279    -- List_Entities --
 280    -------------------
 281
 282    procedure List_Entities (Ent : Entity_Id) is
 283       E : Entity_Id;
 284
 285    begin
 286       if Present (Ent) then
 287          E := First_Entity (Ent);
 288          while Present (E) loop
 289             if Comes_From_Source (E) or else Debug_Flag_AA then
 290
 291                if Is_Record_Type (E) then
 292                   List_Record_Info (E);
 293
 294                elsif Is_Array_Type (E) then
 295                   List_Array_Info (E);
 296
 297                elsif List_Representation_Info >= 2 then
 298
 299                   if Is_Type (E) then
 300                      List_Type_Info (E);
 301
 302                   elsif Ekind (E) = E_Variable
 303                           or else
 304                         Ekind (E) = E_Constant
 305                           or else
 306                         Ekind (E) = E_Loop_Parameter
 307                           or else
 308                         Is_Formal (E)
 309                   then
 310                      List_Object_Info (E);
 311                   end if;
 312                end if;
 313
 314                --  Recurse over nested package, but not if they are
 315                --  package renamings (in particular renamings of the
 316                --  enclosing package, as for some Java bindings and
 317                --  for generic instances).
 318
 319                if (Ekind (E) = E_Package
 320                          and then No (Renamed_Object (E)))
 321                        or else
 322                      Ekind (E) = E_Protected_Type
 323                        or else
 324                      Ekind (E) = E_Task_Type
 325                        or else
 326                      Ekind (E) = E_Subprogram_Body
 327                        or else
 328                      Ekind (E) = E_Package_Body
 329                        or else
 330                      Ekind (E) = E_Task_Body
 331                        or else
 332                      Ekind (E) = E_Protected_Body
 333                then
 334                   List_Entities (E);
 335                end if;
 336             end if;
 337
 338             E := Next_Entity (E);
 339          end loop;
 340       end if;
 341    end List_Entities;
 342
 343    -------------------------
 344    -- List_GCC_Expression --
 345    -------------------------
 346
 347    procedure List_GCC_Expression (U : Node_Ref_Or_Val) is
 348
 349       procedure P (Val : Node_Ref_Or_Val);
 350       --  Internal recursive procedure to print expression
 351
 352       procedure P (Val : Node_Ref_Or_Val) is
 353       begin
 354          if Val >= 0 then
 355             UI_Write (Val, Decimal);
 356
 357          else
 358             declare
 359                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
 360
 361                procedure Binop (S : String);
 362                --  Output text for binary operator with S being operator name
 363
 364                procedure Binop (S : String) is
 365                begin
 366                   Write_Char ('(');
 367                   P (Node.Op1);
 368                   Write_Str (S);
 369                   P (Node.Op2);
 370                   Write_Char (')');
 371                end Binop;
 372
 373             --  Start of processing for P
 374
 375             begin
 376                case Node.Expr is
 377                   when Cond_Expr =>
 378                      Write_Str ("(if ");
 379                      P (Node.Op1);
 380                      Write_Str (" then ");
 381                      P (Node.Op2);
 382                      Write_Str (" else ");
 383                      P (Node.Op3);
 384                      Write_Str (" end)");
 385
 386                   when Plus_Expr =>
 387                      Binop (" + ");
 388
 389                   when Minus_Expr =>
 390                      Binop (" - ");
 391
 392                   when Mult_Expr =>
 393                      Binop (" * ");
 394
 395                   when Trunc_Div_Expr =>
 396                      Binop (" /t ");
 397
 398                   when Ceil_Div_Expr =>
 399                      Binop (" /c ");
 400
 401                   when Floor_Div_Expr =>
 402                      Binop (" /f ");
 403
 404                   when Trunc_Mod_Expr =>
 405                      Binop (" modt ");
 406
 407                   when Floor_Mod_Expr =>
 408                      Binop (" modf ");
 409
 410                   when Ceil_Mod_Expr =>
 411                      Binop (" modc ");
 412
 413                   when Exact_Div_Expr =>
 414                      Binop (" /e ");
 415
 416                   when Negate_Expr =>
 417                      Write_Char ('-');
 418                      P (Node.Op1);
 419
 420                   when Min_Expr =>
 421                      Binop (" min ");
 422
 423                   when Max_Expr =>
 424                      Binop (" max ");
 425
 426                   when Abs_Expr =>
 427                      Write_Str ("abs ");
 428                      P (Node.Op1);
 429
 430                   when Truth_Andif_Expr =>
 431                      Binop (" and if ");
 432
 433                   when Truth_Orif_Expr =>
 434                      Binop (" or if ");
 435
 436                   when Truth_And_Expr =>
 437                      Binop (" and ");
 438
 439                   when Truth_Or_Expr =>
 440                      Binop (" or ");
 441
 442                   when Truth_Xor_Expr =>
 443                      Binop (" xor ");
 444
 445                   when Truth_Not_Expr =>
 446                      Write_Str ("not ");
 447                      P (Node.Op1);
 448
 449                   when Lt_Expr =>
 450                      Binop (" < ");
 451
 452                   when Le_Expr =>
 453                      Binop (" <= ");
 454
 455                   when Gt_Expr =>
 456                      Binop (" > ");
 457
 458                   when Ge_Expr =>
 459                      Binop (" >= ");
 460
 461                   when Eq_Expr =>
 462                      Binop (" == ");
 463
 464                   when Ne_Expr =>
 465                      Binop (" != ");
 466
 467                   when Discrim_Val =>
 468                      Write_Char ('#');
 469                      UI_Write (Node.Op1);
 470
 471                end case;
 472             end;
 473          end if;
 474       end P;
 475
 476    --  Start of processing for List_GCC_Expression
 477
 478    begin
 479       if U = No_Uint then
 480          Write_Line ("??");
 481       else
 482          P (U);
 483       end if;
 484    end List_GCC_Expression;
 485
 486    ---------------
 487    -- List_Name --
 488    ---------------
 489
 490    procedure List_Name (Ent : Entity_Id) is
 491    begin
 492       if not Is_Compilation_Unit (Scope (Ent)) then
 493          List_Name (Scope (Ent));
 494          Write_Char ('.');
 495       end if;
 496
 497       Get_Unqualified_Decoded_Name_String (Chars (Ent));
 498       Set_Casing (Unit_Casing);
 499       Write_Str (Name_Buffer (1 .. Name_Len));
 500    end List_Name;
 501
 502    ---------------------
 503    -- List_Object_Info --
 504    ---------------------
 505
 506    procedure List_Object_Info (Ent : Entity_Id) is
 507    begin
 508       Write_Eol;
 509
 510       if Known_Esize (Ent) then
 511          Write_Str ("for ");
 512          List_Name (Ent);
 513          Write_Str ("'Size use ");
 514          Write_Val (Esize (Ent));
 515          Write_Line (";");
 516       end if;
 517
 518       if Known_Alignment (Ent) then
 519          Write_Str ("for ");
 520          List_Name (Ent);
 521          Write_Str ("'Alignment use ");
 522          Write_Val (Alignment (Ent));
 523          Write_Line (";");
 524       end if;
 525    end List_Object_Info;
 526
 527    ----------------------
 528    -- List_Record_Info --
 529    ----------------------
 530
 531    procedure List_Record_Info (Ent : Entity_Id) is
 532       Comp  : Entity_Id;
 533       Esiz  : Uint;
 534       Cfbit : Uint;
 535       Sunit : Uint;
 536
 537       Max_Name_Length : Natural;
 538       Max_Suni_Length : Natural;
 539
 540    begin
 541       List_Type_Info (Ent);
 542
 543       Write_Str ("for ");
 544       List_Name (Ent);
 545       Write_Line (" use record");
 546
 547       --  First loop finds out max line length and max starting position
 548       --  length, for the purpose of lining things up nicely.
 549
 550       Max_Name_Length := 0;
 551       Max_Suni_Length   := 0;
 552
 553       Comp := First_Entity (Ent);
 554       while Present (Comp) loop
 555          if Ekind (Comp) = E_Component
 556            or else Ekind (Comp) = E_Discriminant
 557          then
 558             Get_Decoded_Name_String (Chars (Comp));
 559             Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
 560
 561             Cfbit := Component_Bit_Offset (Comp);
 562
 563             if Rep_Not_Constant (Cfbit) then
 564                UI_Image_Length := 2;
 565
 566             else
 567                --  Complete annotation in case not done
 568
 569                Set_Normalized_Position (Comp, Cfbit / SSU);
 570                Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
 571
 572                Esiz  := Esize (Comp);
 573                Sunit := Cfbit / SSU;
 574                UI_Image (Sunit);
 575             end if;
 576
 577             if Unknown_Normalized_First_Bit (Comp) then
 578                Set_Normalized_First_Bit (Comp, Uint_0);
 579             end if;
 580
 581             Max_Suni_Length :=
 582               Natural'Max (Max_Suni_Length, UI_Image_Length);
 583          end if;
 584
 585          Comp := Next_Entity (Comp);
 586       end loop;
 587
 588       --  Second loop does actual output based on those values
 589
 590       Comp := First_Entity (Ent);
 591       while Present (Comp) loop
 592          if Ekind (Comp) = E_Component
 593            or else Ekind (Comp) = E_Discriminant
 594          then
 595             declare
 596                Esiz : constant Uint := Esize (Comp);
 597                Bofs : constant Uint := Component_Bit_Offset (Comp);
 598                Npos : constant Uint := Normalized_Position (Comp);
 599                Fbit : constant Uint := Normalized_First_Bit (Comp);
 600                Lbit : Uint;
 601
 602             begin
 603                Write_Str ("   ");
 604                Get_Decoded_Name_String (Chars (Comp));
 605                Set_Casing (Unit_Casing);
 606                Write_Str (Name_Buffer (1 .. Name_Len));
 607
 608                for J in 1 .. Max_Name_Length - Name_Len loop
 609                   Write_Char (' ');
 610                end loop;
 611
 612                Write_Str (" at ");
 613
 614                if Known_Static_Normalized_Position (Comp) then
 615                   UI_Image (Npos);
 616                   Spaces (Max_Suni_Length - UI_Image_Length);
 617                   Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
 618
 619                elsif Known_Component_Bit_Offset (Comp)
 620                  and then List_Representation_Info = 3
 621                then
 622                   Spaces (Max_Suni_Length - 2);
 623                   Write_Val (Bofs, Paren => True);
 624                   Write_Str (" / 8");
 625
 626                elsif Known_Normalized_Position (Comp)
 627                  and then List_Representation_Info = 3
 628                then
 629                   Spaces (Max_Suni_Length - 2);
 630                   Write_Val (Npos);
 631
 632                else
 633                   Write_Str ("??");
 634                end if;
 635
 636                Write_Str (" range  ");
 637                UI_Write (Fbit);
 638                Write_Str (" .. ");
 639
 640                if not Is_Dynamic_SO_Ref (Esize (Comp)) then
 641                   Lbit := Fbit + Esiz - 1;
 642
 643                   if Lbit < 10 then
 644                      Write_Char (' ');
 645                   end if;
 646
 647                   UI_Write (Lbit);
 648
 649                elsif List_Representation_Info < 3 then
 650                   Write_Str ("??");
 651
 652                else -- List_Representation >= 3
 653
 654                   Write_Val (Esiz, Paren => True);
 655
 656                   --  If in front end layout mode, then dynamic size is
 657                   --  stored in storage units, so renormalize for output
 658
 659                   if not Back_End_Layout then
 660                      Write_Str (" * ");
 661                      Write_Int (SSU);
 662                   end if;
 663
 664                   --  Add appropriate first bit offset
 665
 666                   if Fbit = 0 then
 667                      Write_Str (" - 1");
 668
 669                   elsif Fbit = 1 then
 670                      null;
 671
 672                   else
 673                      Write_Str (" + ");
 674                      Write_Int (UI_To_Int (Fbit) - 1);
 675                   end if;
 676                end if;
 677
 678                Write_Line (";");
 679             end;
 680          end if;
 681
 682          Comp := Next_Entity (Comp);
 683       end loop;
 684
 685       Write_Line ("end record;");
 686    end List_Record_Info;
 687
 688    -------------------
 689    -- List_Rep_Info --
 690    -------------------
 691
 692    procedure List_Rep_Info is
 693       Col : Nat;
 694
 695    begin
 696       for U in Main_Unit .. Last_Unit loop
 697          if In_Extended_Main_Source_Unit (Cunit_Entity (U)) then
 698             Unit_Casing := Identifier_Casing (Source_Index (U));
 699             Write_Eol;
 700             Write_Str ("Representation information for unit ");
 701             Write_Unit_Name (Unit_Name (U));
 702             Col := Column;
 703             Write_Eol;
 704
 705             for J in 1 .. Col - 1 loop
 706                Write_Char ('-');
 707             end loop;
 708
 709             Write_Eol;
 710             List_Entities (Cunit_Entity (U));
 711          end if;
 712       end loop;
 713    end List_Rep_Info;
 714
 715    --------------------
 716    -- List_Type_Info --
 717    --------------------
 718
 719    procedure List_Type_Info (Ent : Entity_Id) is
 720    begin
 721       Write_Eol;
 722
 723       --  If Esize and RM_Size are the same and known, list as Size. This
 724       --  is a common case, which we may as well list in simple form.
 725
 726       if Esize (Ent) = RM_Size (Ent) then
 727          if Known_Esize (Ent) then
 728             Write_Str ("for ");
 729             List_Name (Ent);
 730             Write_Str ("'Size use ");
 731             Write_Val (Esize (Ent));
 732             Write_Line (";");
 733          end if;
 734
 735       --  For now, temporary case, to be removed when gigi properly back
 736       --  annotates RM_Size, if RM_Size is not set, then list Esize as
 737       --  Size. This avoids odd Object_Size output till we fix things???
 738
 739       elsif Unknown_RM_Size (Ent) then
 740          if Known_Esize (Ent) then
 741             Write_Str ("for ");
 742             List_Name (Ent);
 743             Write_Str ("'Size use ");
 744             Write_Val (Esize (Ent));
 745             Write_Line (";");
 746          end if;
 747
 748       --  Otherwise list size values separately if they are set
 749
 750       else
 751          if Known_Esize (Ent) then
 752             Write_Str ("for ");
 753             List_Name (Ent);
 754             Write_Str ("'Object_Size use ");
 755             Write_Val (Esize (Ent));
 756             Write_Line (";");
 757          end if;
 758
 759          --  Note on following check: The RM_Size of a discrete type can
 760          --  legitimately be set to zero, so a special check is needed.
 761
 762          if Known_RM_Size (Ent) or else Is_Discrete_Type (Ent) then
 763             Write_Str ("for ");
 764             List_Name (Ent);
 765             Write_Str ("'Value_Size use ");
 766             Write_Val (RM_Size (Ent));
 767             Write_Line (";");
 768          end if;
 769       end if;
 770
 771       if Known_Alignment (Ent) then
 772          Write_Str ("for ");
 773          List_Name (Ent);
 774          Write_Str ("'Alignment use ");
 775          Write_Val (Alignment (Ent));
 776          Write_Line (";");
 777       end if;
 778    end List_Type_Info;
 779
 780    ----------------------
 781    -- Rep_Not_Constant --
 782    ----------------------
 783
 784    function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean is
 785    begin
 786       if Val = No_Uint or else Val < 0 then
 787          return True;
 788       else
 789          return False;
 790       end if;
 791    end Rep_Not_Constant;
 792
 793    ---------------
 794    -- Rep_Value --
 795    ---------------
 796
 797    function Rep_Value
 798      (Val  : Node_Ref_Or_Val;
 799       D    : Discrim_List)
 800       return Uint
 801    is
 802       function B (Val : Boolean) return Uint;
 803       --  Returns Uint_0 for False, Uint_1 for True
 804
 805       function T (Val : Node_Ref_Or_Val) return Boolean;
 806       --  Returns True for 0, False for any non-zero (i.e. True)
 807
 808       function V (Val : Node_Ref_Or_Val) return Uint;
 809       --  Internal recursive routine to evaluate tree
 810
 811       -------
 812       -- B --
 813       -------
 814
 815       function B (Val : Boolean) return Uint is
 816       begin
 817          if Val then
 818             return Uint_1;
 819          else
 820             return Uint_0;
 821          end if;
 822       end B;
 823
 824       -------
 825       -- T --
 826       -------
 827
 828       function T (Val : Node_Ref_Or_Val) return Boolean is
 829       begin
 830          if V (Val) = 0 then
 831             return False;
 832          else
 833             return True;
 834          end if;
 835       end T;
 836
 837       -------
 838       -- V --
 839       -------
 840
 841       function V (Val : Node_Ref_Or_Val) return Uint is
 842          L, R, Q : Uint;
 843
 844       begin
 845          if Val >= 0 then
 846             return Val;
 847
 848          else
 849             declare
 850                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
 851
 852             begin
 853                case Node.Expr is
 854                   when Cond_Expr =>
 855                      if T (Node.Op1) then
 856                         return V (Node.Op2);
 857                      else
 858                         return V (Node.Op3);
 859                      end if;
 860
 861                   when Plus_Expr =>
 862                      return V (Node.Op1) + V (Node.Op2);
 863
 864                   when Minus_Expr =>
 865                      return V (Node.Op1) - V (Node.Op2);
 866
 867                   when Mult_Expr =>
 868                      return V (Node.Op1) * V (Node.Op2);
 869
 870                   when Trunc_Div_Expr =>
 871                      return V (Node.Op1) / V (Node.Op2);
 872
 873                   when Ceil_Div_Expr =>
 874                      return
 875                        UR_Ceiling
 876                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
 877
 878                   when Floor_Div_Expr =>
 879                      return
 880                        UR_Floor
 881                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
 882
 883                   when Trunc_Mod_Expr =>
 884                      return V (Node.Op1) rem V (Node.Op2);
 885
 886                   when Floor_Mod_Expr =>
 887                      return V (Node.Op1) mod V (Node.Op2);
 888
 889                   when Ceil_Mod_Expr =>
 890                      L := V (Node.Op1);
 891                      R := V (Node.Op2);
 892                      Q := UR_Ceiling (L / UR_From_Uint (R));
 893                      return L - R * Q;
 894
 895                   when Exact_Div_Expr =>
 896                      return V (Node.Op1) / V (Node.Op2);
 897
 898                   when Negate_Expr =>
 899                      return -V (Node.Op1);
 900
 901                   when Min_Expr =>
 902                      return UI_Min (V (Node.Op1), V (Node.Op2));
 903
 904                   when Max_Expr =>
 905                      return UI_Max (V (Node.Op1), V (Node.Op2));
 906
 907                   when Abs_Expr =>
 908                      return UI_Abs (V (Node.Op1));
 909
 910                   when Truth_Andif_Expr =>
 911                      return B (T (Node.Op1) and then T (Node.Op2));
 912
 913                   when Truth_Orif_Expr =>
 914                      return B (T (Node.Op1) or else T (Node.Op2));
 915
 916                   when Truth_And_Expr =>
 917                      return B (T (Node.Op1) and T (Node.Op2));
 918
 919                   when Truth_Or_Expr =>
 920                      return B (T (Node.Op1) or T (Node.Op2));
 921
 922                   when Truth_Xor_Expr =>
 923                      return B (T (Node.Op1) xor T (Node.Op2));
 924
 925                   when Truth_Not_Expr =>
 926                      return B (not T (Node.Op1));
 927
 928                   when Lt_Expr =>
 929                      return B (V (Node.Op1) < V (Node.Op2));
 930
 931                   when Le_Expr =>
 932                      return B (V (Node.Op1) <= V (Node.Op2));
 933
 934                   when Gt_Expr =>
 935                      return B (V (Node.Op1) > V (Node.Op2));
 936
 937                   when Ge_Expr =>
 938                      return B (V (Node.Op1) >= V (Node.Op2));
 939
 940                   when Eq_Expr =>
 941                      return B (V (Node.Op1) = V (Node.Op2));
 942
 943                   when Ne_Expr =>
 944                      return B (V (Node.Op1) /= V (Node.Op2));
 945
 946                   when Discrim_Val =>
 947                      declare
 948                         Sub : constant Int := UI_To_Int (Node.Op1);
 949
 950                      begin
 951                         pragma Assert (Sub in D'Range);
 952                         return D (Sub);
 953                      end;
 954
 955                end case;
 956             end;
 957          end if;
 958       end V;
 959
 960    --  Start of processing for Rep_Value
 961
 962    begin
 963       if Val = No_Uint then
 964          return No_Uint;
 965
 966       else
 967          return V (Val);
 968       end if;
 969    end Rep_Value;
 970
 971    ------------
 972    -- Spaces --
 973    ------------
 974
 975    procedure Spaces (N : Natural) is
 976    begin
 977       for J in 1 .. N loop
 978          Write_Char (' ');
 979       end loop;
 980    end Spaces;
 981
 982    ---------------
 983    -- Tree_Read --
 984    ---------------
 985
 986    procedure Tree_Read is
 987    begin
 988       Rep_Table.Tree_Read;
 989    end Tree_Read;
 990
 991    ----------------
 992    -- Tree_Write --
 993    ----------------
 994
 995    procedure Tree_Write is
 996    begin
 997       Rep_Table.Tree_Write;
 998    end Tree_Write;
 999
1000    ---------------
1001    -- Write_Val --
1002    ---------------
1003
1004    procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False) is
1005    begin
1006       if Rep_Not_Constant (Val) then
1007          if List_Representation_Info < 3 then
1008             Write_Str ("??");
1009          else
1010             if Back_End_Layout then
1011                Write_Char (' ');
1012                List_GCC_Expression (Val);
1013                Write_Char (' ');
1014             else
1015                Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
1016             end if;
1017          end if;
1018
1019       else
1020          UI_Write (Val);
1021       end if;
1022    end Write_Val;
1023
1024 end Repinfo;