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-2018, 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;
  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;
  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    --    A table internal to this unit is used to hold the values of back
  66    --    annotated expressions. This table is written out by -gnatt and read
  67    --    back in for ASIS processing.
  68
  69    --    Node values are stored as Uint values using the negative of the node
  70    --    index in this table. Constants appear as non-negative Uint values.
  71
  72    type Exp_Node is record
  73       Expr : TCode;
  74       Op1  : Node_Ref_Or_Val;
  75       Op2  : Node_Ref_Or_Val;
  76       Op3  : Node_Ref_Or_Val;
  77    end record;
  78
  79    --  The following representation clause ensures that the above record
  80    --  has no holes. We do this so that when instances of this record are
  81    --  written by Tree_Gen, we do not write uninitialized values to the file.
  82
  83    for Exp_Node use record
  84       Expr at  0 range 0 .. 31;
  85       Op1  at  4 range 0 .. 31;
  86       Op2  at  8 range 0 .. 31;
  87       Op3  at 12 range 0 .. 31;
  88    end record;
  89
  90    for Exp_Node'Size use 16 * 8;
  91    --  This ensures that we did not leave out any fields
  92
  93    package Rep_Table is new Table.Table (
  94       Table_Component_Type => Exp_Node,
  95       Table_Index_Type     => Nat,
  96       Table_Low_Bound      => 1,
  97       Table_Initial        => Alloc.Rep_Table_Initial,
  98       Table_Increment      => Alloc.Rep_Table_Increment,
  99       Table_Name           => "BE_Rep_Table");
 100
 101    --------------------------------------------------------------
 102    -- Representation of Front-End Dynamic Size/Offset Entities --
 103    --------------------------------------------------------------
 104
 105    package Dynamic_SO_Entity_Table is new Table.Table (
 106       Table_Component_Type => Entity_Id,
 107       Table_Index_Type     => Nat,
 108       Table_Low_Bound      => 1,
 109       Table_Initial        => Alloc.Rep_Table_Initial,
 110       Table_Increment      => Alloc.Rep_Table_Increment,
 111       Table_Name           => "FE_Rep_Table");
 112
 113    Unit_Casing : Casing_Type;
 114    --  Identifier casing for current unit. This is set by List_Rep_Info for
 115    --  each unit, before calling subprograms which may read it.
 116
 117    Need_Blank_Line : Boolean;
 118    --  Set True if a blank line is needed before outputting any information for
 119    --  the current entity. Set True when a new entity is processed, and false
 120    --  when the blank line is output.
 121
 122    -----------------------
 123    -- Local Subprograms --
 124    -----------------------
 125
 126    function Back_End_Layout return Boolean;
 127    --  Test for layout mode, True = back end, False = front end. This function
 128    --  is used rather than checking the configuration parameter because we do
 129    --  not want Repinfo to depend on Targparm (for ASIS)
 130
 131    procedure Blank_Line;
 132    --  Called before outputting anything for an entity. Ensures that
 133    --  a blank line precedes the output for a particular entity.
 134
 135    procedure List_Entities
 136      (Ent              : Entity_Id;
 137       Bytes_Big_Endian : Boolean;
 138       In_Subprogram    : Boolean := False);
 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    --  When recursing within a subprogram body, Is_Subprogram suppresses
 143    --  duplicate information about signature.
 144
 145    procedure List_Name (Ent : Entity_Id);
 146    --  List name of entity Ent in appropriate case. The name is listed with
 147    --  full qualification up to but not including the compilation unit name.
 148
 149    procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
 150    --  List representation info for array type Ent
 151
 152    procedure List_Linker_Section (Ent : Entity_Id);
 153    --  List linker section for Ent (caller has checked that Ent is an entity
 154    --  for which the Linker_Section_Pragma field is defined).
 155
 156    procedure List_Location (Ent : Entity_Id);
 157    --  List location information for Ent
 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_Unknown_Val;
 196    --  Writes symbolic string for an unknown or non-representable value
 197
 198    procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False);
 199    --  Given a representation value, write it out. No_Uint values or values
 200    --  dependent on discriminants are written as two question marks. If the
 201    --  flag Paren is set, then the output is surrounded in parentheses if it is
 202    --  other than a simple value.
 203
 204    ---------------------
 205    -- Back_End_Layout --
 206    ---------------------
 207
 208    function Back_End_Layout return Boolean is
 209    begin
 210       --  We have back-end layout if the back end has made any entries in the
 211       --  table of GCC expressions, otherwise we have front-end layout.
 212
 213       return Rep_Table.Last > 0;
 214    end Back_End_Layout;
 215
 216    ----------------
 217    -- Blank_Line --
 218    ----------------
 219
 220    procedure Blank_Line is
 221    begin
 222       if Need_Blank_Line then
 223          Write_Eol;
 224          Need_Blank_Line := False;
 225       end if;
 226    end Blank_Line;
 227
 228    ------------------------
 229    -- Create_Discrim_Ref --
 230    ------------------------
 231
 232    function Create_Discrim_Ref (Discr : Entity_Id) return Node_Ref is
 233    begin
 234       return Create_Node
 235         (Expr => Discrim_Val,
 236          Op1  => Discriminant_Number (Discr));
 237    end Create_Discrim_Ref;
 238
 239    ---------------------------
 240    -- Create_Dynamic_SO_Ref --
 241    ---------------------------
 242
 243    function Create_Dynamic_SO_Ref (E : Entity_Id) return Dynamic_SO_Ref is
 244    begin
 245       Dynamic_SO_Entity_Table.Append (E);
 246       return UI_From_Int (-Dynamic_SO_Entity_Table.Last);
 247    end Create_Dynamic_SO_Ref;
 248
 249    -----------------
 250    -- Create_Node --
 251    -----------------
 252
 253    function Create_Node
 254      (Expr : TCode;
 255       Op1  : Node_Ref_Or_Val;
 256       Op2  : Node_Ref_Or_Val := No_Uint;
 257       Op3  : Node_Ref_Or_Val := No_Uint) return Node_Ref
 258    is
 259    begin
 260       Rep_Table.Append (
 261         (Expr => Expr,
 262          Op1  => Op1,
 263          Op2  => Op2,
 264          Op3  => Op3));
 265       return UI_From_Int (-Rep_Table.Last);
 266    end Create_Node;
 267
 268    ---------------------------
 269    -- Get_Dynamic_SO_Entity --
 270    ---------------------------
 271
 272    function Get_Dynamic_SO_Entity (U : Dynamic_SO_Ref) return Entity_Id is
 273    begin
 274       return Dynamic_SO_Entity_Table.Table (-UI_To_Int (U));
 275    end Get_Dynamic_SO_Entity;
 276
 277    -----------------------
 278    -- Is_Dynamic_SO_Ref --
 279    -----------------------
 280
 281    function Is_Dynamic_SO_Ref (U : SO_Ref) return Boolean is
 282    begin
 283       return U < Uint_0;
 284    end Is_Dynamic_SO_Ref;
 285
 286    ----------------------
 287    -- Is_Static_SO_Ref --
 288    ----------------------
 289
 290    function Is_Static_SO_Ref (U : SO_Ref) return Boolean is
 291    begin
 292       return U >= Uint_0;
 293    end Is_Static_SO_Ref;
 294
 295    ---------
 296    -- lgx --
 297    ---------
 298
 299    procedure lgx (U : Node_Ref_Or_Val) is
 300    begin
 301       List_GCC_Expression (U);
 302       Write_Eol;
 303    end lgx;
 304
 305    ----------------------
 306    -- List_Array_Info --
 307    ----------------------
 308
 309    procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
 310    begin
 311       Blank_Line;
 312
 313       if List_Representation_Info_To_JSON then
 314          Write_Line ("{");
 315       end if;
 316
 317       List_Type_Info (Ent);
 318
 319       if List_Representation_Info_To_JSON then
 320          Write_Line (",");
 321          Write_Str ("  ""Component_Size"": ");
 322          Write_Val (Component_Size (Ent));
 323       else
 324          Write_Str ("for ");
 325          List_Name (Ent);
 326          Write_Str ("'Component_Size use ");
 327          Write_Val (Component_Size (Ent));
 328          Write_Line (";");
 329       end if;
 330
 331       List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
 332
 333       List_Linker_Section (Ent);
 334
 335       if List_Representation_Info_To_JSON then
 336          Write_Eol;
 337          Write_Line ("}");
 338       end if;
 339    end List_Array_Info;
 340
 341    -------------------
 342    -- List_Entities --
 343    -------------------
 344
 345    procedure List_Entities
 346      (Ent              : Entity_Id;
 347       Bytes_Big_Endian : Boolean;
 348       In_Subprogram    : Boolean := False)
 349    is
 350       Body_E : Entity_Id;
 351       E      : Entity_Id;
 352
 353       function Find_Declaration (E : Entity_Id) return Node_Id;
 354       --  Utility to retrieve declaration node for entity in the
 355       --  case of package bodies and subprograms.
 356
 357       ----------------------
 358       -- Find_Declaration --
 359       ----------------------
 360
 361       function Find_Declaration (E : Entity_Id) return Node_Id is
 362          Decl : Node_Id;
 363
 364       begin
 365          Decl := Parent (E);
 366          while Present (Decl)
 367            and then Nkind (Decl) /= N_Package_Body
 368            and then Nkind (Decl) /= N_Subprogram_Declaration
 369            and then Nkind (Decl) /= N_Subprogram_Body
 370          loop
 371             Decl := Parent (Decl);
 372          end loop;
 373
 374          return Decl;
 375       end Find_Declaration;
 376
 377    --  Start of processing for List_Entities
 378
 379    begin
 380       --  List entity if we have one, and it is not a renaming declaration.
 381       --  For renamings, we don't get proper information, and really it makes
 382       --  sense to restrict the output to the renamed entity.
 383
 384       if Present (Ent)
 385         and then Nkind (Declaration_Node (Ent)) not in N_Renaming_Declaration
 386       then
 387          --  If entity is a subprogram and we are listing mechanisms,
 388          --  then we need to list mechanisms for this entity. We skip this
 389          --  if it is a nested subprogram, as the information has already
 390          --  been produced when listing the enclosing scope.
 391
 392          if List_Representation_Info_Mechanisms
 393            and then (Is_Subprogram (Ent)
 394                       or else Ekind (Ent) = E_Entry
 395                       or else Ekind (Ent) = E_Entry_Family)
 396            and then not In_Subprogram
 397          then
 398             Need_Blank_Line := True;
 399             List_Mechanisms (Ent);
 400          end if;
 401
 402          E := First_Entity (Ent);
 403          while Present (E) loop
 404             Need_Blank_Line := True;
 405
 406             --  We list entities that come from source (excluding private or
 407             --  incomplete types or deferred constants, where we will list the
 408             --  info for the full view). If debug flag A is set, then all
 409             --  entities are listed
 410
 411             if ((Comes_From_Source (E)
 412                    or else (Ekind (E) = E_Block
 413                               and then
 414                             Nkind (Parent (E)) = N_Implicit_Label_Declaration
 415                               and then
 416                             Comes_From_Source (Label_Construct (Parent (E)))))
 417               and then not Is_Incomplete_Or_Private_Type (E)
 418               and then not (Ekind (E) = E_Constant
 419                               and then Present (Full_View (E))))
 420               or else Debug_Flag_AA
 421             then
 422                if Is_Subprogram (E) then
 423                   if List_Representation_Info_Mechanisms then
 424                      List_Mechanisms (E);
 425                   end if;
 426
 427                   --  Recurse into entities local to subprogram
 428
 429                   List_Entities (E, Bytes_Big_Endian, True);
 430
 431                elsif Ekind (E) in Formal_Kind and then In_Subprogram then
 432                   null;
 433
 434                elsif Ekind_In (E, E_Entry,
 435                                   E_Entry_Family,
 436                                   E_Subprogram_Type)
 437                then
 438                   if List_Representation_Info_Mechanisms then
 439                      List_Mechanisms (E);
 440                   end if;
 441
 442                elsif Is_Record_Type (E) then
 443                   if List_Representation_Info >= 1 then
 444                      List_Record_Info (E, Bytes_Big_Endian);
 445                   end if;
 446
 447                elsif Is_Array_Type (E) then
 448                   if List_Representation_Info >= 1 then
 449                      List_Array_Info (E, Bytes_Big_Endian);
 450                   end if;
 451
 452                elsif Is_Type (E) then
 453                   if List_Representation_Info >= 2 then
 454                      Blank_Line;
 455                      if List_Representation_Info_To_JSON then
 456                         Write_Line ("{");
 457                      end if;
 458                      List_Type_Info (E);
 459                      List_Linker_Section (E);
 460                      if List_Representation_Info_To_JSON then
 461                         Write_Eol;
 462                         Write_Line ("}");
 463                      end if;
 464                   end if;
 465
 466                elsif Ekind_In (E, E_Variable, E_Constant) then
 467                   if List_Representation_Info >= 2 then
 468                      List_Object_Info (E);
 469                   end if;
 470
 471                elsif Ekind (E) = E_Loop_Parameter or else Is_Formal (E) then
 472                   if List_Representation_Info >= 2 then
 473                      List_Object_Info (E);
 474                   end if;
 475                end if;
 476
 477                --  Recurse into nested package, but not if they are package
 478                --  renamings (in particular renamings of the enclosing package,
 479                --  as for some Java bindings and for generic instances).
 480
 481                if Ekind (E) = E_Package then
 482                   if No (Renamed_Object (E)) then
 483                      List_Entities (E, Bytes_Big_Endian);
 484                   end if;
 485
 486                --  Recurse into bodies
 487
 488                elsif Ekind_In (E, E_Protected_Type,
 489                                   E_Task_Type,
 490                                   E_Subprogram_Body,
 491                                   E_Package_Body,
 492                                   E_Task_Body,
 493                                   E_Protected_Body)
 494                then
 495                   List_Entities (E, Bytes_Big_Endian);
 496
 497                --  Recurse into blocks
 498
 499                elsif Ekind (E) = E_Block then
 500                   List_Entities (E, Bytes_Big_Endian);
 501                end if;
 502             end if;
 503
 504             E := Next_Entity (E);
 505          end loop;
 506
 507          --  For a package body, the entities of the visible subprograms are
 508          --  declared in the corresponding spec. Iterate over its entities in
 509          --  order to handle properly the subprogram bodies. Skip bodies in
 510          --  subunits, which are listed independently.
 511
 512          if Ekind (Ent) = E_Package_Body
 513            and then Present (Corresponding_Spec (Find_Declaration (Ent)))
 514          then
 515             E := First_Entity (Corresponding_Spec (Find_Declaration (Ent)));
 516             while Present (E) loop
 517                if Is_Subprogram (E)
 518                  and then
 519                    Nkind (Find_Declaration (E)) = N_Subprogram_Declaration
 520                then
 521                   Body_E := Corresponding_Body (Find_Declaration (E));
 522
 523                   if Present (Body_E)
 524                     and then
 525                       Nkind (Parent (Find_Declaration (Body_E))) /= N_Subunit
 526                   then
 527                      List_Entities (Body_E, Bytes_Big_Endian);
 528                   end if;
 529                end if;
 530
 531                Next_Entity (E);
 532             end loop;
 533          end if;
 534       end if;
 535    end List_Entities;
 536
 537    -------------------------
 538    -- List_GCC_Expression --
 539    -------------------------
 540
 541    procedure List_GCC_Expression (U : Node_Ref_Or_Val) is
 542
 543       procedure Print_Expr (Val : Node_Ref_Or_Val);
 544       --  Internal recursive procedure to print expression
 545
 546       ----------------
 547       -- Print_Expr --
 548       ----------------
 549
 550       procedure Print_Expr (Val : Node_Ref_Or_Val) is
 551       begin
 552          if Val >= 0 then
 553             UI_Write (Val, Decimal);
 554
 555          else
 556             declare
 557                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
 558
 559                procedure Unop (S : String);
 560                --  Output text for unary operator with S being operator name
 561
 562                procedure Binop (S : String);
 563                --  Output text for binary operator with S being operator name
 564
 565                ----------
 566                -- Unop --
 567                ----------
 568
 569                procedure Unop (S : String) is
 570                begin
 571                   if List_Representation_Info_To_JSON then
 572                      Write_Str ("{ ""code"": """);
 573                      if S (S'Last) = ' ' then
 574                         Write_Str (S (S'First .. S'Last - 1));
 575                      else
 576                         Write_Str (S);
 577                      end if;
 578                      Write_Str (""", ""operands"": [ ");
 579                      Print_Expr (Node.Op1);
 580                      Write_Str (" ] }");
 581                   else
 582                      Write_Str (S);
 583                      Print_Expr (Node.Op1);
 584                   end if;
 585                end Unop;
 586
 587                -----------
 588                -- Binop --
 589                -----------
 590
 591                procedure Binop (S : String) is
 592                begin
 593                   if List_Representation_Info_To_JSON then
 594                      Write_Str ("{ ""code"": """);
 595                      Write_Str (S (S'First + 1 .. S'Last - 1));
 596                      Write_Str (""", ""operands"": [ ");
 597                      Print_Expr (Node.Op1);
 598                      Write_Str (", ");
 599                      Print_Expr (Node.Op2);
 600                      Write_Str (" ] }");
 601                   else
 602                      Write_Char ('(');
 603                      Print_Expr (Node.Op1);
 604                      Write_Str (S);
 605                      Print_Expr (Node.Op2);
 606                      Write_Char (')');
 607                   end if;
 608                end Binop;
 609
 610             --  Start of processing for Print_Expr
 611
 612             begin
 613                case Node.Expr is
 614                   when Cond_Expr =>
 615                      if List_Representation_Info_To_JSON then
 616                         Write_Str ("{ ""code"": ""?<>""");
 617                         Write_Str (", ""operands"": [ ");
 618                         Print_Expr (Node.Op1);
 619                         Write_Str (", ");
 620                         Print_Expr (Node.Op2);
 621                         Write_Str (", ");
 622                         Print_Expr (Node.Op3);
 623                         Write_Str (" ] }");
 624                      else
 625                         Write_Str ("(if ");
 626                         Print_Expr (Node.Op1);
 627                         Write_Str (" then ");
 628                         Print_Expr (Node.Op2);
 629                         Write_Str (" else ");
 630                         Print_Expr (Node.Op3);
 631                         Write_Str (" end)");
 632                      end if;
 633
 634                   when Plus_Expr =>
 635                      Binop (" + ");
 636
 637                   when Minus_Expr =>
 638                      Binop (" - ");
 639
 640                   when Mult_Expr =>
 641                      Binop (" * ");
 642
 643                   when Trunc_Div_Expr =>
 644                      Binop (" /t ");
 645
 646                   when Ceil_Div_Expr =>
 647                      Binop (" /c ");
 648
 649                   when Floor_Div_Expr =>
 650                      Binop (" /f ");
 651
 652                   when Trunc_Mod_Expr =>
 653                      Binop (" modt ");
 654
 655                   when Ceil_Mod_Expr =>
 656                      Binop (" modc ");
 657
 658                   when Floor_Mod_Expr =>
 659                      Binop (" modf ");
 660
 661                   when Exact_Div_Expr =>
 662                      Binop (" /e ");
 663
 664                   when Negate_Expr =>
 665                      Unop ("-");
 666
 667                   when Min_Expr =>
 668                      Binop (" min ");
 669
 670                   when Max_Expr =>
 671                      Binop (" max ");
 672
 673                   when Abs_Expr =>
 674                      Unop ("abs ");
 675
 676                   when Truth_And_Expr =>
 677                      Binop (" and ");
 678
 679                   when Truth_Or_Expr =>
 680                      Binop (" or ");
 681
 682                   when Truth_Xor_Expr =>
 683                      Binop (" xor ");
 684
 685                   when Truth_Not_Expr =>
 686                      Unop ("not ");
 687
 688                   when Lt_Expr =>
 689                      Binop (" < ");
 690
 691                   when Le_Expr =>
 692                      Binop (" <= ");
 693
 694                   when Gt_Expr =>
 695                      Binop (" > ");
 696
 697                   when Ge_Expr =>
 698                      Binop (" >= ");
 699
 700                   when Eq_Expr =>
 701                      Binop (" == ");
 702
 703                   when Ne_Expr =>
 704                      Binop (" != ");
 705
 706                   when Bit_And_Expr =>
 707                      Binop (" & ");
 708
 709                   when Discrim_Val =>
 710                      Unop ("#");
 711
 712                   when Dynamic_Val =>
 713                      Unop ("var");
 714                end case;
 715             end;
 716          end if;
 717       end Print_Expr;
 718
 719    --  Start of processing for List_GCC_Expression
 720
 721    begin
 722       if U = No_Uint then
 723          Write_Unknown_Val;
 724       else
 725          Print_Expr (U);
 726       end if;
 727    end List_GCC_Expression;
 728
 729    -------------------------
 730    -- List_Linker_Section --
 731    -------------------------
 732
 733    procedure List_Linker_Section (Ent : Entity_Id) is
 734       function Expr_Value_S (N : Node_Id) return Node_Id;
 735       --  Returns the folded value of the expression. This function is called
 736       --  in instances where it has already been determined that the expression
 737       --  is static or its value is known at compile time. This version is used
 738       --  for string types and returns the corresponding N_String_Literal node.
 739       --  NOTE: This is an exact copy of Sem_Eval.Expr_Value_S. Licensing stops
 740       --  Repinfo from within Sem_Eval. Once ASIS is removed, and the licenses
 741       --  are modified, Repinfo should be able to rely on Sem_Eval.
 742
 743       ------------------
 744       -- Expr_Value_S --
 745       ------------------
 746
 747       function Expr_Value_S (N : Node_Id) return Node_Id is
 748       begin
 749          if Nkind (N) = N_String_Literal then
 750             return N;
 751          else
 752             pragma Assert (Ekind (Entity (N)) = E_Constant);
 753             return Expr_Value_S (Constant_Value (Entity (N)));
 754          end if;
 755       end Expr_Value_S;
 756
 757       --  Local variables
 758
 759       Args : List_Id;
 760       Sect : Node_Id;
 761
 762    --  Start of processing for List_Linker_Section
 763
 764    begin
 765       if Present (Linker_Section_Pragma (Ent)) then
 766          Args := Pragma_Argument_Associations (Linker_Section_Pragma (Ent));
 767          Sect := Expr_Value_S (Get_Pragma_Arg (Last (Args)));
 768
 769          if List_Representation_Info_To_JSON then
 770             Write_Line (",");
 771             Write_Str ("  ""Linker_Section"": """);
 772          else
 773             Write_Str ("pragma Linker_Section (");
 774             List_Name (Ent);
 775             Write_Str (", """);
 776          end if;
 777
 778          pragma Assert (Nkind (Sect) = N_String_Literal);
 779          String_To_Name_Buffer (Strval (Sect));
 780          Write_Str (Name_Buffer (1 .. Name_Len));
 781          Write_Str ("""");
 782          if not List_Representation_Info_To_JSON then
 783             Write_Line (");");
 784          end if;
 785       end if;
 786    end List_Linker_Section;
 787
 788    -------------------
 789    -- List_Location --
 790    -------------------
 791
 792    procedure List_Location (Ent : Entity_Id) is
 793    begin
 794       pragma Assert (List_Representation_Info_To_JSON);
 795       Write_Str ("  ""location"": """);
 796       Write_Location (Sloc (Ent));
 797       Write_Line (""",");
 798    end List_Location;
 799
 800    ---------------------
 801    -- List_Mechanisms --
 802    ---------------------
 803
 804    procedure List_Mechanisms (Ent : Entity_Id) is
 805       First : Boolean := True;
 806       Plen  : Natural;
 807       Form  : Entity_Id;
 808
 809    begin
 810       Blank_Line;
 811
 812       if List_Representation_Info_To_JSON then
 813          Write_Line ("{");
 814          Write_Str ("  ""name"": """);
 815          List_Name (Ent);
 816          Write_Line (""",");
 817          List_Location (Ent);
 818
 819          Write_Str ("  ""Convention"": """);
 820       else
 821          case Ekind (Ent) is
 822             when E_Function =>
 823                Write_Str ("function ");
 824
 825             when E_Operator =>
 826                Write_Str ("operator ");
 827
 828             when E_Procedure =>
 829                Write_Str ("procedure ");
 830
 831             when E_Subprogram_Type =>
 832                Write_Str ("type ");
 833
 834             when E_Entry
 835                | E_Entry_Family
 836             =>
 837                Write_Str ("entry ");
 838
 839             when others =>
 840                raise Program_Error;
 841          end case;
 842
 843          List_Name (Ent);
 844          Write_Str (" declared at ");
 845          Write_Location (Sloc (Ent));
 846          Write_Eol;
 847
 848          Write_Str ("convention : ");
 849       end if;
 850
 851       case Convention (Ent) is
 852          when Convention_Ada =>
 853             Write_Str ("Ada");
 854
 855          when Convention_Ada_Pass_By_Copy =>
 856             Write_Str ("Ada_Pass_By_Copy");
 857
 858          when Convention_Ada_Pass_By_Reference =>
 859             Write_Str ("Ada_Pass_By_Reference");
 860
 861          when Convention_Intrinsic =>
 862             Write_Str ("Intrinsic");
 863
 864          when Convention_Entry =>
 865             Write_Str ("Entry");
 866
 867          when Convention_Protected =>
 868             Write_Str ("Protected");
 869
 870          when Convention_Assembler =>
 871             Write_Str ("Assembler");
 872
 873          when Convention_C =>
 874             Write_Str ("C");
 875
 876          when Convention_COBOL =>
 877             Write_Str ("COBOL");
 878
 879          when Convention_CPP =>
 880             Write_Str ("C++");
 881
 882          when Convention_Fortran =>
 883             Write_Str ("Fortran");
 884
 885          when Convention_Stdcall =>
 886             Write_Str ("Stdcall");
 887
 888          when Convention_Stubbed =>
 889             Write_Str ("Stubbed");
 890       end case;
 891
 892       if List_Representation_Info_To_JSON then
 893          Write_Line (""",");
 894          Write_Str ("  ""formal"": [");
 895       else
 896          Write_Eol;
 897       end if;
 898
 899       --  Find max length of formal name
 900
 901       Plen := 0;
 902       Form := First_Formal (Ent);
 903       while Present (Form) loop
 904          Get_Unqualified_Decoded_Name_String (Chars (Form));
 905
 906          if Name_Len > Plen then
 907             Plen := Name_Len;
 908          end if;
 909
 910          Next_Formal (Form);
 911       end loop;
 912
 913       --  Output formals and mechanisms
 914
 915       Form := First_Formal (Ent);
 916       while Present (Form) loop
 917          Get_Unqualified_Decoded_Name_String (Chars (Form));
 918          Set_Casing (Unit_Casing);
 919
 920          if List_Representation_Info_To_JSON then
 921             if First then
 922                Write_Eol;
 923                First := False;
 924             else
 925                Write_Line (",");
 926             end if;
 927
 928             Write_Line ("    {");
 929             Write_Str ("      ""name"": """);
 930             Write_Str (Name_Buffer (1 .. Name_Len));
 931             Write_Line (""",");
 932
 933             Write_Str ("      ""mechanism"": """);
 934             Write_Mechanism (Mechanism (Form));
 935             Write_Line ("""");
 936             Write_Str ("    }");
 937          else
 938             while Name_Len <= Plen loop
 939                Name_Len := Name_Len + 1;
 940                Name_Buffer (Name_Len) := ' ';
 941             end loop;
 942
 943             Write_Str ("   ");
 944             Write_Str (Name_Buffer (1 .. Plen + 1));
 945             Write_Str (": passed by ");
 946
 947             Write_Mechanism (Mechanism (Form));
 948             Write_Eol;
 949          end if;
 950
 951          Next_Formal (Form);
 952       end loop;
 953
 954       if List_Representation_Info_To_JSON then
 955          Write_Eol;
 956          Write_Str ("  ]");
 957       end if;
 958
 959       if Etype (Ent) /= Standard_Void_Type then
 960          if List_Representation_Info_To_JSON then
 961             Write_Line (",");
 962             Write_Str ("  ""mechanism"": """);
 963             Write_Mechanism (Mechanism (Ent));
 964             Write_Str ("""");
 965          else
 966             Write_Str ("returns by ");
 967             Write_Mechanism (Mechanism (Ent));
 968             Write_Eol;
 969          end if;
 970       end if;
 971
 972       if not Is_Entry (Ent) then
 973          List_Linker_Section (Ent);
 974       end if;
 975
 976       if List_Representation_Info_To_JSON then
 977          Write_Eol;
 978          Write_Line ("}");
 979       end if;
 980    end List_Mechanisms;
 981
 982    ---------------
 983    -- List_Name --
 984    ---------------
 985
 986    procedure List_Name (Ent : Entity_Id) is
 987    begin
 988       --  List the qualified name recursively, except
 989       --  at compilation unit level in default mode.
 990
 991       if Is_Compilation_Unit (Ent) then
 992          null;
 993       elsif not Is_Compilation_Unit (Scope (Ent))
 994         or else List_Representation_Info_To_JSON
 995       then
 996          List_Name (Scope (Ent));
 997          Write_Char ('.');
 998       end if;
 999
1000       Get_Unqualified_Decoded_Name_String (Chars (Ent));
1001       Set_Casing (Unit_Casing);
1002       Write_Str (Name_Buffer (1 .. Name_Len));
1003    end List_Name;
1004
1005    ---------------------
1006    -- List_Object_Info --
1007    ---------------------
1008
1009    procedure List_Object_Info (Ent : Entity_Id) is
1010    begin
1011       Blank_Line;
1012
1013       if List_Representation_Info_To_JSON then
1014          Write_Line ("{");
1015
1016          Write_Str ("  ""name"": """);
1017          List_Name (Ent);
1018          Write_Line (""",");
1019          List_Location (Ent);
1020
1021          Write_Str ("  ""Size"": ");
1022          Write_Val (Esize (Ent));
1023          Write_Line (",");
1024
1025          Write_Str ("  ""Alignment"": ");
1026          Write_Val (Alignment (Ent));
1027
1028          List_Linker_Section (Ent);
1029
1030          Write_Eol;
1031          Write_Line ("}");
1032       else
1033          Write_Str ("for ");
1034          List_Name (Ent);
1035          Write_Str ("'Size use ");
1036          Write_Val (Esize (Ent));
1037          Write_Line (";");
1038
1039          Write_Str ("for ");
1040          List_Name (Ent);
1041          Write_Str ("'Alignment use ");
1042          Write_Val (Alignment (Ent));
1043          Write_Line (";");
1044
1045          List_Linker_Section (Ent);
1046       end if;
1047    end List_Object_Info;
1048
1049    ----------------------
1050    -- List_Record_Info --
1051    ----------------------
1052
1053    procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
1054       procedure Compute_Max_Length
1055         (Ent                : Entity_Id;
1056          Starting_Position  : Uint := Uint_0;
1057          Starting_First_Bit : Uint := Uint_0;
1058          Prefix_Length      : Natural := 0);
1059       --  Internal recursive procedure to compute the max length
1060
1061       procedure List_Component_Layout
1062         (Ent                : Entity_Id;
1063          Starting_Position  : Uint := Uint_0;
1064          Starting_First_Bit : Uint := Uint_0;
1065          Prefix             : String := "";
1066          Indent             : Natural := 0);
1067       --  Procedure to display the layout of a single component
1068
1069       procedure List_Record_Layout
1070         (Ent                : Entity_Id;
1071          Starting_Position  : Uint := Uint_0;
1072          Starting_First_Bit : Uint := Uint_0;
1073          Prefix             : String := "");
1074       --  Internal recursive procedure to display the layout
1075
1076       procedure List_Structural_Record_Layout
1077         (Ent       : Entity_Id;
1078          Outer_Ent : Entity_Id;
1079          Variant   : Node_Id := Empty;
1080          Indent    : Natural := 0);
1081       --  Internal recursive procedure to display the structural layout
1082
1083       Max_Name_Length : Natural := 0;
1084       Max_Spos_Length : Natural := 0;
1085
1086       ------------------------
1087       -- Compute_Max_Length --
1088       ------------------------
1089
1090       procedure Compute_Max_Length
1091         (Ent                : Entity_Id;
1092          Starting_Position  : Uint := Uint_0;
1093          Starting_First_Bit : Uint := Uint_0;
1094          Prefix_Length      : Natural := 0)
1095       is
1096          Comp : Entity_Id;
1097
1098       begin
1099          Comp := First_Component_Or_Discriminant (Ent);
1100          while Present (Comp) loop
1101
1102             --  Skip discriminant in unchecked union (since it is not there!)
1103
1104             if Ekind (Comp) = E_Discriminant
1105               and then Is_Unchecked_Union (Ent)
1106             then
1107                goto Continue;
1108             end if;
1109
1110             --  Skip _Parent component in extension (to avoid overlap)
1111
1112             if Chars (Comp) = Name_uParent then
1113                goto Continue;
1114             end if;
1115
1116             --  All other cases
1117
1118             declare
1119                Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
1120                Bofs : constant Uint      := Component_Bit_Offset (Comp);
1121                Npos : Uint;
1122                Fbit : Uint;
1123                Spos : Uint;
1124                Sbit : Uint;
1125
1126                Name_Length : Natural;
1127
1128             begin
1129                Get_Decoded_Name_String (Chars (Comp));
1130                Name_Length := Prefix_Length + Name_Len;
1131
1132                if Rep_Not_Constant (Bofs) then
1133
1134                   --  If the record is not packed, then we know that all fields
1135                   --  whose position is not specified have starting normalized
1136                   --  bit position of zero.
1137
1138                   if Unknown_Normalized_First_Bit (Comp)
1139                     and then not Is_Packed (Ent)
1140                   then
1141                      Set_Normalized_First_Bit (Comp, Uint_0);
1142                   end if;
1143
1144                   UI_Image_Length := 2; -- For "??" marker
1145                else
1146                   Npos := Bofs / SSU;
1147                   Fbit := Bofs mod SSU;
1148
1149                   --  Complete annotation in case not done
1150
1151                   if Unknown_Normalized_First_Bit (Comp) then
1152                      Set_Normalized_Position  (Comp, Npos);
1153                      Set_Normalized_First_Bit (Comp, Fbit);
1154                   end if;
1155
1156                   Spos := Starting_Position  + Npos;
1157                   Sbit := Starting_First_Bit + Fbit;
1158
1159                   if Sbit >= SSU then
1160                      Spos := Spos + 1;
1161                      Sbit := Sbit - SSU;
1162                   end if;
1163
1164                   --  If extended information is requested, recurse fully into
1165                   --  record components, i.e. skip the outer level.
1166
1167                   if List_Representation_Info_Extended
1168                     and then Is_Record_Type (Ctyp)
1169                   then
1170                      Compute_Max_Length (Ctyp, Spos, Sbit, Name_Length + 1);
1171                      goto Continue;
1172                   end if;
1173
1174                   UI_Image (Spos);
1175                end if;
1176
1177                Max_Name_Length := Natural'Max (Max_Name_Length, Name_Length);
1178                Max_Spos_Length :=
1179                  Natural'Max (Max_Spos_Length, UI_Image_Length);
1180             end;
1181
1182          <<Continue>>
1183             Next_Component_Or_Discriminant (Comp);
1184          end loop;
1185       end Compute_Max_Length;
1186
1187       ---------------------------
1188       -- List_Component_Layout --
1189       ---------------------------
1190
1191       procedure List_Component_Layout
1192         (Ent                : Entity_Id;
1193          Starting_Position  : Uint := Uint_0;
1194          Starting_First_Bit : Uint := Uint_0;
1195          Prefix             : String := "";
1196          Indent             : Natural := 0)
1197       is
1198          Esiz  : constant Uint := Esize (Ent);
1199          Npos  : constant Uint := Normalized_Position (Ent);
1200          Fbit  : constant Uint := Normalized_First_Bit (Ent);
1201          Spos  : Uint;
1202          Sbit  : Uint;
1203          Lbit  : Uint;
1204
1205       begin
1206          if List_Representation_Info_To_JSON then
1207             Spaces (Indent);
1208             Write_Line ("    {");
1209             Spaces (Indent);
1210             Write_Str ("      ""name"": """);
1211             Write_Str (Prefix);
1212             Write_Str (Name_Buffer (1 .. Name_Len));
1213             Write_Line (""",");
1214             if Ekind (Ent) = E_Discriminant then
1215                Spaces (Indent);
1216                Write_Str ("      ""discriminant"": ");
1217                UI_Write (Discriminant_Number (Ent));
1218                Write_Line (",");
1219             end if;
1220             Spaces (Indent);
1221             Write_Str ("      ""Position"": ");
1222          else
1223             Write_Str ("   ");
1224             Write_Str (Prefix);
1225             Write_Str (Name_Buffer (1 .. Name_Len));
1226             Spaces (Max_Name_Length - Prefix'Length - Name_Len);
1227             Write_Str (" at ");
1228          end if;
1229
1230          if Known_Static_Normalized_Position (Ent) then
1231             Spos := Starting_Position  + Npos;
1232             Sbit := Starting_First_Bit + Fbit;
1233
1234             if Sbit >= SSU then
1235                Spos := Spos + 1;
1236             end if;
1237
1238             UI_Image (Spos);
1239             Spaces (Max_Spos_Length - UI_Image_Length);
1240             Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
1241
1242          elsif Known_Normalized_Position (Ent)
1243            and then List_Representation_Info = 3
1244          then
1245             Spaces (Max_Spos_Length - 2);
1246
1247             if Starting_Position /= Uint_0 then
1248                UI_Write (Starting_Position);
1249                Write_Str (" + ");
1250             end if;
1251
1252             Write_Val (Npos);
1253
1254          else
1255             Write_Unknown_Val;
1256          end if;
1257
1258          if List_Representation_Info_To_JSON then
1259             Write_Line (",");
1260             Spaces (Indent);
1261             Write_Str ("      ""First_Bit"": ");
1262          else
1263             Write_Str (" range  ");
1264          end if;
1265
1266          Sbit := Starting_First_Bit + Fbit;
1267
1268          if Sbit >= SSU then
1269             Sbit := Sbit - SSU;
1270          end if;
1271
1272          UI_Write (Sbit);
1273
1274          if List_Representation_Info_To_JSON then
1275             Write_Line (", ");
1276             Spaces (Indent);
1277             Write_Str ("      ""Size"": ");
1278          else
1279             Write_Str (" .. ");
1280          end if;
1281
1282          --  Allowing Uint_0 here is an annoying special case. Really this
1283          --  should be a fine Esize value but currently it means unknown,
1284          --  except that we know after gigi has back annotated that a size
1285          --  of zero is real, since otherwise gigi back annotates using
1286          --  No_Uint as the value to indicate unknown.
1287
1288          if (Esize (Ent) = Uint_0 or else Known_Static_Esize (Ent))
1289            and then Known_Static_Normalized_First_Bit (Ent)
1290          then
1291             Lbit := Sbit + Esiz - 1;
1292
1293             if List_Representation_Info_To_JSON then
1294                UI_Write (Esiz);
1295             else
1296                if Lbit < 10 then
1297                   Write_Char (' ');
1298                end if;
1299
1300                UI_Write (Lbit);
1301             end if;
1302
1303          --  The test for Esize (Ent) not Uint_0 here is an annoying special
1304          --  case. Officially a value of zero for Esize means unknown, but
1305          --  here we use the fact that we know that gigi annotates Esize with
1306          --  No_Uint, not Uint_0. Really everyone should use No_Uint???
1307
1308          elsif List_Representation_Info < 3
1309            or else (Esize (Ent) /= Uint_0 and then Unknown_Esize (Ent))
1310          then
1311             Write_Unknown_Val;
1312
1313          --  List_Representation >= 3 and Known_Esize (Ent)
1314
1315          else
1316             Write_Val (Esiz, Paren => not List_Representation_Info_To_JSON);
1317
1318             --  If in front-end layout mode, then dynamic size is stored in
1319             --  storage units, so renormalize for output.
1320
1321             if not Back_End_Layout then
1322                Write_Str (" * ");
1323                Write_Int (SSU);
1324             end if;
1325
1326             --  Add appropriate first bit offset
1327
1328             if not List_Representation_Info_To_JSON then
1329                if Sbit = 0 then
1330                   Write_Str (" - 1");
1331
1332                elsif Sbit = 1 then
1333                   null;
1334
1335                else
1336                   Write_Str (" + ");
1337                   Write_Int (UI_To_Int (Sbit) - 1);
1338                end if;
1339             end if;
1340          end if;
1341
1342          if List_Representation_Info_To_JSON then
1343             Write_Eol;
1344             Spaces (Indent);
1345             Write_Str ("    }");
1346          else
1347             Write_Line (";");
1348          end if;
1349       end List_Component_Layout;
1350
1351       ------------------------
1352       -- List_Record_Layout --
1353       ------------------------
1354
1355       procedure List_Record_Layout
1356         (Ent                : Entity_Id;
1357          Starting_Position  : Uint := Uint_0;
1358          Starting_First_Bit : Uint := Uint_0;
1359          Prefix             : String := "")
1360       is
1361          Comp : Entity_Id;
1362
1363       begin
1364          Comp := First_Component_Or_Discriminant (Ent);
1365          while Present (Comp) loop
1366
1367             --  Skip discriminant in unchecked union (since it is not there!)
1368
1369             if Ekind (Comp) = E_Discriminant
1370               and then Is_Unchecked_Union (Ent)
1371             then
1372                goto Continue;
1373             end if;
1374
1375             --  Skip _Parent component in extension (to avoid overlap)
1376
1377             if Chars (Comp) = Name_uParent then
1378                goto Continue;
1379             end if;
1380
1381             --  All other cases
1382
1383             declare
1384                Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
1385                Npos : constant Uint      := Normalized_Position (Comp);
1386                Fbit : constant Uint      := Normalized_First_Bit (Comp);
1387                Spos : Uint;
1388                Sbit : Uint;
1389
1390             begin
1391                Get_Decoded_Name_String (Chars (Comp));
1392                Set_Casing (Unit_Casing);
1393
1394                --  If extended information is requested, recurse fully into
1395                --  record components, i.e. skip the outer level.
1396
1397                if List_Representation_Info_Extended
1398                  and then Is_Record_Type (Ctyp)
1399                  and then Known_Static_Normalized_Position (Comp)
1400                  and then Known_Static_Normalized_First_Bit (Comp)
1401                then
1402                   Spos := Starting_Position  + Npos;
1403                   Sbit := Starting_First_Bit + Fbit;
1404
1405                   if Sbit >= SSU then
1406                      Spos := Spos + 1;
1407                      Sbit := Sbit - SSU;
1408                   end if;
1409
1410                   List_Record_Layout (Ctyp,
1411                     Spos, Sbit, Prefix & Name_Buffer (1 .. Name_Len) & ".");
1412
1413                   goto Continue;
1414                end if;
1415
1416                List_Component_Layout (Comp,
1417                  Starting_Position, Starting_First_Bit, Prefix);
1418             end;
1419
1420          <<Continue>>
1421             Next_Component_Or_Discriminant (Comp);
1422          end loop;
1423       end List_Record_Layout;
1424
1425       -----------------------------------
1426       -- List_Structural_Record_Layout --
1427       -----------------------------------
1428
1429       procedure List_Structural_Record_Layout
1430         (Ent       : Entity_Id;
1431          Outer_Ent : Entity_Id;
1432          Variant   : Node_Id := Empty;
1433          Indent    : Natural := 0)
1434       is
1435          function Derived_Discriminant (Disc : Entity_Id) return Entity_Id;
1436          --  This function assumes that Outer_Ent is an extension of Ent.
1437          --  Disc is a discriminant of Ent that does not itself constrain a
1438          --  discriminant of the parent type of Ent. Return the discriminant
1439          --  of Outer_Ent that ultimately constrains Disc, if any.
1440
1441          ----------------------------
1442          --  Derived_Discriminant  --
1443          ----------------------------
1444
1445          function Derived_Discriminant (Disc : Entity_Id) return Entity_Id is
1446             Corr_Disc    : Entity_Id;
1447             Derived_Disc : Entity_Id;
1448
1449          begin
1450             Derived_Disc := First_Stored_Discriminant (Outer_Ent);
1451
1452             --  Loop over the discriminants of the extension
1453
1454             while Present (Derived_Disc) loop
1455
1456                --  Check if this discriminant constrains another discriminant.
1457                --  If so, find the ultimately constrained discriminant and
1458                --  compare with the original components in the base type.
1459
1460                if Present (Corresponding_Discriminant (Derived_Disc)) then
1461                   Corr_Disc := Corresponding_Discriminant (Derived_Disc);
1462
1463                   while Present (Corresponding_Discriminant (Corr_Disc)) loop
1464                      Corr_Disc := Corresponding_Discriminant (Corr_Disc);
1465                   end loop;
1466
1467                   if Original_Record_Component (Corr_Disc) =
1468                      Original_Record_Component (Disc)
1469                   then
1470                      return Derived_Disc;
1471                   end if;
1472                end if;
1473
1474                Next_Stored_Discriminant (Derived_Disc);
1475             end loop;
1476
1477             --  Disc is not constrained by a discriminant of Outer_Ent
1478
1479             return Empty;
1480          end Derived_Discriminant;
1481
1482          --  Local declarations
1483
1484          Comp       : Node_Id;
1485          Comp_List  : Node_Id;
1486          First      : Boolean := True;
1487          Var        : Node_Id;
1488
1489       --  Start of processing for List_Structural_Record_Layout
1490
1491       begin
1492          --  If we are dealing with a variant, just process the components
1493
1494          if Present (Variant) then
1495             Comp_List := Component_List (Variant);
1496
1497          --  Otherwise, we are dealing with the full record and need to get
1498          --  to its definition in order to retrieve its structural layout.
1499
1500          else
1501             declare
1502                Definition : Node_Id :=
1503                               Type_Definition (Declaration_Node (Ent));
1504
1505                Is_Extension : constant Boolean :=
1506                                 Is_Tagged_Type (Ent)
1507                                   and then Nkind (Definition) =
1508                                              N_Derived_Type_Definition;
1509
1510                Disc        : Entity_Id;
1511                Listed_Disc : Entity_Id;
1512
1513             begin
1514                --  If this is an extension, first list the layout of the parent
1515                --  and then proceed to the extension part, if any.
1516
1517                if Is_Extension then
1518                   List_Structural_Record_Layout
1519                     (Base_Type (Parent_Subtype (Ent)), Outer_Ent);
1520                   First := False;
1521
1522                   if Present (Record_Extension_Part (Definition)) then
1523                      Definition := Record_Extension_Part (Definition);
1524                   end if;
1525                end if;
1526
1527                --  If the record has discriminants and is not an unchecked
1528                --  union, then display them now.
1529
1530                if Has_Discriminants (Ent)
1531                  and then not Is_Unchecked_Union (Ent)
1532                then
1533                   Disc := First_Stored_Discriminant (Ent);
1534                   while Present (Disc) loop
1535
1536                      --  If this is a record extension and the discriminant is
1537                      --  the renaming of another discriminant, skip it.
1538
1539                      if Is_Extension
1540                        and then Present (Corresponding_Discriminant (Disc))
1541                      then
1542                         goto Continue_Disc;
1543                      end if;
1544
1545                      --  If this is the parent type of an extension, retrieve
1546                      --  the derived discriminant from the extension, if any.
1547
1548                      if Ent /= Outer_Ent then
1549                         Listed_Disc := Derived_Discriminant (Disc);
1550
1551                         if No (Listed_Disc) then
1552                            goto Continue_Disc;
1553                         end if;
1554                      else
1555                         Listed_Disc := Disc;
1556                      end if;
1557
1558                      Get_Decoded_Name_String (Chars (Listed_Disc));
1559                      Set_Casing (Unit_Casing);
1560
1561                      if First then
1562                         Write_Eol;
1563                         First := False;
1564                      else
1565                         Write_Line (",");
1566                      end if;
1567
1568                      List_Component_Layout (Listed_Disc, Indent => Indent);
1569
1570                   <<Continue_Disc>>
1571                      Next_Stored_Discriminant (Disc);
1572                   end loop;
1573                end if;
1574
1575                Comp_List := Component_List (Definition);
1576             end;
1577          end if;
1578
1579          --  Bail out for the null record
1580
1581          if No (Comp_List) then
1582             return;
1583          end if;
1584
1585          --  Now deal with the regular components, if any
1586
1587          if Present (Component_Items (Comp_List)) then
1588             Comp := First_Non_Pragma (Component_Items (Comp_List));
1589             while Present (Comp) loop
1590
1591                --  Skip _Parent component in extension (to avoid overlap)
1592
1593                if Chars (Defining_Identifier (Comp)) = Name_uParent then
1594                   goto Continue_Comp;
1595                end if;
1596
1597                Get_Decoded_Name_String (Chars (Defining_Identifier (Comp)));
1598                Set_Casing (Unit_Casing);
1599
1600                if First then
1601                   Write_Eol;
1602                   First := False;
1603                else
1604                   Write_Line (",");
1605                end if;
1606
1607                List_Component_Layout
1608                  (Defining_Identifier (Comp), Indent => Indent);
1609
1610             <<Continue_Comp>>
1611                Next_Non_Pragma (Comp);
1612             end loop;
1613          end if;
1614
1615          --  We are done if there is no variant part
1616
1617          if No (Variant_Part (Comp_List)) then
1618             return;
1619          end if;
1620
1621          Write_Eol;
1622          Spaces (Indent);
1623          Write_Line ("  ],");
1624          Spaces (Indent);
1625          Write_Str ("  ""variant"" : [");
1626
1627          --  Otherwise we recurse on each variant
1628
1629          Var := First_Non_Pragma (Variants (Variant_Part (Comp_List)));
1630          First := True;
1631          while Present (Var) loop
1632             if First then
1633                Write_Eol;
1634                First := False;
1635             else
1636                Write_Line (",");
1637             end if;
1638
1639             Spaces (Indent);
1640             Write_Line ("    {");
1641             Spaces (Indent);
1642             Write_Str ("      ""present"": ");
1643             Write_Val (Present_Expr (Var));
1644             Write_Line (",");
1645             Spaces (Indent);
1646             Write_Str ("      ""record"": [");
1647
1648             List_Structural_Record_Layout (Ent, Outer_Ent, Var, Indent + 4);
1649
1650             Write_Eol;
1651             Spaces (Indent);
1652             Write_Line ("      ]");
1653             Spaces (Indent);
1654             Write_Str ("    }");
1655             Next_Non_Pragma (Var);
1656          end loop;
1657       end List_Structural_Record_Layout;
1658
1659    --  Start of processing for List_Record_Info
1660
1661    begin
1662       Blank_Line;
1663
1664       if List_Representation_Info_To_JSON then
1665          Write_Line ("{");
1666       end if;
1667
1668       List_Type_Info (Ent);
1669
1670       --  First find out max line length and max starting position
1671       --  length, for the purpose of lining things up nicely.
1672
1673       Compute_Max_Length (Ent);
1674
1675       --  Then do actual output based on those values
1676
1677       if List_Representation_Info_To_JSON then
1678          Write_Line (",");
1679          Write_Str ("  ""record"": [");
1680
1681          List_Structural_Record_Layout (Ent, Ent);
1682
1683          Write_Eol;
1684          Write_Str ("  ]");
1685       else
1686          Write_Str ("for ");
1687          List_Name (Ent);
1688          Write_Line (" use record");
1689
1690          List_Record_Layout (Ent);
1691
1692          Write_Line ("end record;");
1693       end if;
1694
1695       List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
1696
1697       List_Linker_Section (Ent);
1698
1699       if List_Representation_Info_To_JSON then
1700          Write_Eol;
1701          Write_Line ("}");
1702       end if;
1703    end List_Record_Info;
1704
1705    -------------------
1706    -- List_Rep_Info --
1707    -------------------
1708
1709    procedure List_Rep_Info (Bytes_Big_Endian : Boolean) is
1710       Col : Nat;
1711
1712    begin
1713       if List_Representation_Info /= 0
1714         or else List_Representation_Info_Mechanisms
1715       then
1716          for U in Main_Unit .. Last_Unit loop
1717             if In_Extended_Main_Source_Unit (Cunit_Entity (U)) then
1718                Unit_Casing := Identifier_Casing (Source_Index (U));
1719
1720                --  Normal case, list to standard output
1721
1722                if not List_Representation_Info_To_File then
1723                   if not List_Representation_Info_To_JSON then
1724                      Write_Eol;
1725                      Write_Str ("Representation information for unit ");
1726                      Write_Unit_Name (Unit_Name (U));
1727                      Col := Column;
1728                      Write_Eol;
1729
1730                      for J in 1 .. Col - 1 loop
1731                         Write_Char ('-');
1732                      end loop;
1733
1734                      Write_Eol;
1735                   end if;
1736
1737                   List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1738
1739                --  List representation information to file
1740
1741                else
1742                   Create_Repinfo_File_Access.all
1743                     (Get_Name_String (File_Name (Source_Index (U))));
1744                   Set_Special_Output (Write_Info_Line'Access);
1745                   List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1746                   Set_Special_Output (null);
1747                   Close_Repinfo_File_Access.all;
1748                end if;
1749             end if;
1750          end loop;
1751       end if;
1752    end List_Rep_Info;
1753
1754    -------------------------------
1755    -- List_Scalar_Storage_Order --
1756    -------------------------------
1757
1758    procedure List_Scalar_Storage_Order
1759      (Ent              : Entity_Id;
1760       Bytes_Big_Endian : Boolean)
1761    is
1762       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean);
1763       --  Show attribute definition clause for Attr_Name (an endianness
1764       --  attribute), depending on whether or not the endianness is reversed
1765       --  compared to native endianness.
1766
1767       ---------------
1768       -- List_Attr --
1769       ---------------
1770
1771       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean) is
1772       begin
1773          if List_Representation_Info_To_JSON then
1774             Write_Line (",");
1775             Write_Str ("  """);
1776             Write_Str (Attr_Name);
1777             Write_Str (""": ""System.");
1778          else
1779             Write_Str ("for ");
1780             List_Name (Ent);
1781             Write_Char (''');
1782             Write_Str (Attr_Name);
1783             Write_Str (" use System.");
1784          end if;
1785
1786          if Bytes_Big_Endian xor Is_Reversed then
1787             Write_Str ("High");
1788          else
1789             Write_Str ("Low");
1790          end if;
1791
1792          Write_Str ("_Order_First");
1793          if List_Representation_Info_To_JSON then
1794             Write_Str ("""");
1795          else
1796             Write_Line (";");
1797          end if;
1798       end List_Attr;
1799
1800       List_SSO : constant Boolean :=
1801                    Has_Rep_Item (Ent, Name_Scalar_Storage_Order)
1802                      or else SSO_Set_Low_By_Default  (Ent)
1803                      or else SSO_Set_High_By_Default (Ent);
1804       --  Scalar_Storage_Order is displayed if specified explicitly
1805       --  or set by Default_Scalar_Storage_Order.
1806
1807    --  Start of processing for List_Scalar_Storage_Order
1808
1809    begin
1810       --  For record types, list Bit_Order if not default, or if SSO is shown
1811
1812       if Is_Record_Type (Ent)
1813         and then (List_SSO or else Reverse_Bit_Order (Ent))
1814       then
1815          List_Attr ("Bit_Order", Reverse_Bit_Order (Ent));
1816       end if;
1817
1818       --  List SSO if required. If not, then storage is supposed to be in
1819       --  native order.
1820
1821       if List_SSO then
1822          List_Attr ("Scalar_Storage_Order", Reverse_Storage_Order (Ent));
1823       else
1824          pragma Assert (not Reverse_Storage_Order (Ent));
1825          null;
1826       end if;
1827    end List_Scalar_Storage_Order;
1828
1829    --------------------
1830    -- List_Type_Info --
1831    --------------------
1832
1833    procedure List_Type_Info (Ent : Entity_Id) is
1834    begin
1835       if List_Representation_Info_To_JSON then
1836          Write_Str ("  ""name"": """);
1837          List_Name (Ent);
1838          Write_Line (""",");
1839          List_Location (Ent);
1840       end if;
1841
1842       --  Do not list size info for unconstrained arrays, not meaningful
1843
1844       if Is_Array_Type (Ent) and then not Is_Constrained (Ent) then
1845          null;
1846
1847       else
1848          --  If Esize and RM_Size are the same, list as Size. This is a common
1849          --  case, which we may as well list in simple form.
1850
1851          if Esize (Ent) = RM_Size (Ent) then
1852             if List_Representation_Info_To_JSON then
1853                Write_Str ("  ""Size"": ");
1854                Write_Val (Esize (Ent));
1855                Write_Line (",");
1856             else
1857                Write_Str ("for ");
1858                List_Name (Ent);
1859                Write_Str ("'Size use ");
1860                Write_Val (Esize (Ent));
1861                Write_Line (";");
1862             end if;
1863
1864          --  Otherwise list size values separately
1865
1866          else
1867             if List_Representation_Info_To_JSON then
1868                Write_Str ("  ""Object_Size"": ");
1869                Write_Val (Esize (Ent));
1870                Write_Line (",");
1871
1872                Write_Str ("  ""Value_Size"": ");
1873                Write_Val (RM_Size (Ent));
1874                Write_Line (",");
1875
1876             else
1877                Write_Str ("for ");
1878                List_Name (Ent);
1879                Write_Str ("'Object_Size use ");
1880                Write_Val (Esize (Ent));
1881                Write_Line (";");
1882
1883                Write_Str ("for ");
1884                List_Name (Ent);
1885                Write_Str ("'Value_Size use ");
1886                Write_Val (RM_Size (Ent));
1887                Write_Line (";");
1888             end if;
1889          end if;
1890       end if;
1891
1892       if List_Representation_Info_To_JSON then
1893          Write_Str ("  ""Alignment"": ");
1894          Write_Val (Alignment (Ent));
1895       else
1896          Write_Str ("for ");
1897          List_Name (Ent);
1898          Write_Str ("'Alignment use ");
1899          Write_Val (Alignment (Ent));
1900          Write_Line (";");
1901       end if;
1902
1903       --  Special stuff for fixed-point
1904
1905       if Is_Fixed_Point_Type (Ent) then
1906
1907          --  Write small (always a static constant)
1908
1909          if List_Representation_Info_To_JSON then
1910             Write_Line (",");
1911             Write_Str ("  ""Small"": ");
1912             UR_Write (Small_Value (Ent));
1913          else
1914             Write_Str ("for ");
1915             List_Name (Ent);
1916             Write_Str ("'Small use ");
1917             UR_Write (Small_Value (Ent));
1918             Write_Line (";");
1919          end if;
1920
1921          --  Write range if static
1922
1923          declare
1924             R : constant Node_Id := Scalar_Range (Ent);
1925
1926          begin
1927             if Nkind (Low_Bound (R)) = N_Real_Literal
1928                  and then
1929                Nkind (High_Bound (R)) = N_Real_Literal
1930             then
1931                if List_Representation_Info_To_JSON then
1932                   Write_Line (",");
1933                   Write_Str ("  ""Range"": [ ");
1934                   UR_Write (Realval (Low_Bound (R)));
1935                   Write_Str (", ");
1936                   UR_Write (Realval (High_Bound (R)));
1937                   Write_Str (" ]");
1938                else
1939                   Write_Str ("for ");
1940                   List_Name (Ent);
1941                   Write_Str ("'Range use ");
1942                   UR_Write (Realval (Low_Bound (R)));
1943                   Write_Str (" .. ");
1944                   UR_Write (Realval (High_Bound (R)));
1945                   Write_Line (";");
1946                end if;
1947             end if;
1948          end;
1949       end if;
1950    end List_Type_Info;
1951
1952    ----------------------
1953    -- Rep_Not_Constant --
1954    ----------------------
1955
1956    function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean is
1957    begin
1958       if Val = No_Uint or else Val < 0 then
1959          return True;
1960       else
1961          return False;
1962       end if;
1963    end Rep_Not_Constant;
1964
1965    ---------------
1966    -- Rep_Value --
1967    ---------------
1968
1969    function Rep_Value (Val : Node_Ref_Or_Val; D : Discrim_List) return Uint is
1970
1971       function B (Val : Boolean) return Uint;
1972       --  Returns Uint_0 for False, Uint_1 for True
1973
1974       function T (Val : Node_Ref_Or_Val) return Boolean;
1975       --  Returns True for 0, False for any non-zero (i.e. True)
1976
1977       function V (Val : Node_Ref_Or_Val) return Uint;
1978       --  Internal recursive routine to evaluate tree
1979
1980       function W (Val : Uint) return Word;
1981       --  Convert Val to Word, assuming Val is always in the Int range. This
1982       --  is a helper function for the evaluation of bitwise expressions like
1983       --  Bit_And_Expr, for which there is no direct support in uintp. Uint
1984       --  values out of the Int range are expected to be seen in such
1985       --  expressions only with overflowing byte sizes around, introducing
1986       --  inherent unreliabilities in computations anyway.
1987
1988       -------
1989       -- B --
1990       -------
1991
1992       function B (Val : Boolean) return Uint is
1993       begin
1994          if Val then
1995             return Uint_1;
1996          else
1997             return Uint_0;
1998          end if;
1999       end B;
2000
2001       -------
2002       -- T --
2003       -------
2004
2005       function T (Val : Node_Ref_Or_Val) return Boolean is
2006       begin
2007          if V (Val) = 0 then
2008             return False;
2009          else
2010             return True;
2011          end if;
2012       end T;
2013
2014       -------
2015       -- V --
2016       -------
2017
2018       function V (Val : Node_Ref_Or_Val) return Uint is
2019          L, R, Q : Uint;
2020
2021       begin
2022          if Val >= 0 then
2023             return Val;
2024
2025          else
2026             declare
2027                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
2028
2029             begin
2030                case Node.Expr is
2031                   when Cond_Expr =>
2032                      if T (Node.Op1) then
2033                         return V (Node.Op2);
2034                      else
2035                         return V (Node.Op3);
2036                      end if;
2037
2038                   when Plus_Expr =>
2039                      return V (Node.Op1) + V (Node.Op2);
2040
2041                   when Minus_Expr =>
2042                      return V (Node.Op1) - V (Node.Op2);
2043
2044                   when Mult_Expr =>
2045                      return V (Node.Op1) * V (Node.Op2);
2046
2047                   when Trunc_Div_Expr =>
2048                      return V (Node.Op1) / V (Node.Op2);
2049
2050                   when Ceil_Div_Expr =>
2051                      return
2052                        UR_Ceiling
2053                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
2054
2055                   when Floor_Div_Expr =>
2056                      return
2057                        UR_Floor
2058                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
2059
2060                   when Trunc_Mod_Expr =>
2061                      return V (Node.Op1) rem V (Node.Op2);
2062
2063                   when Floor_Mod_Expr =>
2064                      return V (Node.Op1) mod V (Node.Op2);
2065
2066                   when Ceil_Mod_Expr =>
2067                      L := V (Node.Op1);
2068                      R := V (Node.Op2);
2069                      Q := UR_Ceiling (L / UR_From_Uint (R));
2070                      return L - R * Q;
2071
2072                   when Exact_Div_Expr =>
2073                      return V (Node.Op1) / V (Node.Op2);
2074
2075                   when Negate_Expr =>
2076                      return -V (Node.Op1);
2077
2078                   when Min_Expr =>
2079                      return UI_Min (V (Node.Op1), V (Node.Op2));
2080
2081                   when Max_Expr =>
2082                      return UI_Max (V (Node.Op1), V (Node.Op2));
2083
2084                   when Abs_Expr =>
2085                      return UI_Abs (V (Node.Op1));
2086
2087                   when Truth_And_Expr =>
2088                      return B (T (Node.Op1) and then T (Node.Op2));
2089
2090                   when Truth_Or_Expr =>
2091                      return B (T (Node.Op1) or else T (Node.Op2));
2092
2093                   when Truth_Xor_Expr =>
2094                      return B (T (Node.Op1) xor T (Node.Op2));
2095
2096                   when Truth_Not_Expr =>
2097                      return B (not T (Node.Op1));
2098
2099                   when Bit_And_Expr =>
2100                      L := V (Node.Op1);
2101                      R := V (Node.Op2);
2102                      return UI_From_Int (Int (W (L) and W (R)));
2103
2104                   when Lt_Expr =>
2105                      return B (V (Node.Op1) < V (Node.Op2));
2106
2107                   when Le_Expr =>
2108                      return B (V (Node.Op1) <= V (Node.Op2));
2109
2110                   when Gt_Expr =>
2111                      return B (V (Node.Op1) > V (Node.Op2));
2112
2113                   when Ge_Expr =>
2114                      return B (V (Node.Op1) >= V (Node.Op2));
2115
2116                   when Eq_Expr =>
2117                      return B (V (Node.Op1) = V (Node.Op2));
2118
2119                   when Ne_Expr =>
2120                      return B (V (Node.Op1) /= V (Node.Op2));
2121
2122                   when Discrim_Val =>
2123                      declare
2124                         Sub : constant Int := UI_To_Int (Node.Op1);
2125                      begin
2126                         pragma Assert (Sub in D'Range);
2127                         return D (Sub);
2128                      end;
2129
2130                   when Dynamic_Val =>
2131                      return No_Uint;
2132                end case;
2133             end;
2134          end if;
2135       end V;
2136
2137       -------
2138       -- W --
2139       -------
2140
2141       --  We use an unchecked conversion to map Int values to their Word
2142       --  bitwise equivalent, which we could not achieve with a normal type
2143       --  conversion for negative Ints. We want bitwise equivalents because W
2144       --  is used as a helper for bit operators like Bit_And_Expr, and can be
2145       --  called for negative Ints in the context of aligning expressions like
2146       --  X+Align & -Align.
2147
2148       function W (Val : Uint) return Word is
2149          function To_Word is new Ada.Unchecked_Conversion (Int, Word);
2150       begin
2151          return To_Word (UI_To_Int (Val));
2152       end W;
2153
2154    --  Start of processing for Rep_Value
2155
2156    begin
2157       if Val = No_Uint then
2158          return No_Uint;
2159
2160       else
2161          return V (Val);
2162       end if;
2163    end Rep_Value;
2164
2165    ------------
2166    -- Spaces --
2167    ------------
2168
2169    procedure Spaces (N : Natural) is
2170    begin
2171       for J in 1 .. N loop
2172          Write_Char (' ');
2173       end loop;
2174    end Spaces;
2175
2176    ---------------
2177    -- Tree_Read --
2178    ---------------
2179
2180    procedure Tree_Read is
2181    begin
2182       Rep_Table.Tree_Read;
2183    end Tree_Read;
2184
2185    ----------------
2186    -- Tree_Write --
2187    ----------------
2188
2189    procedure Tree_Write is
2190    begin
2191       Rep_Table.Tree_Write;
2192    end Tree_Write;
2193
2194    ---------------------
2195    -- Write_Info_Line --
2196    ---------------------
2197
2198    procedure Write_Info_Line (S : String) is
2199    begin
2200       Write_Repinfo_Line_Access.all (S (S'First .. S'Last - 1));
2201    end Write_Info_Line;
2202
2203    ---------------------
2204    -- Write_Mechanism --
2205    ---------------------
2206
2207    procedure Write_Mechanism (M : Mechanism_Type) is
2208    begin
2209       case M is
2210          when 0 =>
2211             Write_Str ("default");
2212
2213          when -1 =>
2214             Write_Str ("copy");
2215
2216          when -2 =>
2217             Write_Str ("reference");
2218
2219          when others =>
2220             raise Program_Error;
2221       end case;
2222    end Write_Mechanism;
2223
2224    -----------------------
2225    -- Write_Unknown_Val --
2226    -----------------------
2227
2228    procedure Write_Unknown_Val is
2229    begin
2230       if List_Representation_Info_To_JSON then
2231          Write_Str ("""??""");
2232       else
2233          Write_Str ("??");
2234       end if;
2235    end Write_Unknown_Val;
2236
2237    ---------------
2238    -- Write_Val --
2239    ---------------
2240
2241    procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False) is
2242    begin
2243       if Rep_Not_Constant (Val) then
2244          if List_Representation_Info < 3 or else Val = No_Uint then
2245             Write_Unknown_Val;
2246
2247          else
2248             if Paren then
2249                Write_Char ('(');
2250             end if;
2251
2252             if Back_End_Layout then
2253                List_GCC_Expression (Val);
2254             else
2255                Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
2256             end if;
2257
2258             if Paren then
2259                Write_Char (')');
2260             end if;
2261          end if;
2262
2263       else
2264          UI_Write (Val);
2265       end if;
2266    end Write_Val;
2267
2268 end Repinfo;