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 --          Copyright (C) 1999-2014, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Alloc;   use Alloc;
  33 with Atree;   use Atree;
  34 with Casing;  use Casing;
  35 with Debug;   use Debug;
  36 with Einfo;   use Einfo;
  37 with Lib;     use Lib;
  38 with Namet;   use Namet;
  39 with Nlists;  use Nlists;
  40 with Opt;     use Opt;
  41 with Output;  use Output;
  42 with Sem_Aux; use Sem_Aux;
  43 with Sinfo;   use Sinfo;
  44 with Sinput;  use Sinput;
  45 with Snames;  use Snames;
  46 with Stand;   use Stand;
  47 with Stringt; use Stringt;
  48 with Table;   use Table;
  49 with Uname;   use Uname;
  50 with Urealp;  use Urealp;
  51
  52 with Ada.Unchecked_Conversion;
  53
  54 package body Repinfo is
  55
  56    SSU : constant := 8;
  57    --  Value for Storage_Unit, we do not want to get this from TTypes, since
  58    --  this introduces problematic dependencies in ASIS, and in any case this
  59    --  value is assumed to be 8 for the implementation of the DDA.
  60
  61    --  This is wrong for AAMP???
  62
  63    ---------------------------------------
  64    -- Representation of gcc Expressions --
  65    ---------------------------------------
  66
  67    --    This table is used only if Frontend_Layout_On_Target is False, so gigi
  68    --    lays out dynamic size/offset fields using encoded gcc expressions.
  69
  70    --    A table internal to this unit is used to hold the values of back
  71    --    annotated expressions. This table is written out by -gnatt and read
  72    --    back in for ASIS processing.
  73
  74    --    Node values are stored as Uint values using the negative of the node
  75    --    index in this table. Constants appear as non-negative Uint values.
  76
  77    type Exp_Node is record
  78       Expr : TCode;
  79       Op1  : Node_Ref_Or_Val;
  80       Op2  : Node_Ref_Or_Val;
  81       Op3  : Node_Ref_Or_Val;
  82    end record;
  83
  84    --  The following representation clause ensures that the above record
  85    --  has no holes. We do this so that when instances of this record are
  86    --  written by Tree_Gen, we do not write uninitialized values to the file.
  87
  88    for Exp_Node use record
  89       Expr at  0 range 0 .. 31;
  90       Op1  at  4 range 0 .. 31;
  91       Op2  at  8 range 0 .. 31;
  92       Op3  at 12 range 0 .. 31;
  93    end record;
  94
  95    for Exp_Node'Size use 16 * 8;
  96    --  This ensures that we did not leave out any fields
  97
  98    package Rep_Table is new Table.Table (
  99       Table_Component_Type => Exp_Node,
 100       Table_Index_Type     => Nat,
 101       Table_Low_Bound      => 1,
 102       Table_Initial        => Alloc.Rep_Table_Initial,
 103       Table_Increment      => Alloc.Rep_Table_Increment,
 104       Table_Name           => "BE_Rep_Table");
 105
 106    --------------------------------------------------------------
 107    -- Representation of Front-End Dynamic Size/Offset Entities --
 108    --------------------------------------------------------------
 109
 110    package Dynamic_SO_Entity_Table is new Table.Table (
 111       Table_Component_Type => Entity_Id,
 112       Table_Index_Type     => Nat,
 113       Table_Low_Bound      => 1,
 114       Table_Initial        => Alloc.Rep_Table_Initial,
 115       Table_Increment      => Alloc.Rep_Table_Increment,
 116       Table_Name           => "FE_Rep_Table");
 117
 118    Unit_Casing : Casing_Type;
 119    --  Identifier casing for current unit. This is set by List_Rep_Info for
 120    --  each unit, before calling subprograms which may read it.
 121
 122    Need_Blank_Line : Boolean;
 123    --  Set True if a blank line is needed before outputting any information for
 124    --  the current entity. Set True when a new entity is processed, and false
 125    --  when the blank line is output.
 126
 127    -----------------------
 128    -- Local Subprograms --
 129    -----------------------
 130
 131    function Back_End_Layout return Boolean;
 132    --  Test for layout mode, True = back end, False = front end. This function
 133    --  is used rather than checking the configuration parameter because we do
 134    --  not want Repinfo to depend on Targparm (for ASIS)
 135
 136    procedure Blank_Line;
 137    --  Called before outputting anything for an entity. Ensures that
 138    --  a blank line precedes the output for a particular entity.
 139
 140    procedure List_Entities (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
 141    --  This procedure lists the entities associated with the entity E, starting
 142    --  with the First_Entity and using the Next_Entity link. If a nested
 143    --  package is found, entities within the package are recursively processed.
 144
 145    procedure List_Name (Ent : Entity_Id);
 146    --  List name of entity Ent in appropriate case. The name is listed with
 147    --  full qualification up to but not including the compilation unit name.
 148
 149    procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
 150    --  List representation info for array type Ent
 151
 152    procedure List_Linker_Section (Ent : Entity_Id);
 153    --  List linker section for Ent (caller has checked that Ent is an entity
 154    --  for which the Linker_Section_Pragma field is defined).
 155
 156    procedure List_Mechanisms (Ent : Entity_Id);
 157    --  List mechanism information for parameters of Ent, which is subprogram,
 158    --  subprogram type, or an entry or entry family.
 159
 160    procedure List_Object_Info (Ent : Entity_Id);
 161    --  List representation info for object Ent
 162
 163    procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
 164    --  List representation info for record type Ent
 165
 166    procedure List_Scalar_Storage_Order
 167      (Ent              : Entity_Id;
 168       Bytes_Big_Endian : Boolean);
 169    --  List scalar storage order information for record or array type Ent.
 170    --  Also includes bit order information for record types, if necessary.
 171
 172    procedure List_Type_Info (Ent : Entity_Id);
 173    --  List type info for type Ent
 174
 175    function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean;
 176    --  Returns True if Val represents a variable value, and False if it
 177    --  represents a value that is fixed at compile time.
 178
 179    procedure Spaces (N : Natural);
 180    --  Output given number of spaces
 181
 182    procedure Write_Info_Line (S : String);
 183    --  Routine to write a line to Repinfo output file. This routine is passed
 184    --  as a special output procedure to Output.Set_Special_Output. Note that
 185    --  Write_Info_Line is called with an EOL character at the end of each line,
 186    --  as per the Output spec, but the internal call to the appropriate routine
 187    --  in Osint requires that the end of line sequence be stripped off.
 188
 189    procedure Write_Mechanism (M : Mechanism_Type);
 190    --  Writes symbolic string for mechanism represented by M
 191
 192    procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False);
 193    --  Given a representation value, write it out. No_Uint values or values
 194    --  dependent on discriminants are written as two question marks. If the
 195    --  flag Paren is set, then the output is surrounded in parentheses if it is
 196    --  other than a simple value.
 197
 198    ---------------------
 199    -- Back_End_Layout --
 200    ---------------------
 201
 202    function Back_End_Layout return Boolean is
 203    begin
 204       --  We have back end layout if the back end has made any entries in the
 205       --  table of GCC expressions, otherwise we have front end layout.
 206
 207       return Rep_Table.Last > 0;
 208    end Back_End_Layout;
 209
 210    ----------------
 211    -- Blank_Line --
 212    ----------------
 213
 214    procedure Blank_Line is
 215    begin
 216       if Need_Blank_Line then
 217          Write_Eol;
 218          Need_Blank_Line := False;
 219       end if;
 220    end Blank_Line;
 221
 222    ------------------------
 223    -- Create_Discrim_Ref --
 224    ------------------------
 225
 226    function Create_Discrim_Ref (Discr : Entity_Id) return Node_Ref is
 227    begin
 228       return Create_Node
 229         (Expr => Discrim_Val,
 230          Op1  => Discriminant_Number (Discr));
 231    end Create_Discrim_Ref;
 232
 233    ---------------------------
 234    -- Create_Dynamic_SO_Ref --
 235    ---------------------------
 236
 237    function Create_Dynamic_SO_Ref (E : Entity_Id) return Dynamic_SO_Ref is
 238    begin
 239       Dynamic_SO_Entity_Table.Append (E);
 240       return UI_From_Int (-Dynamic_SO_Entity_Table.Last);
 241    end Create_Dynamic_SO_Ref;
 242
 243    -----------------
 244    -- Create_Node --
 245    -----------------
 246
 247    function Create_Node
 248      (Expr : TCode;
 249       Op1  : Node_Ref_Or_Val;
 250       Op2  : Node_Ref_Or_Val := No_Uint;
 251       Op3  : Node_Ref_Or_Val := No_Uint) return Node_Ref
 252    is
 253    begin
 254       Rep_Table.Append (
 255         (Expr => Expr,
 256          Op1  => Op1,
 257          Op2  => Op2,
 258          Op3  => Op3));
 259       return UI_From_Int (-Rep_Table.Last);
 260    end Create_Node;
 261
 262    ---------------------------
 263    -- Get_Dynamic_SO_Entity --
 264    ---------------------------
 265
 266    function Get_Dynamic_SO_Entity (U : Dynamic_SO_Ref) return Entity_Id is
 267    begin
 268       return Dynamic_SO_Entity_Table.Table (-UI_To_Int (U));
 269    end Get_Dynamic_SO_Entity;
 270
 271    -----------------------
 272    -- Is_Dynamic_SO_Ref --
 273    -----------------------
 274
 275    function Is_Dynamic_SO_Ref (U : SO_Ref) return Boolean is
 276    begin
 277       return U < Uint_0;
 278    end Is_Dynamic_SO_Ref;
 279
 280    ----------------------
 281    -- Is_Static_SO_Ref --
 282    ----------------------
 283
 284    function Is_Static_SO_Ref (U : SO_Ref) return Boolean is
 285    begin
 286       return U >= Uint_0;
 287    end Is_Static_SO_Ref;
 288
 289    ---------
 290    -- lgx --
 291    ---------
 292
 293    procedure lgx (U : Node_Ref_Or_Val) is
 294    begin
 295       List_GCC_Expression (U);
 296       Write_Eol;
 297    end lgx;
 298
 299    ----------------------
 300    -- List_Array_Info --
 301    ----------------------
 302
 303    procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
 304    begin
 305       List_Type_Info (Ent);
 306       Write_Str ("for ");
 307       List_Name (Ent);
 308       Write_Str ("'Component_Size use ");
 309       Write_Val (Component_Size (Ent));
 310       Write_Line (";");
 311
 312       List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
 313    end List_Array_Info;
 314
 315    -------------------
 316    -- List_Entities --
 317    -------------------
 318
 319    procedure List_Entities (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
 320       Body_E : Entity_Id;
 321       E      : Entity_Id;
 322
 323       function Find_Declaration (E : Entity_Id) return Node_Id;
 324       --  Utility to retrieve declaration node for entity in the
 325       --  case of package bodies and subprograms.
 326
 327       ----------------------
 328       -- Find_Declaration --
 329       ----------------------
 330
 331       function Find_Declaration (E : Entity_Id) return Node_Id is
 332          Decl : Node_Id;
 333
 334       begin
 335          Decl := Parent (E);
 336          while Present (Decl)
 337            and then  Nkind (Decl) /= N_Package_Body
 338            and then Nkind (Decl) /= N_Subprogram_Declaration
 339            and then Nkind (Decl) /= N_Subprogram_Body
 340          loop
 341             Decl := Parent (Decl);
 342          end loop;
 343
 344          return Decl;
 345       end Find_Declaration;
 346
 347    --  Start of processing for List_Entities
 348
 349    begin
 350       --  List entity if we have one, and it is not a renaming declaration.
 351       --  For renamings, we don't get proper information, and really it makes
 352       --  sense to restrict the output to the renamed entity.
 353
 354       if Present (Ent)
 355         and then Nkind (Declaration_Node (Ent)) not in N_Renaming_Declaration
 356       then
 357          --  If entity is a subprogram and we are listing mechanisms,
 358          --  then we need to list mechanisms for this entity.
 359
 360          if List_Representation_Info_Mechanisms
 361            and then (Is_Subprogram (Ent)
 362                       or else Ekind (Ent) = E_Entry
 363                       or else Ekind (Ent) = E_Entry_Family)
 364          then
 365             Need_Blank_Line := True;
 366             List_Mechanisms (Ent);
 367          end if;
 368
 369          E := First_Entity (Ent);
 370          while Present (E) loop
 371             Need_Blank_Line := True;
 372
 373             --  We list entities that come from source (excluding private or
 374             --  incomplete types or deferred constants, where we will list the
 375             --  info for the full view). If debug flag A is set, then all
 376             --  entities are listed
 377
 378             if (Comes_From_Source (E)
 379               and then not Is_Incomplete_Or_Private_Type (E)
 380               and then not (Ekind (E) = E_Constant
 381                               and then Present (Full_View (E))))
 382               or else Debug_Flag_AA
 383             then
 384                if Is_Subprogram (E) then
 385                   List_Linker_Section (E);
 386
 387                   if List_Representation_Info_Mechanisms then
 388                      List_Mechanisms (E);
 389                   end if;
 390
 391                elsif Ekind_In (E, E_Entry,
 392                                   E_Entry_Family,
 393                                   E_Subprogram_Type)
 394                then
 395                   if List_Representation_Info_Mechanisms then
 396                      List_Mechanisms (E);
 397                   end if;
 398
 399                elsif Is_Record_Type (E) then
 400                   if List_Representation_Info >= 1 then
 401                      List_Record_Info (E, Bytes_Big_Endian);
 402                   end if;
 403
 404                   List_Linker_Section (E);
 405
 406                elsif Is_Array_Type (E) then
 407                   if List_Representation_Info >= 1 then
 408                      List_Array_Info (E, Bytes_Big_Endian);
 409                   end if;
 410
 411                   List_Linker_Section (E);
 412
 413                elsif Is_Type (E) then
 414                   if List_Representation_Info >= 2 then
 415                      List_Type_Info (E);
 416                      List_Linker_Section (E);
 417                   end if;
 418
 419                elsif Ekind_In (E, E_Variable, E_Constant) then
 420                   if List_Representation_Info >= 2 then
 421                      List_Object_Info (E);
 422                      List_Linker_Section (E);
 423                   end if;
 424
 425                elsif Ekind (E) = E_Loop_Parameter or else Is_Formal (E) then
 426                   if List_Representation_Info >= 2 then
 427                      List_Object_Info (E);
 428                   end if;
 429                end if;
 430
 431                --  Recurse into nested package, but not if they are package
 432                --  renamings (in particular renamings of the enclosing package,
 433                --  as for some Java bindings and for generic instances).
 434
 435                if Ekind (E) = E_Package then
 436                   if No (Renamed_Object (E)) then
 437                      List_Entities (E, Bytes_Big_Endian);
 438                   end if;
 439
 440                --  Recurse into bodies
 441
 442                elsif Ekind_In (E, E_Protected_Type,
 443                                   E_Task_Type,
 444                                   E_Subprogram_Body,
 445                                   E_Package_Body,
 446                                   E_Task_Body,
 447                                   E_Protected_Body)
 448                then
 449                   List_Entities (E, Bytes_Big_Endian);
 450
 451                --  Recurse into blocks
 452
 453                elsif Ekind (E) = E_Block then
 454                   List_Entities (E, Bytes_Big_Endian);
 455                end if;
 456             end if;
 457
 458             E := Next_Entity (E);
 459          end loop;
 460
 461          --  For a package body, the entities of the visible subprograms are
 462          --  declared in the corresponding spec. Iterate over its entities in
 463          --  order to handle properly the subprogram bodies. Skip bodies in
 464          --  subunits, which are listed independently.
 465
 466          if Ekind (Ent) = E_Package_Body
 467            and then Present (Corresponding_Spec (Find_Declaration (Ent)))
 468          then
 469             E := First_Entity (Corresponding_Spec (Find_Declaration (Ent)));
 470             while Present (E) loop
 471                if Is_Subprogram (E)
 472                  and then
 473                    Nkind (Find_Declaration (E)) = N_Subprogram_Declaration
 474                then
 475                   Body_E := Corresponding_Body (Find_Declaration (E));
 476
 477                   if Present (Body_E)
 478                     and then
 479                       Nkind (Parent (Find_Declaration (Body_E))) /= N_Subunit
 480                   then
 481                      List_Entities (Body_E, Bytes_Big_Endian);
 482                   end if;
 483                end if;
 484
 485                Next_Entity (E);
 486             end loop;
 487          end if;
 488       end if;
 489    end List_Entities;
 490
 491    -------------------------
 492    -- List_GCC_Expression --
 493    -------------------------
 494
 495    procedure List_GCC_Expression (U : Node_Ref_Or_Val) is
 496
 497       procedure Print_Expr (Val : Node_Ref_Or_Val);
 498       --  Internal recursive procedure to print expression
 499
 500       ----------------
 501       -- Print_Expr --
 502       ----------------
 503
 504       procedure Print_Expr (Val : Node_Ref_Or_Val) is
 505       begin
 506          if Val >= 0 then
 507             UI_Write (Val, Decimal);
 508
 509          else
 510             declare
 511                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
 512
 513                procedure Binop (S : String);
 514                --  Output text for binary operator with S being operator name
 515
 516                -----------
 517                -- Binop --
 518                -----------
 519
 520                procedure Binop (S : String) is
 521                begin
 522                   Write_Char ('(');
 523                   Print_Expr (Node.Op1);
 524                   Write_Str (S);
 525                   Print_Expr (Node.Op2);
 526                   Write_Char (')');
 527                end Binop;
 528
 529             --  Start of processing for Print_Expr
 530
 531             begin
 532                case Node.Expr is
 533                   when Cond_Expr =>
 534                      Write_Str ("(if ");
 535                      Print_Expr (Node.Op1);
 536                      Write_Str (" then ");
 537                      Print_Expr (Node.Op2);
 538                      Write_Str (" else ");
 539                      Print_Expr (Node.Op3);
 540                      Write_Str (" end)");
 541
 542                   when Plus_Expr =>
 543                      Binop (" + ");
 544
 545                   when Minus_Expr =>
 546                      Binop (" - ");
 547
 548                   when Mult_Expr =>
 549                      Binop (" * ");
 550
 551                   when Trunc_Div_Expr =>
 552                      Binop (" /t ");
 553
 554                   when Ceil_Div_Expr =>
 555                      Binop (" /c ");
 556
 557                   when Floor_Div_Expr =>
 558                      Binop (" /f ");
 559
 560                   when Trunc_Mod_Expr =>
 561                      Binop (" modt ");
 562
 563                   when Floor_Mod_Expr =>
 564                      Binop (" modf ");
 565
 566                   when Ceil_Mod_Expr =>
 567                      Binop (" modc ");
 568
 569                   when Exact_Div_Expr =>
 570                      Binop (" /e ");
 571
 572                   when Negate_Expr =>
 573                      Write_Char ('-');
 574                      Print_Expr (Node.Op1);
 575
 576                   when Min_Expr =>
 577                      Binop (" min ");
 578
 579                   when Max_Expr =>
 580                      Binop (" max ");
 581
 582                   when Abs_Expr =>
 583                      Write_Str ("abs ");
 584                      Print_Expr (Node.Op1);
 585
 586                   when Truth_Andif_Expr =>
 587                      Binop (" and if ");
 588
 589                   when Truth_Orif_Expr =>
 590                      Binop (" or if ");
 591
 592                   when Truth_And_Expr =>
 593                      Binop (" and ");
 594
 595                   when Truth_Or_Expr =>
 596                      Binop (" or ");
 597
 598                   when Truth_Xor_Expr =>
 599                      Binop (" xor ");
 600
 601                   when Truth_Not_Expr =>
 602                      Write_Str ("not ");
 603                      Print_Expr (Node.Op1);
 604
 605                   when Bit_And_Expr =>
 606                      Binop (" & ");
 607
 608                   when Lt_Expr =>
 609                      Binop (" < ");
 610
 611                   when Le_Expr =>
 612                      Binop (" <= ");
 613
 614                   when Gt_Expr =>
 615                      Binop (" > ");
 616
 617                   when Ge_Expr =>
 618                      Binop (" >= ");
 619
 620                   when Eq_Expr =>
 621                      Binop (" == ");
 622
 623                   when Ne_Expr =>
 624                      Binop (" != ");
 625
 626                   when Discrim_Val =>
 627                      Write_Char ('#');
 628                      UI_Write (Node.Op1);
 629
 630                end case;
 631             end;
 632          end if;
 633       end Print_Expr;
 634
 635    --  Start of processing for List_GCC_Expression
 636
 637    begin
 638       if U = No_Uint then
 639          Write_Str ("??");
 640       else
 641          Print_Expr (U);
 642       end if;
 643    end List_GCC_Expression;
 644
 645    -------------------------
 646    -- List_Linker_Section --
 647    -------------------------
 648
 649    procedure List_Linker_Section (Ent : Entity_Id) is
 650       Arg : Node_Id;
 651
 652    begin
 653       if Present (Linker_Section_Pragma (Ent)) then
 654          Write_Str ("pragma Linker_Section (");
 655          List_Name (Ent);
 656          Write_Str (", """);
 657
 658          Arg :=
 659            Last (Pragma_Argument_Associations (Linker_Section_Pragma (Ent)));
 660
 661          if Nkind (Arg) = N_Pragma_Argument_Association then
 662             Arg := Expression (Arg);
 663          end if;
 664
 665          pragma Assert (Nkind (Arg) = N_String_Literal);
 666          String_To_Name_Buffer (Strval (Arg));
 667          Write_Str (Name_Buffer (1 .. Name_Len));
 668          Write_Str (""");");
 669          Write_Eol;
 670       end if;
 671    end List_Linker_Section;
 672
 673    ---------------------
 674    -- List_Mechanisms --
 675    ---------------------
 676
 677    procedure List_Mechanisms (Ent : Entity_Id) is
 678       Plen : Natural;
 679       Form : Entity_Id;
 680
 681    begin
 682       Blank_Line;
 683
 684       case Ekind (Ent) is
 685          when E_Function =>
 686             Write_Str ("function ");
 687
 688          when E_Operator =>
 689             Write_Str ("operator ");
 690
 691          when E_Procedure =>
 692             Write_Str ("procedure ");
 693
 694          when E_Subprogram_Type =>
 695             Write_Str ("type ");
 696
 697          when E_Entry | E_Entry_Family =>
 698             Write_Str ("entry ");
 699
 700          when others =>
 701             raise Program_Error;
 702       end case;
 703
 704       Get_Unqualified_Decoded_Name_String (Chars (Ent));
 705       Write_Str (Name_Buffer (1 .. Name_Len));
 706       Write_Str (" declared at ");
 707       Write_Location (Sloc (Ent));
 708       Write_Eol;
 709
 710       Write_Str ("  convention : ");
 711
 712       case Convention (Ent) is
 713          when Convention_Ada                   =>
 714             Write_Line ("Ada");
 715          when Convention_Ada_Pass_By_Copy      =>
 716             Write_Line ("Ada_Pass_By_Copy");
 717          when Convention_Ada_Pass_By_Reference =>
 718             Write_Line ("Ada_Pass_By_Reference");
 719          when Convention_Intrinsic             =>
 720             Write_Line ("Intrinsic");
 721          when Convention_Entry                 =>
 722             Write_Line ("Entry");
 723          when Convention_Ghost                 =>
 724             Write_Line ("Ghost");
 725          when Convention_Protected             =>
 726             Write_Line ("Protected");
 727          when Convention_Assembler             =>
 728             Write_Line ("Assembler");
 729          when Convention_C                     =>
 730             Write_Line ("C");
 731          when Convention_CIL                   =>
 732             Write_Line ("CIL");
 733          when Convention_COBOL                 =>
 734             Write_Line ("COBOL");
 735          when Convention_CPP                   =>
 736             Write_Line ("C++");
 737          when Convention_Fortran               =>
 738             Write_Line ("Fortran");
 739          when Convention_Java                  =>
 740             Write_Line ("Java");
 741          when Convention_Stdcall               =>
 742             Write_Line ("Stdcall");
 743          when Convention_Stubbed               =>
 744             Write_Line ("Stubbed");
 745       end case;
 746
 747       --  Find max length of formal name
 748
 749       Plen := 0;
 750       Form := First_Formal (Ent);
 751       while Present (Form) loop
 752          Get_Unqualified_Decoded_Name_String (Chars (Form));
 753
 754          if Name_Len > Plen then
 755             Plen := Name_Len;
 756          end if;
 757
 758          Next_Formal (Form);
 759       end loop;
 760
 761       --  Output formals and mechanisms
 762
 763       Form := First_Formal (Ent);
 764       while Present (Form) loop
 765          Get_Unqualified_Decoded_Name_String (Chars (Form));
 766          while Name_Len <= Plen loop
 767             Name_Len := Name_Len + 1;
 768             Name_Buffer (Name_Len) := ' ';
 769          end loop;
 770
 771          Write_Str ("  ");
 772          Write_Str (Name_Buffer (1 .. Plen + 1));
 773          Write_Str (": passed by ");
 774
 775          Write_Mechanism (Mechanism (Form));
 776          Write_Eol;
 777          Next_Formal (Form);
 778       end loop;
 779
 780       if Etype (Ent) /= Standard_Void_Type then
 781          Write_Str ("  returns by ");
 782          Write_Mechanism (Mechanism (Ent));
 783          Write_Eol;
 784       end if;
 785    end List_Mechanisms;
 786
 787    ---------------
 788    -- List_Name --
 789    ---------------
 790
 791    procedure List_Name (Ent : Entity_Id) is
 792    begin
 793       if not Is_Compilation_Unit (Scope (Ent)) then
 794          List_Name (Scope (Ent));
 795          Write_Char ('.');
 796       end if;
 797
 798       Get_Unqualified_Decoded_Name_String (Chars (Ent));
 799       Set_Casing (Unit_Casing);
 800       Write_Str (Name_Buffer (1 .. Name_Len));
 801    end List_Name;
 802
 803    ---------------------
 804    -- List_Object_Info --
 805    ---------------------
 806
 807    procedure List_Object_Info (Ent : Entity_Id) is
 808    begin
 809       Blank_Line;
 810
 811       Write_Str ("for ");
 812       List_Name (Ent);
 813       Write_Str ("'Size use ");
 814       Write_Val (Esize (Ent));
 815       Write_Line (";");
 816
 817       Write_Str ("for ");
 818       List_Name (Ent);
 819       Write_Str ("'Alignment use ");
 820       Write_Val (Alignment (Ent));
 821       Write_Line (";");
 822    end List_Object_Info;
 823
 824    ----------------------
 825    -- List_Record_Info --
 826    ----------------------
 827
 828    procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
 829       Comp  : Entity_Id;
 830       Cfbit : Uint;
 831       Sunit : Uint;
 832
 833       Max_Name_Length : Natural;
 834       Max_Suni_Length : Natural;
 835
 836    begin
 837       Blank_Line;
 838       List_Type_Info (Ent);
 839
 840       Write_Str ("for ");
 841       List_Name (Ent);
 842       Write_Line (" use record");
 843
 844       --  First loop finds out max line length and max starting position
 845       --  length, for the purpose of lining things up nicely.
 846
 847       Max_Name_Length := 0;
 848       Max_Suni_Length := 0;
 849
 850       Comp := First_Component_Or_Discriminant (Ent);
 851       while Present (Comp) loop
 852          Get_Decoded_Name_String (Chars (Comp));
 853          Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
 854
 855          Cfbit := Component_Bit_Offset (Comp);
 856
 857          if Rep_Not_Constant (Cfbit) then
 858             UI_Image_Length := 2;
 859
 860          else
 861             --  Complete annotation in case not done
 862
 863             Set_Normalized_Position (Comp, Cfbit / SSU);
 864             Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
 865
 866             Sunit := Cfbit / SSU;
 867             UI_Image (Sunit);
 868          end if;
 869
 870          --  If the record is not packed, then we know that all fields whose
 871          --  position is not specified have a starting normalized bit position
 872          --  of zero.
 873
 874          if Unknown_Normalized_First_Bit (Comp)
 875            and then not Is_Packed (Ent)
 876          then
 877             Set_Normalized_First_Bit (Comp, Uint_0);
 878          end if;
 879
 880          Max_Suni_Length :=
 881            Natural'Max (Max_Suni_Length, UI_Image_Length);
 882
 883          Next_Component_Or_Discriminant (Comp);
 884       end loop;
 885
 886       --  Second loop does actual output based on those values
 887
 888       Comp := First_Component_Or_Discriminant (Ent);
 889       while Present (Comp) loop
 890          declare
 891             Esiz : constant Uint := Esize (Comp);
 892             Bofs : constant Uint := Component_Bit_Offset (Comp);
 893             Npos : constant Uint := Normalized_Position (Comp);
 894             Fbit : constant Uint := Normalized_First_Bit (Comp);
 895             Lbit : Uint;
 896
 897          begin
 898             Write_Str ("   ");
 899             Get_Decoded_Name_String (Chars (Comp));
 900             Set_Casing (Unit_Casing);
 901             Write_Str (Name_Buffer (1 .. Name_Len));
 902
 903             for J in 1 .. Max_Name_Length - Name_Len loop
 904                Write_Char (' ');
 905             end loop;
 906
 907             Write_Str (" at ");
 908
 909             if Known_Static_Normalized_Position (Comp) then
 910                UI_Image (Npos);
 911                Spaces (Max_Suni_Length - UI_Image_Length);
 912                Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
 913
 914             elsif Known_Component_Bit_Offset (Comp)
 915               and then List_Representation_Info = 3
 916             then
 917                Spaces (Max_Suni_Length - 2);
 918                Write_Str ("bit offset");
 919                Write_Val (Bofs, Paren => True);
 920                Write_Str (" size in bits = ");
 921                Write_Val (Esiz, Paren => True);
 922                Write_Eol;
 923                goto Continue;
 924
 925             elsif Known_Normalized_Position (Comp)
 926               and then List_Representation_Info = 3
 927             then
 928                Spaces (Max_Suni_Length - 2);
 929                Write_Val (Npos);
 930
 931             else
 932                --  For the packed case, we don't know the bit positions if we
 933                --  don't know the starting position.
 934
 935                if Is_Packed (Ent) then
 936                   Write_Line ("?? range  ? .. ??;");
 937                   goto Continue;
 938
 939                --  Otherwise we can continue
 940
 941                else
 942                   Write_Str ("??");
 943                end if;
 944             end if;
 945
 946             Write_Str (" range  ");
 947             UI_Write (Fbit);
 948             Write_Str (" .. ");
 949
 950             --  Allowing Uint_0 here is an annoying special case. Really this
 951             --  should be a fine Esize value but currently it means unknown,
 952             --  except that we know after gigi has back annotated that a size
 953             --  of zero is real, since otherwise gigi back annotates using
 954             --  No_Uint as the value to indicate unknown).
 955
 956             if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
 957               and then Known_Static_Normalized_First_Bit (Comp)
 958             then
 959                Lbit := Fbit + Esiz - 1;
 960
 961                if Lbit < 10 then
 962                   Write_Char (' ');
 963                end if;
 964
 965                UI_Write (Lbit);
 966
 967             --  The test for Esize (Comp) not Uint_0 here is an annoying
 968             --  special case. Officially a value of zero for Esize means
 969             --  unknown, but here we use the fact that we know that gigi
 970             --  annotates Esize with No_Uint, not Uint_0. Really everyone
 971             --  should use No_Uint???
 972
 973             elsif List_Representation_Info < 3
 974               or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
 975             then
 976                Write_Str ("??");
 977
 978             --  List_Representation >= 3 and Known_Esize (Comp)
 979
 980             else
 981                Write_Val (Esiz, Paren => True);
 982
 983                --  If in front end layout mode, then dynamic size is stored
 984                --  in storage units, so renormalize for output
 985
 986                if not Back_End_Layout then
 987                   Write_Str (" * ");
 988                   Write_Int (SSU);
 989                end if;
 990
 991                --  Add appropriate first bit offset
 992
 993                if Fbit = 0 then
 994                   Write_Str (" - 1");
 995
 996                elsif Fbit = 1 then
 997                   null;
 998
 999                else
1000                   Write_Str (" + ");
1001                   Write_Int (UI_To_Int (Fbit) - 1);
1002                end if;
1003             end if;
1004
1005             Write_Line (";");
1006          end;
1007
1008       <<Continue>>
1009          Next_Component_Or_Discriminant (Comp);
1010       end loop;
1011
1012       Write_Line ("end record;");
1013
1014       List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
1015    end List_Record_Info;
1016
1017    -------------------
1018    -- List_Rep_Info --
1019    -------------------
1020
1021    procedure List_Rep_Info (Bytes_Big_Endian : Boolean) is
1022       Col : Nat;
1023
1024    begin
1025       if List_Representation_Info /= 0
1026         or else List_Representation_Info_Mechanisms
1027       then
1028          for U in Main_Unit .. Last_Unit loop
1029             if In_Extended_Main_Source_Unit (Cunit_Entity (U)) then
1030                Unit_Casing := Identifier_Casing (Source_Index (U));
1031
1032                --  Normal case, list to standard output
1033
1034                if not List_Representation_Info_To_File then
1035                   Write_Eol;
1036                   Write_Str ("Representation information for unit ");
1037                   Write_Unit_Name (Unit_Name (U));
1038                   Col := Column;
1039                   Write_Eol;
1040
1041                   for J in 1 .. Col - 1 loop
1042                      Write_Char ('-');
1043                   end loop;
1044
1045                   Write_Eol;
1046                   List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1047
1048                --  List representation information to file
1049
1050                else
1051                   Create_Repinfo_File_Access.all
1052                     (Get_Name_String (File_Name (Source_Index (U))));
1053                   Set_Special_Output (Write_Info_Line'Access);
1054                   List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1055                   Set_Special_Output (null);
1056                   Close_Repinfo_File_Access.all;
1057                end if;
1058             end if;
1059          end loop;
1060       end if;
1061    end List_Rep_Info;
1062
1063    -------------------------------
1064    -- List_Scalar_Storage_Order --
1065    -------------------------------
1066
1067    procedure List_Scalar_Storage_Order
1068      (Ent              : Entity_Id;
1069       Bytes_Big_Endian : Boolean)
1070    is
1071       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean);
1072       --  Show attribute definition clause for Attr_Name (an endianness
1073       --  attribute), depending on whether or not the endianness is reversed
1074       --  compared to native endianness.
1075
1076       ---------------
1077       -- List_Attr --
1078       ---------------
1079
1080       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean) is
1081       begin
1082          Write_Str ("for ");
1083          List_Name (Ent);
1084          Write_Str ("'" & Attr_Name & " use System.");
1085
1086          if Bytes_Big_Endian xor Is_Reversed then
1087             Write_Str ("High");
1088          else
1089             Write_Str ("Low");
1090          end if;
1091
1092          Write_Line ("_Order_First;");
1093       end List_Attr;
1094
1095       List_SSO : constant Boolean :=
1096                    Has_Rep_Item (Ent, Name_Scalar_Storage_Order)
1097                      or else SSO_Set_Low_By_Default  (Ent)
1098                      or else SSO_Set_High_By_Default (Ent);
1099       --  Scalar_Storage_Order is displayed if specified explicitly
1100       --  or set by Default_Scalar_Storage_Order.
1101
1102    --  Start of processing for List_Scalar_Storage_Order
1103
1104    begin
1105       --  For record types, list Bit_Order if not default, or if SSO is shown
1106
1107       if Is_Record_Type (Ent)
1108         and then (List_SSO or else Reverse_Bit_Order (Ent))
1109       then
1110          List_Attr ("Bit_Order", Reverse_Bit_Order (Ent));
1111       end if;
1112
1113       --  List SSO if required. If not, then storage is supposed to be in
1114       --  native order.
1115
1116       if List_SSO then
1117          List_Attr ("Scalar_Storage_Order", Reverse_Storage_Order (Ent));
1118       else
1119          pragma Assert (not Reverse_Storage_Order (Ent));
1120          null;
1121       end if;
1122    end List_Scalar_Storage_Order;
1123
1124    --------------------
1125    -- List_Type_Info --
1126    --------------------
1127
1128    procedure List_Type_Info (Ent : Entity_Id) is
1129    begin
1130       Blank_Line;
1131
1132       --  Do not list size info for unconstrained arrays, not meaningful
1133
1134       if Is_Array_Type (Ent) and then not Is_Constrained (Ent) then
1135          null;
1136
1137       else
1138          --  If Esize and RM_Size are the same and known, list as Size. This
1139          --  is a common case, which we may as well list in simple form.
1140
1141          if Esize (Ent) = RM_Size (Ent) then
1142             Write_Str ("for ");
1143             List_Name (Ent);
1144             Write_Str ("'Size use ");
1145             Write_Val (Esize (Ent));
1146             Write_Line (";");
1147
1148          --  For now, temporary case, to be removed when gigi properly back
1149          --  annotates RM_Size, if RM_Size is not set, then list Esize as Size.
1150          --  This avoids odd Object_Size output till we fix things???
1151
1152          elsif Unknown_RM_Size (Ent) then
1153             Write_Str ("for ");
1154             List_Name (Ent);
1155             Write_Str ("'Size use ");
1156             Write_Val (Esize (Ent));
1157             Write_Line (";");
1158
1159          --  Otherwise list size values separately if they are set
1160
1161          else
1162             Write_Str ("for ");
1163             List_Name (Ent);
1164             Write_Str ("'Object_Size use ");
1165             Write_Val (Esize (Ent));
1166             Write_Line (";");
1167
1168             --  Note on following check: The RM_Size of a discrete type can
1169             --  legitimately be set to zero, so a special check is needed.
1170
1171             Write_Str ("for ");
1172             List_Name (Ent);
1173             Write_Str ("'Value_Size use ");
1174             Write_Val (RM_Size (Ent));
1175             Write_Line (";");
1176          end if;
1177       end if;
1178
1179       Write_Str ("for ");
1180       List_Name (Ent);
1181       Write_Str ("'Alignment use ");
1182       Write_Val (Alignment (Ent));
1183       Write_Line (";");
1184
1185       --  Special stuff for fixed-point
1186
1187       if Is_Fixed_Point_Type (Ent) then
1188
1189          --  Write small (always a static constant)
1190
1191          Write_Str ("for ");
1192          List_Name (Ent);
1193          Write_Str ("'Small use ");
1194          UR_Write (Small_Value (Ent));
1195          Write_Line (";");
1196
1197          --  Write range if static
1198
1199          declare
1200             R : constant Node_Id := Scalar_Range (Ent);
1201
1202          begin
1203             if Nkind (Low_Bound (R)) = N_Real_Literal
1204                  and then
1205                Nkind (High_Bound (R)) = N_Real_Literal
1206             then
1207                Write_Str ("for ");
1208                List_Name (Ent);
1209                Write_Str ("'Range use ");
1210                UR_Write (Realval (Low_Bound (R)));
1211                Write_Str (" .. ");
1212                UR_Write (Realval (High_Bound (R)));
1213                Write_Line (";");
1214             end if;
1215          end;
1216       end if;
1217    end List_Type_Info;
1218
1219    ----------------------
1220    -- Rep_Not_Constant --
1221    ----------------------
1222
1223    function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean is
1224    begin
1225       if Val = No_Uint or else Val < 0 then
1226          return True;
1227       else
1228          return False;
1229       end if;
1230    end Rep_Not_Constant;
1231
1232    ---------------
1233    -- Rep_Value --
1234    ---------------
1235
1236    function Rep_Value
1237      (Val : Node_Ref_Or_Val;
1238       D   : Discrim_List) return Uint
1239    is
1240       function B (Val : Boolean) return Uint;
1241       --  Returns Uint_0 for False, Uint_1 for True
1242
1243       function T (Val : Node_Ref_Or_Val) return Boolean;
1244       --  Returns True for 0, False for any non-zero (i.e. True)
1245
1246       function V (Val : Node_Ref_Or_Val) return Uint;
1247       --  Internal recursive routine to evaluate tree
1248
1249       function W (Val : Uint) return Word;
1250       --  Convert Val to Word, assuming Val is always in the Int range. This
1251       --  is a helper function for the evaluation of bitwise expressions like
1252       --  Bit_And_Expr, for which there is no direct support in uintp. Uint
1253       --  values out of the Int range are expected to be seen in such
1254       --  expressions only with overflowing byte sizes around, introducing
1255       --  inherent unreliabilities in computations anyway.
1256
1257       -------
1258       -- B --
1259       -------
1260
1261       function B (Val : Boolean) return Uint is
1262       begin
1263          if Val then
1264             return Uint_1;
1265          else
1266             return Uint_0;
1267          end if;
1268       end B;
1269
1270       -------
1271       -- T --
1272       -------
1273
1274       function T (Val : Node_Ref_Or_Val) return Boolean is
1275       begin
1276          if V (Val) = 0 then
1277             return False;
1278          else
1279             return True;
1280          end if;
1281       end T;
1282
1283       -------
1284       -- V --
1285       -------
1286
1287       function V (Val : Node_Ref_Or_Val) return Uint is
1288          L, R, Q : Uint;
1289
1290       begin
1291          if Val >= 0 then
1292             return Val;
1293
1294          else
1295             declare
1296                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
1297
1298             begin
1299                case Node.Expr is
1300                   when Cond_Expr =>
1301                      if T (Node.Op1) then
1302                         return V (Node.Op2);
1303                      else
1304                         return V (Node.Op3);
1305                      end if;
1306
1307                   when Plus_Expr =>
1308                      return V (Node.Op1) + V (Node.Op2);
1309
1310                   when Minus_Expr =>
1311                      return V (Node.Op1) - V (Node.Op2);
1312
1313                   when Mult_Expr =>
1314                      return V (Node.Op1) * V (Node.Op2);
1315
1316                   when Trunc_Div_Expr =>
1317                      return V (Node.Op1) / V (Node.Op2);
1318
1319                   when Ceil_Div_Expr =>
1320                      return
1321                        UR_Ceiling
1322                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
1323
1324                   when Floor_Div_Expr =>
1325                      return
1326                        UR_Floor
1327                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
1328
1329                   when Trunc_Mod_Expr =>
1330                      return V (Node.Op1) rem V (Node.Op2);
1331
1332                   when Floor_Mod_Expr =>
1333                      return V (Node.Op1) mod V (Node.Op2);
1334
1335                   when Ceil_Mod_Expr =>
1336                      L := V (Node.Op1);
1337                      R := V (Node.Op2);
1338                      Q := UR_Ceiling (L / UR_From_Uint (R));
1339                      return L - R * Q;
1340
1341                   when Exact_Div_Expr =>
1342                      return V (Node.Op1) / V (Node.Op2);
1343
1344                   when Negate_Expr =>
1345                      return -V (Node.Op1);
1346
1347                   when Min_Expr =>
1348                      return UI_Min (V (Node.Op1), V (Node.Op2));
1349
1350                   when Max_Expr =>
1351                      return UI_Max (V (Node.Op1), V (Node.Op2));
1352
1353                   when Abs_Expr =>
1354                      return UI_Abs (V (Node.Op1));
1355
1356                   when Truth_Andif_Expr =>
1357                      return B (T (Node.Op1) and then T (Node.Op2));
1358
1359                   when Truth_Orif_Expr =>
1360                      return B (T (Node.Op1) or else T (Node.Op2));
1361
1362                   when Truth_And_Expr =>
1363                      return B (T (Node.Op1) and then T (Node.Op2));
1364
1365                   when Truth_Or_Expr =>
1366                      return B (T (Node.Op1) or else T (Node.Op2));
1367
1368                   when Truth_Xor_Expr =>
1369                      return B (T (Node.Op1) xor T (Node.Op2));
1370
1371                   when Truth_Not_Expr =>
1372                      return B (not T (Node.Op1));
1373
1374                   when Bit_And_Expr =>
1375                      L := V (Node.Op1);
1376                      R := V (Node.Op2);
1377                      return UI_From_Int (Int (W (L) and W (R)));
1378
1379                   when Lt_Expr =>
1380                      return B (V (Node.Op1) < V (Node.Op2));
1381
1382                   when Le_Expr =>
1383                      return B (V (Node.Op1) <= V (Node.Op2));
1384
1385                   when Gt_Expr =>
1386                      return B (V (Node.Op1) > V (Node.Op2));
1387
1388                   when Ge_Expr =>
1389                      return B (V (Node.Op1) >= V (Node.Op2));
1390
1391                   when Eq_Expr =>
1392                      return B (V (Node.Op1) = V (Node.Op2));
1393
1394                   when Ne_Expr =>
1395                      return B (V (Node.Op1) /= V (Node.Op2));
1396
1397                   when Discrim_Val =>
1398                      declare
1399                         Sub : constant Int := UI_To_Int (Node.Op1);
1400                      begin
1401                         pragma Assert (Sub in D'Range);
1402                         return D (Sub);
1403                      end;
1404
1405                end case;
1406             end;
1407          end if;
1408       end V;
1409
1410       -------
1411       -- W --
1412       -------
1413
1414       --  We use an unchecked conversion to map Int values to their Word
1415       --  bitwise equivalent, which we could not achieve with a normal type
1416       --  conversion for negative Ints. We want bitwise equivalents because W
1417       --  is used as a helper for bit operators like Bit_And_Expr, and can be
1418       --  called for negative Ints in the context of aligning expressions like
1419       --  X+Align & -Align.
1420
1421       function W (Val : Uint) return Word is
1422          function To_Word is new Ada.Unchecked_Conversion (Int, Word);
1423       begin
1424          return To_Word (UI_To_Int (Val));
1425       end W;
1426
1427    --  Start of processing for Rep_Value
1428
1429    begin
1430       if Val = No_Uint then
1431          return No_Uint;
1432
1433       else
1434          return V (Val);
1435       end if;
1436    end Rep_Value;
1437
1438    ------------
1439    -- Spaces --
1440    ------------
1441
1442    procedure Spaces (N : Natural) is
1443    begin
1444       for J in 1 .. N loop
1445          Write_Char (' ');
1446       end loop;
1447    end Spaces;
1448
1449    ---------------
1450    -- Tree_Read --
1451    ---------------
1452
1453    procedure Tree_Read is
1454    begin
1455       Rep_Table.Tree_Read;
1456    end Tree_Read;
1457
1458    ----------------
1459    -- Tree_Write --
1460    ----------------
1461
1462    procedure Tree_Write is
1463    begin
1464       Rep_Table.Tree_Write;
1465    end Tree_Write;
1466
1467    ---------------------
1468    -- Write_Info_Line --
1469    ---------------------
1470
1471    procedure Write_Info_Line (S : String) is
1472    begin
1473       Write_Repinfo_Line_Access.all (S (S'First .. S'Last - 1));
1474    end Write_Info_Line;
1475
1476    ---------------------
1477    -- Write_Mechanism --
1478    ---------------------
1479
1480    procedure Write_Mechanism (M : Mechanism_Type) is
1481    begin
1482       case M is
1483          when 0 =>
1484             Write_Str ("default");
1485
1486          when -1 =>
1487             Write_Str ("copy");
1488
1489          when -2 =>
1490             Write_Str ("reference");
1491
1492          when others =>
1493             raise Program_Error;
1494       end case;
1495    end Write_Mechanism;
1496
1497    ---------------
1498    -- Write_Val --
1499    ---------------
1500
1501    procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False) is
1502    begin
1503       if Rep_Not_Constant (Val) then
1504          if List_Representation_Info < 3 or else Val = No_Uint then
1505             Write_Str ("??");
1506
1507          else
1508             if Back_End_Layout then
1509                Write_Char (' ');
1510
1511                if Paren then
1512                   Write_Char ('(');
1513                   List_GCC_Expression (Val);
1514                   Write_Char (')');
1515                else
1516                   List_GCC_Expression (Val);
1517                end if;
1518
1519                Write_Char (' ');
1520
1521             else
1522                if Paren then
1523                   Write_Char ('(');
1524                   Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
1525                   Write_Char (')');
1526                else
1527                   Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
1528                end if;
1529             end if;
1530          end if;
1531
1532       else
1533          UI_Write (Val);
1534       end if;
1535    end Write_Val;
1536
1537 end Repinfo;