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