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_Protected             =>
 724             Write_Line ("Protected");
 725          when Convention_Assembler             =>
 726             Write_Line ("Assembler");
 727          when Convention_C                     =>
 728             Write_Line ("C");
 729          when Convention_CIL                   =>
 730             Write_Line ("CIL");
 731          when Convention_COBOL                 =>
 732             Write_Line ("COBOL");
 733          when Convention_CPP                   =>
 734             Write_Line ("C++");
 735          when Convention_Fortran               =>
 736             Write_Line ("Fortran");
 737          when Convention_Java                  =>
 738             Write_Line ("Java");
 739          when Convention_Stdcall               =>
 740             Write_Line ("Stdcall");
 741          when Convention_Stubbed               =>
 742             Write_Line ("Stubbed");
 743       end case;
 744
 745       --  Find max length of formal name
 746
 747       Plen := 0;
 748       Form := First_Formal (Ent);
 749       while Present (Form) loop
 750          Get_Unqualified_Decoded_Name_String (Chars (Form));
 751
 752          if Name_Len > Plen then
 753             Plen := Name_Len;
 754          end if;
 755
 756          Next_Formal (Form);
 757       end loop;
 758
 759       --  Output formals and mechanisms
 760
 761       Form := First_Formal (Ent);
 762       while Present (Form) loop
 763          Get_Unqualified_Decoded_Name_String (Chars (Form));
 764          while Name_Len <= Plen loop
 765             Name_Len := Name_Len + 1;
 766             Name_Buffer (Name_Len) := ' ';
 767          end loop;
 768
 769          Write_Str ("  ");
 770          Write_Str (Name_Buffer (1 .. Plen + 1));
 771          Write_Str (": passed by ");
 772
 773          Write_Mechanism (Mechanism (Form));
 774          Write_Eol;
 775          Next_Formal (Form);
 776       end loop;
 777
 778       if Etype (Ent) /= Standard_Void_Type then
 779          Write_Str ("  returns by ");
 780          Write_Mechanism (Mechanism (Ent));
 781          Write_Eol;
 782       end if;
 783    end List_Mechanisms;
 784
 785    ---------------
 786    -- List_Name --
 787    ---------------
 788
 789    procedure List_Name (Ent : Entity_Id) is
 790    begin
 791       if not Is_Compilation_Unit (Scope (Ent)) then
 792          List_Name (Scope (Ent));
 793          Write_Char ('.');
 794       end if;
 795
 796       Get_Unqualified_Decoded_Name_String (Chars (Ent));
 797       Set_Casing (Unit_Casing);
 798       Write_Str (Name_Buffer (1 .. Name_Len));
 799    end List_Name;
 800
 801    ---------------------
 802    -- List_Object_Info --
 803    ---------------------
 804
 805    procedure List_Object_Info (Ent : Entity_Id) is
 806    begin
 807       Blank_Line;
 808
 809       Write_Str ("for ");
 810       List_Name (Ent);
 811       Write_Str ("'Size use ");
 812       Write_Val (Esize (Ent));
 813       Write_Line (";");
 814
 815       Write_Str ("for ");
 816       List_Name (Ent);
 817       Write_Str ("'Alignment use ");
 818       Write_Val (Alignment (Ent));
 819       Write_Line (";");
 820    end List_Object_Info;
 821
 822    ----------------------
 823    -- List_Record_Info --
 824    ----------------------
 825
 826    procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
 827       Comp  : Entity_Id;
 828       Cfbit : Uint;
 829       Sunit : Uint;
 830
 831       Max_Name_Length : Natural;
 832       Max_Suni_Length : Natural;
 833
 834    begin
 835       Blank_Line;
 836       List_Type_Info (Ent);
 837
 838       Write_Str ("for ");
 839       List_Name (Ent);
 840       Write_Line (" use record");
 841
 842       --  First loop finds out max line length and max starting position
 843       --  length, for the purpose of lining things up nicely.
 844
 845       Max_Name_Length := 0;
 846       Max_Suni_Length := 0;
 847
 848       Comp := First_Component_Or_Discriminant (Ent);
 849       while Present (Comp) loop
 850
 851          --  Skip discriminant in unchecked union (since it is not there!)
 852
 853          if Ekind (Comp) = E_Discriminant
 854            and then Is_Unchecked_Union (Ent)
 855          then
 856             null;
 857
 858          --  All other cases
 859
 860          else
 861             Get_Decoded_Name_String (Chars (Comp));
 862             Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
 863
 864             Cfbit := Component_Bit_Offset (Comp);
 865
 866             if Rep_Not_Constant (Cfbit) then
 867                UI_Image_Length := 2;
 868
 869             else
 870                --  Complete annotation in case not done
 871
 872                Set_Normalized_Position (Comp, Cfbit / SSU);
 873                Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
 874
 875                Sunit := Cfbit / SSU;
 876                UI_Image (Sunit);
 877             end if;
 878
 879             --  If the record is not packed, then we know that all fields
 880             --  whose position is not specified have a starting normalized
 881             --  bit position of zero.
 882
 883             if Unknown_Normalized_First_Bit (Comp)
 884               and then not Is_Packed (Ent)
 885             then
 886                Set_Normalized_First_Bit (Comp, Uint_0);
 887             end if;
 888
 889             Max_Suni_Length :=
 890               Natural'Max (Max_Suni_Length, UI_Image_Length);
 891          end if;
 892
 893          Next_Component_Or_Discriminant (Comp);
 894       end loop;
 895
 896       --  Second loop does actual output based on those values
 897
 898       Comp := First_Component_Or_Discriminant (Ent);
 899       while Present (Comp) loop
 900
 901          --  Skip discriminant in unchecked union (since it is not there!)
 902
 903          if Ekind (Comp) = E_Discriminant
 904            and then Is_Unchecked_Union (Ent)
 905          then
 906             goto Continue;
 907          end if;
 908
 909          --  All other cases
 910
 911          declare
 912             Esiz : constant Uint := Esize (Comp);
 913             Bofs : constant Uint := Component_Bit_Offset (Comp);
 914             Npos : constant Uint := Normalized_Position (Comp);
 915             Fbit : constant Uint := Normalized_First_Bit (Comp);
 916             Lbit : Uint;
 917
 918          begin
 919             Write_Str ("   ");
 920             Get_Decoded_Name_String (Chars (Comp));
 921             Set_Casing (Unit_Casing);
 922             Write_Str (Name_Buffer (1 .. Name_Len));
 923
 924             for J in 1 .. Max_Name_Length - Name_Len loop
 925                Write_Char (' ');
 926             end loop;
 927
 928             Write_Str (" at ");
 929
 930             if Known_Static_Normalized_Position (Comp) then
 931                UI_Image (Npos);
 932                Spaces (Max_Suni_Length - UI_Image_Length);
 933                Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
 934
 935             elsif Known_Component_Bit_Offset (Comp)
 936               and then List_Representation_Info = 3
 937             then
 938                Spaces (Max_Suni_Length - 2);
 939                Write_Str ("bit offset");
 940                Write_Val (Bofs, Paren => True);
 941                Write_Str (" size in bits = ");
 942                Write_Val (Esiz, Paren => True);
 943                Write_Eol;
 944                goto Continue;
 945
 946             elsif Known_Normalized_Position (Comp)
 947               and then List_Representation_Info = 3
 948             then
 949                Spaces (Max_Suni_Length - 2);
 950                Write_Val (Npos);
 951
 952             else
 953                --  For the packed case, we don't know the bit positions if we
 954                --  don't know the starting position.
 955
 956                if Is_Packed (Ent) then
 957                   Write_Line ("?? range  ? .. ??;");
 958                   goto Continue;
 959
 960                --  Otherwise we can continue
 961
 962                else
 963                   Write_Str ("??");
 964                end if;
 965             end if;
 966
 967             Write_Str (" range  ");
 968             UI_Write (Fbit);
 969             Write_Str (" .. ");
 970
 971             --  Allowing Uint_0 here is an annoying special case. Really this
 972             --  should be a fine Esize value but currently it means unknown,
 973             --  except that we know after gigi has back annotated that a size
 974             --  of zero is real, since otherwise gigi back annotates using
 975             --  No_Uint as the value to indicate unknown).
 976
 977             if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
 978               and then Known_Static_Normalized_First_Bit (Comp)
 979             then
 980                Lbit := Fbit + Esiz - 1;
 981
 982                if Lbit < 10 then
 983                   Write_Char (' ');
 984                end if;
 985
 986                UI_Write (Lbit);
 987
 988             --  The test for Esize (Comp) not Uint_0 here is an annoying
 989             --  special case. Officially a value of zero for Esize means
 990             --  unknown, but here we use the fact that we know that gigi
 991             --  annotates Esize with No_Uint, not Uint_0. Really everyone
 992             --  should use No_Uint???
 993
 994             elsif List_Representation_Info < 3
 995               or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
 996             then
 997                Write_Str ("??");
 998
 999             --  List_Representation >= 3 and Known_Esize (Comp)
