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