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