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