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