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