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