1000
1001             else
1002                Write_Val (Esiz, Paren => True);
1003
1004                --  If in front end layout mode, then dynamic size is stored
1005                --  in storage units, so renormalize for output
1006
1007                if not Back_End_Layout then
1008                   Write_Str (" * ");
1009                   Write_Int (SSU);
1010                end if;
1011
1012                --  Add appropriate first bit offset
1013
1014                if Fbit = 0 then
1015                   Write_Str (" - 1");
1016
1017                elsif Fbit = 1 then
1018                   null;
1019
1020                else
1021                   Write_Str (" + ");
1022                   Write_Int (UI_To_Int (Fbit) - 1);
1023                end if;
1024             end if;
1025
1026             Write_Line (";");
1027          end;
1028
1029       <<Continue>>
1030          Next_Component_Or_Discriminant (Comp);
1031       end loop;
1032
1033       Write_Line ("end record;");
1034
1035       List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
1036    end List_Record_Info;
1037
1038    -------------------
1039    -- List_Rep_Info --
1040    -------------------
1041
1042    procedure List_Rep_Info (Bytes_Big_Endian : Boolean) is
1043       Col : Nat;
1044
1045    begin
1046       if List_Representation_Info /= 0
1047         or else List_Representation_Info_Mechanisms
1048       then
1049          for U in Main_Unit .. Last_Unit loop
1050             if In_Extended_Main_Source_Unit (Cunit_Entity (U)) then
1051                Unit_Casing := Identifier_Casing (Source_Index (U));
1052
1053                --  Normal case, list to standard output
1054
1055                if not List_Representation_Info_To_File then
1056                   Write_Eol;
1057                   Write_Str ("Representation information for unit ");
1058                   Write_Unit_Name (Unit_Name (U));
1059                   Col := Column;
1060                   Write_Eol;
1061
1062                   for J in 1 .. Col - 1 loop
1063                      Write_Char ('-');
1064                   end loop;
1065
1066                   Write_Eol;
1067                   List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1068
1069                --  List representation information to file
1070
1071                else
1072                   Create_Repinfo_File_Access.all
1073                     (Get_Name_String (File_Name (Source_Index (U))));
1074                   Set_Special_Output (Write_Info_Line'Access);
1075                   List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1076                   Set_Special_Output (null);
1077                   Close_Repinfo_File_Access.all;
1078                end if;
1079             end if;
1080          end loop;
1081       end if;
1082    end List_Rep_Info;
1083
1084    -------------------------------
1085    -- List_Scalar_Storage_Order --
1086    -------------------------------
1087
1088    procedure List_Scalar_Storage_Order
1089      (Ent              : Entity_Id;
1090       Bytes_Big_Endian : Boolean)
1091    is
1092       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean);
1093       --  Show attribute definition clause for Attr_Name (an endianness
1094       --  attribute), depending on whether or not the endianness is reversed
1095       --  compared to native endianness.
1096
1097       ---------------
1098       -- List_Attr --
1099       ---------------
1100
1101       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean) is
1102       begin
1103          Write_Str ("for ");
1104          List_Name (Ent);
1105          Write_Str ("'" & Attr_Name & " use System.");
1106
1107          if Bytes_Big_Endian xor Is_Reversed then
1108             Write_Str ("High");
1109          else
1110             Write_Str ("Low");
1111          end if;
1112
1113          Write_Line ("_Order_First;");
1114       end List_Attr;
1115
1116       List_SSO : constant Boolean :=
1117                    Has_Rep_Item (Ent, Name_Scalar_Storage_Order)
1118                      or else SSO_Set_Low_By_Default  (Ent)
1119                      or else SSO_Set_High_By_Default (Ent);
1120       --  Scalar_Storage_Order is displayed if specified explicitly
1121       --  or set by Default_Scalar_Storage_Order.
1122
1123    --  Start of processing for List_Scalar_Storage_Order
1124
1125    begin
1126       --  For record types, list Bit_Order if not default, or if SSO is shown
1127
1128       if Is_Record_Type (Ent)
1129         and then (List_SSO or else Reverse_Bit_Order (Ent))
1130       then
1131          List_Attr ("Bit_Order", Reverse_Bit_Order (Ent));
1132       end if;
1133
1134       --  List SSO if required. If not, then storage is supposed to be in
1135       --  native order.
1136
1137       if List_SSO then
1138          List_Attr ("Scalar_Storage_Order", Reverse_Storage_Order (Ent));
1139       else
1140          pragma Assert (not Reverse_Storage_Order (Ent));
1141          null;
1142       end if;
1143    end List_Scalar_Storage_Order;
1144
1145    --------------------
1146    -- List_Type_Info --
1147    --------------------
1148
1149    procedure List_Type_Info (Ent : Entity_Id) is
1150    begin
1151       Blank_Line;
1152
1153       --  Do not list size info for unconstrained arrays, not meaningful
1154
1155       if Is_Array_Type (Ent) and then not Is_Constrained (Ent) then
1156          null;
1157
1158       else
1159          --  If Esize and RM_Size are the same and known, list as Size. This
1160          --  is a common case, which we may as well list in simple form.
1161
1162          if Esize (Ent) = RM_Size (Ent) then
1163             Write_Str ("for ");
1164             List_Name (Ent);
1165             Write_Str ("'Size use ");
1166             Write_Val (Esize (Ent));
1167             Write_Line (";");
1168
1169          --  For now, temporary case, to be removed when gigi properly back
1170          --  annotates RM_Size, if RM_Size is not set, then list Esize as Size.
1171          --  This avoids odd Object_Size output till we fix things???
1172
1173          elsif Unknown_RM_Size (Ent) then
1174             Write_Str ("for ");
1175             List_Name (Ent);
1176             Write_Str ("'Size use ");
1177             Write_Val (Esize (Ent));
1178             Write_Line (";");
1179
1180          --  Otherwise list size values separately if they are set
1181
1182          else
1183             Write_Str ("for ");
1184             List_Name (Ent);
1185             Write_Str ("'Object_Size use ");
1186             Write_Val (Esize (Ent));
1187             Write_Line (";");
1188
1189             --  Note on following check: The RM_Size of a discrete type can
1190             --  legitimately be set to zero, so a special check is needed.
1191
1192             Write_Str ("for ");
1193             List_Name (Ent);
1194             Write_Str ("'Value_Size use ");
1195             Write_Val (RM_Size (Ent));
1196             Write_Line (";");
1197          end if;
1198       end if;
1199
1200       Write_Str ("for ");
1201       List_Name (Ent);
1202       Write_Str ("'Alignment use ");
1203       Write_Val (Alignment (Ent));
1204       Write_Line (";");
1205
1206       --  Special stuff for fixed-point
1207
1208       if Is_Fixed_Point_Type (Ent) then
1209
1210          --  Write small (always a static constant)
1211
1212          Write_Str ("for ");
1213          List_Name (Ent);
1214          Write_Str ("'Small use ");
1215          UR_Write (Small_Value (Ent));
1216          Write_Line (";");
1217
1218          --  Write range if static
1219
1220          declare
1221             R : constant Node_Id := Scalar_Range (Ent);
1222
1223          begin
1224             if Nkind (Low_Bound (R)) = N_Real_Literal
1225                  and then
1226                Nkind (High_Bound (R)) = N_Real_Literal
1227             then
1228                Write_Str ("for ");
1229                List_Name (Ent);
1230                Write_Str ("'Range use ");
1231                UR_Write (Realval (Low_Bound (R)));
1232                Write_Str (" .. ");
1233                UR_Write (Realval (High_Bound (R)));
1234                Write_Line (";");
1235             end if;
1236          end;
1237       end if;
1238    end List_Type_Info;
1239
1240    ----------------------
1241    -- Rep_Not_Constant --
1242    ----------------------
1243
1244    function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean is
1245    begin
1246       if Val = No_Uint or else Val < 0 then
1247          return True;
1248       else
1249          return False;
1250       end if;
1251    end Rep_Not_Constant;
1252
1253    ---------------
1254    -- Rep_Value --
1255    ---------------
1256
1257    function Rep_Value
1258      (Val : Node_Ref_Or_Val;
1259       D   : Discrim_List) return Uint
1260    is
1261       function B (Val : Boolean) return Uint;
1262       --  Returns Uint_0 for False, Uint_1 for True
1263
1264       function T (Val : Node_Ref_Or_Val) return Boolean;
1265       --  Returns True for 0, False for any non-zero (i.e. True)
1266
1267       function V (Val : Node_Ref_Or_Val) return Uint;
1268       --  Internal recursive routine to evaluate tree
1269
1270       function W (Val : Uint) return Word;
1271       --  Convert Val to Word, assuming Val is always in the Int range. This
1272       --  is a helper function for the evaluation of bitwise expressions like
1273       --  Bit_And_Expr, for which there is no direct support in uintp. Uint
1274       --  values out of the Int range are expected to be seen in such
1275       --  expressions only with overflowing byte sizes around, introducing
1276       --  inherent unreliabilities in computations anyway.
1277
1278       -------
1279       -- B --
1280       -------
1281
1282       function B (Val : Boolean) return Uint is
1283       begin
1284          if Val then
1285             return Uint_1;
1286          else
1287             return Uint_0;
1288          end if;
1289       end B;
1290
1291       -------
1292       -- T --
1293       -------
1294
1295       function T (Val : Node_Ref_Or_Val) return Boolean is
1296       begin
1297          if V (Val) = 0 then
1298             return False;
1299          else
1300             return True;
1301          end if;
1302       end T;
1303
1304       -------
1305       -- V --
1306       -------
1307
1308       function V (Val : Node_Ref_Or_Val) return Uint is
1309          L, R, Q : Uint;
1310
1311       begin
1312          if Val >= 0 then
1313             return Val;
1314
1315          else
1316             declare
1317                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
1318
1319             begin
1320                case Node.Expr is
1321                   when Cond_Expr =>
1322                      if T (Node.Op1) then
1323                         return V (Node.Op2);
1324                      else
1325                         return V (Node.Op3);
1326                      end if;
1327
1328                   when Plus_Expr =>
1329                      return V (Node.Op1) + V (Node.Op2);
1330
1331                   when Minus_Expr =>
1332                      return V (Node.Op1) - V (Node.Op2);
1333
1334                   when Mult_Expr =>
1335                      return V (Node.Op1) * V (Node.Op2);
1336
1337                   when Trunc_Div_Expr =>
1338                      return V (Node.Op1) / V (Node.Op2);
1339
1340                   when Ceil_Div_Expr =>
1341                      return
1342                        UR_Ceiling
1343                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
1344
1345                   when Floor_Div_Expr =>
1346                      return
1347                        UR_Floor
1348                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
1349
1350                   when Trunc_Mod_Expr =>
1351                      return V (Node.Op1) rem V (Node.Op2);
1352
1353                   when Floor_Mod_Expr =>
1354                      return V (Node.Op1) mod V (Node.Op2);
1355
1356                   when Ceil_Mod_Expr =>
1357                      L := V (Node.Op1);
1358                      R := V (Node.Op2);
1359                      Q := UR_Ceiling (L / UR_From_Uint (R));
1360                      return L - R * Q;
1361
1362                   when Exact_Div_Expr =>
1363                      return V (Node.Op1) / V (Node.Op2);
1364
1365                   when Negate_Expr =>
1366                      return -V (Node.Op1);
1367
1368                   when Min_Expr =>
1369                      return UI_Min (V (Node.Op1), V (Node.Op2));
1370
1371                   when Max_Expr =>
1372                      return UI_Max (V (Node.Op1), V (Node.Op2));
1373
1374                   when Abs_Expr =>
1375                      return UI_Abs (V (Node.Op1));
1376
1377                   when Truth_Andif_Expr =>
1378                      return B (T (Node.Op1) and then T (Node.Op2));
1379
1380                   when Truth_Orif_Expr =>
1381                      return B (T (Node.Op1) or else T (Node.Op2));
1382
1383                   when Truth_And_Expr =>
1384                      return B (T (Node.Op1) and then T (Node.Op2));
1385
1386                   when Truth_Or_Expr =>
1387                      return B (T (Node.Op1) or else T (Node.Op2));
1388
1389                   when Truth_Xor_Expr =>
1390                      return B (T (Node.Op1) xor T (Node.Op2));
1391
1392                   when Truth_Not_Expr =>
1393                      return B (not T (Node.Op1));
1394
1395                   when Bit_And_Expr =>
1396                      L := V (Node.Op1);
1397                      R := V (Node.Op2);
1398                      return UI_From_Int (Int (W (L) and W (R)));
1399
1400                   when Lt_Expr =>
1401                      return B (V (Node.Op1) < V (Node.Op2));
1402
1403                   when Le_Expr =>
1404                      return B (V (Node.Op1) <= V (Node.Op2));
1405
1406                   when Gt_Expr =>
1407                      return B (V (Node.Op1) > V (Node.Op2));
1408
1409                   when Ge_Expr =>
1410                      return B (V (Node.Op1) >= V (Node.Op2));
1411
1412                   when Eq_Expr =>
1413                      return B (V (Node.Op1) = V (Node.Op2));
1414
1415                   when Ne_Expr =>
1416                      return B (V (Node.Op1) /= V (Node.Op2));
1417
1418                   when Discrim_Val =>
1419                      declare
1420                         Sub : constant Int := UI_To_Int (Node.Op1);
1421                      begin
1422                         pragma Assert (Sub in D'Range);
1423                         return D (Sub);
1424                      end;
1425
1426                end case;
1427             end;
1428          end if;
1429       end V;
1430
1431       -------
1432       -- W --
1433       -------
1434
1435       --  We use an unchecked conversion to map Int values to their Word
1436       --  bitwise equivalent, which we could not achieve with a normal type
1437       --  conversion for negative Ints. We want bitwise equivalents because W
1438       --  is used as a helper for bit operators like Bit_And_Expr, and can be
1439       --  called for negative Ints in the context of aligning expressions like
1440       --  X+Align & -Align.
1441
1442       function W (Val : Uint) return Word is
1443          function To_Word is new Ada.Unchecked_Conversion (Int, Word);
1444       begin
1445          return To_Word (UI_To_Int (Val));
1446       end W;
1447
1448    --  Start of processing for Rep_Value
1449
1450    begin
1451       if Val = No_Uint then
1452          return No_Uint;
1453
1454       else
1455          return V (Val);
1456       end if;
1457    end Rep_Value;
1458
1459    ------------
1460    -- Spaces --
1461    ------------
1462
1463    procedure Spaces (N : Natural) is
1464    begin
1465       for J in 1 .. N loop
1466          Write_Char (' ');
1467       end loop;
1468    end Spaces;
1469
1470    ---------------
1471    -- Tree_Read --
1472    ---------------
1473
1474    procedure Tree_Read is
1475    begin
1476       Rep_Table.Tree_Read;
1477    end Tree_Read;
1478
1479    ----------------
1480    -- Tree_Write --
1481    ----------------
1482
1483    procedure Tree_Write is
1484    begin
1485       Rep_Table.Tree_Write;
1486    end Tree_Write;
1487
1488    ---------------------
1489    -- Write_Info_Line --
1490    ---------------------
1491
1492    procedure Write_Info_Line (S : String) is
1493    begin
1494       Write_Repinfo_Line_Access.all (S (S'First .. S'Last - 1));
1495    end Write_Info_Line;
1496
1497    ---------------------
1498    -- Write_Mechanism --
1499    ---------------------
1500
1501    procedure Write_Mechanism (M : Mechanism_Type) is
1502    begin
1503       case M is
1504          when 0 =>
1505             Write_Str ("default");
1506
1507          when -1 =>
1508             Write_Str ("copy");
1509
1510          when -2 =>
1511             Write_Str ("reference");
1512
1513          when others =>
1514             raise Program_Error;
1515       end case;
1516    end Write_Mechanism;
1517
1518    ---------------
1519    -- Write_Val --
1520    ---------------
1521
1522    procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False) is
1523    begin
1524       if Rep_Not_Constant (Val) then
1525          if List_Representation_Info < 3 or else Val = No_Uint then
1526             Write_Str ("??");
1527
1528          else
1529             if Back_End_Layout then
1530                Write_Char (' ');
1531
1532                if Paren then
1533                   Write_Char ('(');
1534                   List_GCC_Expression (Val);
1535                   Write_Char (')');
1536                else
1537                   List_GCC_Expression (Val);
1538                end if;
1539
1540                Write_Char (' ');
1541
1542             else
1543                if Paren then
1544                   Write_Char ('(');
1545                   Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
1546                   Write_Char (')');
1547                else
1548                   Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
1549                end if;
1550             end if;
1551          end if;
1552
1553       else
1554          UI_Write (Val);
1555       end if;
1556    end Write_Val;
1557
1558 end Repinfo;