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-2023, 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. Representation aspects are not computed for types in a
 432       --  generic unit.
 433
 434       else
 435          pragma Assert
 436            (Is_Concurrent_Type (Ent) or else
 437               Is_Class_Wide_Type (Ent) or else
 438               Sem_Util.In_Generic_Scope (Ent));
 439       end if;
 440    end List_Common_Type_Info;
 441
 442    -------------------
 443    -- List_Entities --
 444    -------------------
 445
 446    procedure List_Entities
 447      (Ent              : Entity_Id;
 448       Bytes_Big_Endian : Boolean;
 449       In_Subprogram    : Boolean := False)
 450    is
 451       Body_E : Entity_Id;
 452       E      : Entity_Id;
 453
 454       function Find_Declaration (E : Entity_Id) return Node_Id;
 455       --  Utility to retrieve declaration node for entity in the
 456       --  case of package bodies and subprograms.
 457
 458       ----------------------
 459       -- Find_Declaration --
 460       ----------------------
 461
 462       function Find_Declaration (E : Entity_Id) return Node_Id is
 463          Decl : Node_Id;
 464
 465       begin
 466          Decl := Parent (E);
 467          while Present (Decl)
 468            and then Nkind (Decl) /= N_Package_Body
 469            and then Nkind (Decl) /= N_Subprogram_Declaration
 470            and then Nkind (Decl) /= N_Subprogram_Body
 471          loop
 472             Decl := Parent (Decl);
 473          end loop;
 474
 475          return Decl;
 476       end Find_Declaration;
 477
 478    --  Start of processing for List_Entities
 479
 480    begin
 481       --  List entity if we have one, and it is not a renaming declaration.
 482       --  For renamings, we don't get proper information, and really it makes
 483       --  sense to restrict the output to the renamed entity.
 484
 485       if Present (Ent)
 486         and then Nkind (Declaration_Node (Ent)) not in N_Renaming_Declaration
 487         and then not Is_Ignored_Ghost_Entity (Ent)
 488       then
 489          --  If entity is a subprogram and we are listing mechanisms,
 490          --  then we need to list mechanisms for this entity. We skip this
 491          --  if it is a nested subprogram, as the information has already
 492          --  been produced when listing the enclosing scope.
 493
 494          if List_Representation_Info_Mechanisms
 495            and then Is_Subprogram_Or_Entry (Ent)
 496            and then not In_Subprogram
 497          then
 498             List_Subprogram_Info (Ent);
 499          end if;
 500
 501          E := First_Entity (Ent);
 502          while Present (E) loop
 503             --  We list entities that come from source (excluding private or
 504             --  incomplete types or deferred constants, for which we will list
 505             --  the information for the full view). If requested, we also list
 506             --  relevant entities that have been generated when processing the
 507             --  original entities coming from source. But if debug flag A is
 508             --  set, then all entities are listed.
 509
 510             if ((Comes_From_Source (E)
 511                    or else (Ekind (E) = E_Block
 512                               and then
 513                             Nkind (Parent (E)) = N_Implicit_Label_Declaration
 514                               and then
 515                             Comes_From_Source (Label_Construct (Parent (E)))))
 516               and then not Is_Incomplete_Or_Private_Type (E)
 517               and then not (Ekind (E) = E_Constant
 518                               and then Present (Full_View (E))))
 519               or else (List_Representation_Info = 4
 520                          and then Relevant_Entities.Get (E))
 521               or else Debug_Flag_AA
 522             then
 523                if Is_Subprogram (E) then
 524                   if List_Representation_Info_Mechanisms then
 525                      List_Subprogram_Info (E);
 526                   end if;
 527
 528                   --  Recurse into entities local to subprogram
 529
 530                   List_Entities (E, Bytes_Big_Endian, True);
 531
 532                elsif Ekind (E) in E_Entry
 533                                 | E_Entry_Family
 534                                 | E_Subprogram_Type
 535                then
 536                   if List_Representation_Info_Mechanisms then
 537                      List_Subprogram_Info (E);
 538                   end if;
 539
 540                elsif Is_Record_Type (E) then
 541                   if List_Representation_Info >= 1 then
 542                      List_Record_Info (E, Bytes_Big_Endian);
 543
 544                      --  Recurse into entities local to a record type
 545
 546                      if List_Representation_Info = 4 then
 547                         List_Entities (E, Bytes_Big_Endian, False);
 548                      end if;
 549                   end if;
 550
 551                elsif Is_Array_Type (E) then
 552                   if List_Representation_Info >= 1 then
 553                      List_Array_Info (E, Bytes_Big_Endian);
 554                   end if;
 555
 556                elsif Is_Type (E) then
 557                   if List_Representation_Info >= 2 then
 558                      List_Type_Info (E);
 559                   end if;
 560
 561                --  Note that formals are not annotated so we skip them here
 562
 563                elsif Ekind (E) in E_Constant
 564                                 | E_Loop_Parameter
 565                                 | E_Variable
 566                then
 567                   if List_Representation_Info >= 2 then
 568                      List_Object_Info (E);
 569                   end if;
 570                end if;
 571
 572                --  Recurse into nested package, but not child packages, and not
 573                --  nested package renamings (in particular renamings of the
 574                --  enclosing package, as for some Java bindings and for generic
 575                --  instances).
 576
 577                if Ekind (E) = E_Package then
 578                   if No (Renamed_Entity (E)) and then not Is_Child_Unit (E)
 579                   then
 580                      List_Entities (E, Bytes_Big_Endian);
 581                   end if;
 582
 583                --  Recurse into bodies
 584
 585                elsif Ekind (E) in E_Package_Body
 586                                 | E_Protected_Body
 587                                 | E_Protected_Type
 588                                 | E_Subprogram_Body
 589                                 | E_Task_Body
 590                                 | E_Task_Type
 591                then
 592                   List_Entities (E, Bytes_Big_Endian);
 593
 594                --  Recurse into blocks
 595
 596                elsif Ekind (E) = E_Block then
 597                   List_Entities (E, Bytes_Big_Endian);
 598                end if;
 599             end if;
 600
 601             Next_Entity (E);
 602          end loop;
 603
 604          --  For a package body, the entities of the visible subprograms are
 605          --  declared in the corresponding spec. Iterate over its entities in
 606          --  order to handle properly the subprogram bodies. Skip bodies in
 607          --  subunits, which are listed independently.
 608
 609          if Ekind (Ent) = E_Package_Body
 610            and then Present (Corresponding_Spec (Find_Declaration (Ent)))
 611          then
 612             E := First_Entity (Corresponding_Spec (Find_Declaration (Ent)));
 613             while Present (E) loop
 614                if Is_Subprogram (E)
 615                  and then
 616                    Nkind (Find_Declaration (E)) = N_Subprogram_Declaration
 617                then
 618                   Body_E := Corresponding_Body (Find_Declaration (E));
 619
 620                   if Present (Body_E)
 621                     and then
 622                       Nkind (Parent (Find_Declaration (Body_E))) /= N_Subunit
 623                   then
 624                      List_Entities (Body_E, Bytes_Big_Endian);
 625                   end if;
 626                end if;
 627
 628                Next_Entity (E);
 629             end loop;
 630          end if;
 631       end if;
 632    end List_Entities;
 633
 634    -------------------------
 635    -- List_GCC_Expression --
 636    -------------------------
 637
 638    procedure List_GCC_Expression (U : Node_Ref_Or_Val) is
 639
 640       procedure Print_Expr (Val : Node_Ref_Or_Val);
 641       --  Internal recursive procedure to print expression
 642
 643       ----------------
 644       -- Print_Expr --
 645       ----------------
 646
 647       procedure Print_Expr (Val : Node_Ref_Or_Val) is
 648       begin
 649          if Val >= 0 then
 650             UI_Write (Val, Decimal);
 651
 652          else
 653             declare
 654                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
 655
 656                procedure Unop (S : String);
 657                --  Output text for unary operator with S being operator name
 658
 659                procedure Binop (S : String);
 660                --  Output text for binary operator with S being operator name
 661
 662                ----------
 663                -- Unop --
 664                ----------
 665
 666                procedure Unop (S : String) is
 667                begin
 668                   if List_Representation_Info_To_JSON then
 669                      Write_Str ("{ ""code"": """);
 670                      if S (S'Last) = ' ' then
 671                         Write_Str (S (S'First .. S'Last - 1));
 672                      else
 673                         Write_Str (S);
 674                      end if;
 675                      Write_Str (""", ""operands"": [ ");
 676                      Print_Expr (Node.Op1);
 677                      Write_Str (" ] }");
 678                   else
 679                      Write_Str (S);
 680                      Print_Expr (Node.Op1);
 681                   end if;
 682                end Unop;
 683
 684                -----------
 685                -- Binop --
 686                -----------
 687
 688                procedure Binop (S : String) is
 689                begin
 690                   if List_Representation_Info_To_JSON then
 691                      Write_Str ("{ ""code"": """);
 692                      Write_Str (S (S'First + 1 .. S'Last - 1));
 693                      Write_Str (""", ""operands"": [ ");
 694                      Print_Expr (Node.Op1);
 695                      Write_Str (", ");
 696                      Print_Expr (Node.Op2);
 697                      Write_Str (" ] }");
 698                   else
 699                      Write_Char ('(');
 700                      Print_Expr (Node.Op1);
 701                      Write_Str (S);
 702                      Print_Expr (Node.Op2);
 703                      Write_Char (')');
 704                   end if;
 705                end Binop;
 706
 707             --  Start of processing for Print_Expr
 708
 709             begin
 710                case Node.Expr is
 711                   when Cond_Expr =>
 712                      if List_Representation_Info_To_JSON then
 713                         Write_Str ("{ ""code"": ""?<>""");
 714                         Write_Str (", ""operands"": [ ");
 715                         Print_Expr (Node.Op1);
 716                         Write_Str (", ");
 717                         Print_Expr (Node.Op2);
 718                         Write_Str (", ");
 719                         Print_Expr (Node.Op3);
 720                         Write_Str (" ] }");
 721                      else
 722                         Write_Str ("(if ");
 723                         Print_Expr (Node.Op1);
 724                         Write_Str (" then ");
 725                         Print_Expr (Node.Op2);
 726                         Write_Str (" else ");
 727                         Print_Expr (Node.Op3);
 728                         Write_Str (" end)");
 729                      end if;
 730
 731                   when Plus_Expr =>
 732                      Binop (" + ");
 733
 734                   when Minus_Expr =>
 735                      Binop (" - ");
 736
 737                   when Mult_Expr =>
 738                      Binop (" * ");
 739
 740                   when Trunc_Div_Expr =>
 741                      Binop (" /t ");
 742
 743                   when Ceil_Div_Expr =>
 744                      Binop (" /c ");
 745
 746                   when Floor_Div_Expr =>
 747                      Binop (" /f ");
 748
 749                   when Trunc_Mod_Expr =>
 750                      Binop (" modt ");
 751
 752                   when Ceil_Mod_Expr =>
 753                      Binop (" modc ");
 754
 755                   when Floor_Mod_Expr =>
 756                      Binop (" modf ");
 757
 758                   when Exact_Div_Expr =>
 759                      Binop (" /e ");
 760
 761                   when Negate_Expr =>
 762                      Unop ("-");
 763
 764                   when Min_Expr =>
 765                      Binop (" min ");
 766
 767                   when Max_Expr =>
 768                      Binop (" max ");
 769
 770                   when Abs_Expr =>
 771                      Unop ("abs ");
 772
 773                   when Truth_And_Expr =>
 774                      Binop (" and ");
 775
 776                   when Truth_Or_Expr =>
 777                      Binop (" or ");
 778
 779                   when Truth_Xor_Expr =>
 780                      Binop (" xor ");
 781
 782                   when Truth_Not_Expr =>
 783                      Unop ("not ");
 784
 785                   when Lt_Expr =>
 786                      Binop (" < ");
 787
 788                   when Le_Expr =>
 789                      Binop (" <= ");
 790
 791                   when Gt_Expr =>
 792                      Binop (" > ");
 793
 794                   when Ge_Expr =>
 795                      Binop (" >= ");
 796
 797                   when Eq_Expr =>
 798                      Binop (" == ");
 799
 800                   when Ne_Expr =>
 801                      Binop (" != ");
 802
 803                   when Bit_And_Expr =>
 804                      Binop (" & ");
 805
 806                   when Discrim_Val =>
 807                      Unop ("#");
 808
 809                   when Dynamic_Val =>
 810                      Unop ("var");
 811                end case;
 812             end;
 813          end if;
 814       end Print_Expr;
 815
 816    --  Start of processing for List_GCC_Expression
 817
 818    begin
 819       if No (U) then
 820          Write_Unknown_Val;
 821       else
 822          Print_Expr (U);
 823       end if;
 824    end List_GCC_Expression;
 825
 826    -------------------------
 827    -- List_Linker_Section --
 828    -------------------------
 829
 830    procedure List_Linker_Section (Ent : Entity_Id) is
 831       Args : List_Id;
 832       Sect : Node_Id;
 833
 834    begin
 835       if Present (Linker_Section_Pragma (Ent)) then
 836          Args := Pragma_Argument_Associations (Linker_Section_Pragma (Ent));
 837          Sect := Expr_Value_S (Get_Pragma_Arg (Last (Args)));
 838
 839          if List_Representation_Info_To_JSON then
 840             Write_Line (",");
 841             Write_Str ("  ""Linker_Section"": """);
 842          else
 843             Write_Str ("pragma Linker_Section (");
 844             List_Name (Ent);
 845             Write_Str (", """);
 846          end if;
 847
 848          pragma Assert (Nkind (Sect) = N_String_Literal);
 849          String_To_Name_Buffer (Strval (Sect));
 850          Write_Str (Name_Buffer (1 .. Name_Len));
 851          Write_Str ("""");
 852          if not List_Representation_Info_To_JSON then
 853             Write_Line (");");
 854          end if;
 855       end if;
 856    end List_Linker_Section;
 857
 858    -------------------
 859    -- List_Location --
 860    -------------------
 861
 862    procedure List_Location (Ent : Entity_Id) is
 863    begin
 864       pragma Assert (List_Representation_Info_To_JSON);
 865       Write_Str ("  ""location"": """);
 866       Write_Location (Sloc (Ent));
 867       Write_Line (""",");
 868    end List_Location;
 869
 870    ---------------
 871    -- List_Name --
 872    ---------------
 873
 874    procedure List_Name (Ent : Entity_Id) is
 875       C : Character;
 876
 877    begin
 878       --  In JSON mode, we recurse up to Standard. This is also valid in
 879       --  default mode where we recurse up to the first compilation unit and
 880       --  should not get to Standard.
 881
 882       if Scope (Ent) = Standard_Standard then
 883          null;
 884       elsif not Is_Compilation_Unit (Scope (Ent))
 885         or else List_Representation_Info_To_JSON
 886       then
 887          List_Name (Scope (Ent));
 888          Write_Char ('.');
 889       end if;
 890
 891       Get_Unqualified_Decoded_Name_String (Chars (Ent));
 892       Set_Casing (Unit_Casing);
 893
 894       --  The name of operators needs to be properly escaped for JSON
 895
 896       for J in 1 .. Name_Len loop
 897          C := Name_Buffer (J);
 898          if C = '"' and then List_Representation_Info_To_JSON then
 899             Write_Char ('\');
 900          end if;
 901          Write_Char (C);
 902       end loop;
 903    end List_Name;
 904
 905    ---------------------
 906    -- List_Object_Info --
 907    ---------------------
 908
 909    procedure List_Object_Info (Ent : Entity_Id) is
 910    begin
 911       --  If size and alignment have not been computed (e.g. if we are in a
 912       --  generic unit, or if the back end is not being run), don't try to
 913       --  print them.
 914
 915       pragma Assert (Known_Esize (Ent) = Known_Alignment (Ent));
 916       if not Known_Alignment (Ent) then
 917          return;
 918       end if;
 919
 920       Write_Separator;
 921
 922       if List_Representation_Info_To_JSON then
 923          Write_Line ("{");
 924
 925          Write_Str ("  ""name"": """);
 926          List_Name (Ent);
 927          Write_Line (""",");
 928          List_Location (Ent);
 929
 930          Write_Str ("  ""Size"": ");
 931          Write_Val (Esize (Ent));
 932          Write_Line (",");
 933
 934          Write_Str ("  ""Alignment"": ");
 935          Write_Val (Alignment (Ent));
 936
 937          List_Linker_Section (Ent);
 938
 939          Write_Eol;
 940          Write_Line ("}");
 941       else
 942          Write_Str ("for ");
 943          List_Name (Ent);
 944          Write_Str ("'Size use ");
 945          Write_Val (Esize (Ent));
 946          Write_Line (";");
 947
 948          Write_Str ("for ");
 949          List_Name (Ent);
 950          Write_Str ("'Alignment use ");
 951          Write_Val (Alignment (Ent));
 952          Write_Line (";");
 953
 954          List_Linker_Section (Ent);
 955       end if;
 956
 957       --  The type is relevant for an object
 958
 959       if List_Representation_Info = 4 and then Is_Itype (Etype (Ent)) then
 960          Relevant_Entities.Set (Etype (Ent), True);
 961       end if;
 962    end List_Object_Info;
 963
 964    ----------------------
 965    -- List_Record_Info --
 966    ----------------------
 967
 968    procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
 969       procedure Compute_Max_Length
 970         (Ent                : Entity_Id;
 971          Starting_Position  : Uint := Uint_0;
 972          Starting_First_Bit : Uint := Uint_0;
 973          Prefix_Length      : Natural := 0);
 974       --  Internal recursive procedure to compute the max length
 975
 976       procedure List_Component_Layout
 977         (Ent                : Entity_Id;
 978          Starting_Position  : Uint := Uint_0;
 979          Starting_First_Bit : Uint := Uint_0;
 980          Prefix             : String := "";
 981          Indent             : Natural := 0);
 982       --  Procedure to display the layout of a single component
 983
 984       procedure List_Record_Layout
 985         (Ent                : Entity_Id;
 986          Starting_Position  : Uint := Uint_0;
 987          Starting_First_Bit : Uint := Uint_0;
 988          Prefix             : String := "");
 989       --  Internal recursive procedure to display the layout
 990
 991       procedure List_Structural_Record_Layout
 992         (Ent       : Entity_Id;
 993          Ext_Ent   : Entity_Id;
 994          Ext_Level : Nat := 0;
 995          Variant   : Node_Id := Empty;
 996          Indent    : Natural := 0);
 997       --  Internal recursive procedure to display the structural layout.
 998       --  If Ext_Ent is not equal to Ent, it is an extension of Ent and
 999       --  Ext_Level is the number of successive extensions between them.
1000       --  If Variant is present, it's for a variant in the variant part
1001       --  instead of the common part of Ent. Indent is the indentation.
1002
1003       Incomplete_Layout : exception;
1004       --  Exception raised if the layout is incomplete in -gnatc mode
1005
1006       Not_In_Extended_Main : exception;
1007       --  Exception raised when an ancestor is not declared in the main unit
1008
1009       Max_Name_Length : Natural := 0;
1010       Max_Spos_Length : Natural := 0;
1011
1012       ------------------------
1013       -- Compute_Max_Length --
1014       ------------------------
1015
1016       procedure Compute_Max_Length
1017         (Ent                : Entity_Id;
1018          Starting_Position  : Uint := Uint_0;
1019          Starting_First_Bit : Uint := Uint_0;
1020          Prefix_Length      : Natural := 0)
1021       is
1022          Comp : Entity_Id;
1023
1024       begin
1025          Comp := First_Component_Or_Discriminant (Ent);
1026          while Present (Comp) loop
1027
1028             --  Skip a completely hidden discriminant or a discriminant in an
1029             --  unchecked union (since it is not there).
1030
1031             if Ekind (Comp) = E_Discriminant
1032               and then (Is_Completely_Hidden (Comp)
1033                          or else Is_Unchecked_Union (Ent))
1034             then
1035                goto Continue;
1036             end if;
1037
1038             --  Skip _Parent component in extension (to avoid overlap)
1039
1040             if Chars (Comp) = Name_uParent then
1041                goto Continue;
1042             end if;
1043
1044             --  All other cases
1045
1046             declare
1047                Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
1048                Bofs : constant Uint      := Component_Bit_Offset (Comp);
1049                Npos : Uint;
1050                Fbit : Uint;
1051                Spos : Uint;
1052                Sbit : Uint;
1053
1054                Name_Length : Natural;
1055
1056             begin
1057                Get_Decoded_Name_String (Chars (Comp));
1058                Name_Length := Prefix_Length + Name_Len;
1059
1060                if Compile_Time_Known_Rep (Bofs) then
1061                   Npos := Bofs / SSU;
1062                   Fbit := Bofs mod SSU;
1063
1064                   --  Complete annotation in case not done
1065
1066                   if not Known_Normalized_First_Bit (Comp) then
1067                      Set_Normalized_Position  (Comp, Npos);
1068                      Set_Normalized_First_Bit (Comp, Fbit);
1069                   end if;
1070
1071                   Spos := Starting_Position  + Npos;
1072                   Sbit := Starting_First_Bit + Fbit;
1073
1074                   if Sbit >= SSU then
1075                      Spos := Spos + 1;
1076                      Sbit := Sbit - SSU;
1077                   end if;
1078
1079                   --  If extended information is requested, recurse fully into
1080                   --  record components, i.e. skip the outer level.
1081
1082                   if List_Representation_Info_Extended
1083                     and then Is_Record_Type (Ctyp)
1084                   then
1085                      Compute_Max_Length (Ctyp, Spos, Sbit, Name_Length + 1);
1086                      goto Continue;
1087                   end if;
1088
1089                   UI_Image (Spos);
1090                else
1091                   --  If the record is not packed, then we know that all fields
1092                   --  whose position is not specified have starting normalized
1093                   --  bit position of zero.
1094
1095                   if not Known_Normalized_First_Bit (Comp)
1096                     and then not Is_Packed (Ent)
1097                   then
1098                      Set_Normalized_First_Bit (Comp, Uint_0);
1099                   end if;
1100
1101                   UI_Image_Length := 2; -- For "??" marker
1102                end if;
1103
1104                Max_Name_Length := Natural'Max (Max_Name_Length, Name_Length);
1105                Max_Spos_Length :=
1106                  Natural'Max (Max_Spos_Length, UI_Image_Length);
1107             end;
1108
1109          <<Continue>>
1110             Next_Component_Or_Discriminant (Comp);
1111          end loop;
1112       end Compute_Max_Length;
1113
1114       ---------------------------
1115       -- List_Component_Layout --
1116       ---------------------------
1117
1118       procedure List_Component_Layout
1119         (Ent                : Entity_Id;
1120          Starting_Position  : Uint := Uint_0;
1121          Starting_First_Bit : Uint := Uint_0;
1122          Prefix             : String := "";
1123          Indent             : Natural := 0)
1124       is
1125          Esiz  : constant Uint := Esize (Ent);
1126          Npos  : constant Uint := Normalized_Position (Ent);
1127          Fbit  : constant Uint := Normalized_First_Bit (Ent);
1128          Spos  : Uint;
1129          Sbit  : Uint := No_Uint;
1130          Lbit  : Uint;
1131
1132       begin
1133          if List_Representation_Info_To_JSON then
1134             Spaces (Indent);
1135             Write_Line ("    {");
1136             Spaces (Indent);
1137             Write_Str ("      ""name"": """);
1138             Write_Str (Prefix);
1139             Write_Str (Name_Buffer (1 .. Name_Len));
1140             Write_Line (""",");
1141             if Ekind (Ent) = E_Discriminant then
1142                Spaces (Indent);
1143                Write_Str ("      ""discriminant"": ");
1144                UI_Write (Discriminant_Number (Ent), Decimal);
1145                Write_Line (",");
1146             end if;
1147             Spaces (Indent);
1148             Write_Str ("      ""Position"": ");
1149          else
1150             Write_Str ("   ");
1151             Write_Str (Prefix);
1152             Write_Str (Name_Buffer (1 .. Name_Len));
1153             Spaces (Max_Name_Length - Prefix'Length - Name_Len);
1154             Write_Str (" at ");
1155          end if;
1156
1157          if Known_Static_Normalized_Position (Ent) then
1158             Spos := Starting_Position  + Npos;
1159             Sbit := Starting_First_Bit + Fbit;
1160
1161             if Sbit >= SSU then
1162                Spos := Spos + 1;
1163             end if;
1164
1165             UI_Image (Spos);
1166             Spaces (Max_Spos_Length - UI_Image_Length);
1167             Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
1168
1169          elsif Known_Normalized_Position (Ent)
1170            and then List_Representation_Info >= 3
1171          then
1172             Spaces (Max_Spos_Length - 2);
1173
1174             if Starting_Position /= Uint_0 then
1175                UI_Write (Starting_Position, Decimal);
1176                Write_Str (" + ");
1177             end if;
1178
1179             Write_Val (Npos);
1180
1181          else
1182             Write_Unknown_Val;
1183          end if;
1184
1185          if List_Representation_Info_To_JSON then
1186             Write_Line (",");
1187             Spaces (Indent);
1188             Write_Str ("      ""First_Bit"": ");
1189          else
1190             Write_Str (" range  ");
1191          end if;
1192
1193          if Known_Static_Normalized_First_Bit (Ent) then
1194             Sbit := Starting_First_Bit + Fbit;
1195
1196             if Sbit >= SSU then
1197                Sbit := Sbit - SSU;
1198             end if;
1199
1200             UI_Write (Sbit, Decimal);
1201          else
1202             Write_Unknown_Val;
1203          end if;
1204
1205          if List_Representation_Info_To_JSON then
1206             Write_Line (", ");
1207             Spaces (Indent);
1208             Write_Str ("      ""Size"": ");
1209          else
1210             Write_Str (" .. ");
1211          end if;
1212
1213          if Known_Static_Esize (Ent)
1214            and then Known_Static_Normalized_First_Bit (Ent)
1215          then
1216             Lbit := Sbit + Esiz - 1;
1217
1218             if List_Representation_Info_To_JSON then
1219                UI_Write (Esiz, Decimal);
1220             else
1221                if Lbit >= 0 and then Lbit < 10 then
1222                   Write_Char (' ');
1223                end if;
1224
1225                UI_Write (Lbit, Decimal);
1226             end if;
1227
1228          elsif List_Representation_Info < 3 or else not Known_Esize (Ent) then
1229             Write_Unknown_Val;
1230
1231          --  List_Representation >= 3 and Known_Esize (Ent)
1232
1233          else
1234             Write_Val (Esiz, Paren => not List_Representation_Info_To_JSON);
1235
1236             --  Add appropriate first bit offset
1237
1238             if not List_Representation_Info_To_JSON then
1239                if Sbit = 0 then
1240                   Write_Str (" - 1");
1241
1242                elsif Sbit = 1 then
1243                   null;
1244
1245                else
1246                   Write_Str (" + ");
1247                   Write_Int (UI_To_Int (Sbit) - 1);
1248                end if;
1249             end if;
1250          end if;
1251
1252          if List_Representation_Info_To_JSON then
1253             Write_Eol;
1254             Spaces (Indent);
1255             Write_Str ("    }");
1256          else
1257             Write_Line (";");
1258          end if;
1259
1260          --  The type is relevant for a component
1261
1262          if List_Representation_Info = 4 and then Is_Itype (Etype (Ent)) then
1263             Relevant_Entities.Set (Etype (Ent), True);
1264          end if;
1265       end List_Component_Layout;
1266
1267       ------------------------
1268       -- List_Record_Layout --
1269       ------------------------
1270
1271       procedure List_Record_Layout
1272         (Ent                : Entity_Id;
1273          Starting_Position  : Uint := Uint_0;
1274          Starting_First_Bit : Uint := Uint_0;
1275          Prefix             : String := "")
1276       is
1277          Comp  : Entity_Id;
1278          First : Boolean := True;
1279
1280       begin
1281          Comp := First_Component_Or_Discriminant (Ent);
1282          while Present (Comp) loop
1283
1284             --  Skip a completely hidden discriminant or a discriminant in an
1285             --  unchecked union (since it is not there).
1286
1287             if Ekind (Comp) = E_Discriminant
1288               and then (Is_Completely_Hidden (Comp)
1289                          or else Is_Unchecked_Union (Ent))
1290             then
1291                goto Continue;
1292             end if;
1293
1294             --  Skip _Parent component in extension (to avoid overlap)
1295
1296             if Chars (Comp) = Name_uParent then
1297                goto Continue;
1298             end if;
1299
1300             --  All other cases
1301
1302             declare
1303                Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
1304                Npos : constant Uint      := Normalized_Position (Comp);
1305                Fbit : constant Uint      := Normalized_First_Bit (Comp);
1306                Spos : Uint;
1307                Sbit : Uint;
1308
1309             begin
1310                Get_Decoded_Name_String (Chars (Comp));
1311                Set_Casing (Unit_Casing);
1312
1313                --  If extended information is requested, recurse fully into
1314                --  record components, i.e. skip the outer level.
1315
1316                if List_Representation_Info_Extended
1317                  and then Is_Record_Type (Ctyp)
1318                  and then Known_Static_Normalized_Position (Comp)
1319                  and then Known_Static_Normalized_First_Bit (Comp)
1320                then
1321                   Spos := Starting_Position  + Npos;
1322                   Sbit := Starting_First_Bit + Fbit;
1323
1324                   if Sbit >= SSU then
1325                      Spos := Spos + 1;
1326                      Sbit := Sbit - SSU;
1327                   end if;
1328
1329                   List_Record_Layout (Ctyp,
1330                     Spos, Sbit, Prefix & Name_Buffer (1 .. Name_Len) & ".");
1331
1332                   goto Continue;
1333                end if;
1334
1335                if List_Representation_Info_To_JSON then
1336                   if First then
1337                      Write_Eol;
1338                      First := False;
1339                   else
1340                      Write_Line (",");
1341                   end if;
1342                end if;
1343
1344                --  The Parent_Subtype in an extension is not back-annotated
1345
1346                List_Component_Layout (
1347                  (if Known_Normalized_Position (Comp)
1348                   then Comp
1349                   else Original_Record_Component (Comp)),
1350                  Starting_Position, Starting_First_Bit, Prefix);
1351             end;
1352
1353          <<Continue>>
1354             Next_Component_Or_Discriminant (Comp);
1355          end loop;
1356       end List_Record_Layout;
1357
1358       -----------------------------------
1359       -- List_Structural_Record_Layout --
1360       -----------------------------------
1361
1362       procedure List_Structural_Record_Layout
1363         (Ent       : Entity_Id;
1364          Ext_Ent   : Entity_Id;
1365          Ext_Level : Nat := 0;
1366          Variant   : Node_Id := Empty;
1367          Indent    : Natural := 0)
1368       is
1369          function Derived_Discriminant (Disc : Entity_Id) return Entity_Id;
1370          --  This function assumes that Ext_Ent is an extension of Ent.
1371          --  Disc is a discriminant of Ent that does not itself constrain a
1372          --  discriminant of the parent type of Ent. Return the discriminant
1373          --  of Ext_Ent that ultimately constrains Disc, if any.
1374
1375          ----------------------------
1376          --  Derived_Discriminant  --
1377          ----------------------------
1378
1379          function Derived_Discriminant (Disc : Entity_Id) return Entity_Id is
1380             Corr_Disc    : Entity_Id;
1381             Derived_Disc : Entity_Id;
1382
1383          begin
1384             Derived_Disc := First_Discriminant (Ext_Ent);
1385
1386             --  Loop over the discriminants of the extension
1387
1388             while Present (Derived_Disc) loop
1389
1390                --  Check if this discriminant constrains another discriminant.
1391                --  If so, find the ultimately constrained discriminant and
1392                --  compare with the original components in the base type.
1393
1394                if Present (Corresponding_Discriminant (Derived_Disc)) then
1395                   Corr_Disc := Corresponding_Discriminant (Derived_Disc);
1396
1397                   while Present (Corresponding_Discriminant (Corr_Disc)) loop
1398                      Corr_Disc := Corresponding_Discriminant (Corr_Disc);
1399                   end loop;
1400
1401                   if Original_Record_Component (Corr_Disc) =
1402                      Original_Record_Component (Disc)
1403                   then
1404                      return Derived_Disc;
1405                   end if;
1406                end if;
1407
1408                Next_Discriminant (Derived_Disc);
1409             end loop;
1410
1411             --  Disc is not constrained by a discriminant of Ext_Ent
1412
1413             return Empty;
1414          end Derived_Discriminant;
1415
1416          --  Local declarations
1417
1418          Comp       : Node_Id;
1419          Comp_List  : Node_Id;
1420          First      : Boolean := True;
1421          Var        : Node_Id;
1422
1423       --  Start of processing for List_Structural_Record_Layout
1424
1425       begin
1426          --  If we are dealing with a variant, just process the components
1427
1428          if Present (Variant) then
1429             Comp_List := Component_List (Variant);
1430
1431          --  Otherwise, we are dealing with the full record and need to get
1432          --  to its definition in order to retrieve its structural layout.
1433
1434          else
1435             declare
1436                Definition : Node_Id :=
1437                               Type_Definition (Declaration_Node (Ent));
1438
1439                Is_Extension : constant Boolean :=
1440                                 Is_Tagged_Type (Ent)
1441                                   and then Nkind (Definition) =
1442                                              N_Derived_Type_Definition;
1443
1444                Disc        : Entity_Id;
1445                Listed_Disc : Entity_Id;
1446                Parent_Type : Entity_Id;
1447
1448             begin
1449                --  If this is an extension, first list the layout of the parent
1450                --  and then proceed to the extension part, if any.
1451
1452                if Is_Extension then
1453                   Parent_Type := Parent_Subtype (Ent);
1454                   if No (Parent_Type) then
1455                      raise Incomplete_Layout;
1456                   end if;
1457
1458                   if Is_Private_Type (Parent_Type) then
1459                      Parent_Type := Full_View (Parent_Type);
1460                      pragma Assert (Present (Parent_Type));
1461                   end if;
1462
1463                   --  Do not list variants if one of them has been selected
1464
1465                   if Has_Static_Discriminants (Parent_Type) then
1466                      List_Record_Layout (Parent_Type);
1467
1468                   else
1469                      Parent_Type := Base_Type (Parent_Type);
1470                      if not In_Extended_Main_Source_Unit (Parent_Type) then
1471                         raise Not_In_Extended_Main;
1472                      end if;
1473
1474                      List_Structural_Record_Layout
1475                        (Parent_Type, Ext_Ent, Ext_Level + 1);
1476                   end if;
1477
1478                   First := False;
1479
1480                   if Present (Record_Extension_Part (Definition)) then
1481                      Definition := Record_Extension_Part (Definition);
1482                   end if;
1483                end if;
1484
1485                --  If the record has discriminants and is not an unchecked
1486                --  union, then display them now. Note that, even if this is
1487                --  a structural layout, we list the visible discriminants.
1488
1489                if Has_Discriminants (Ent)
1490                  and then not Is_Unchecked_Union (Ent)
1491                then
1492                   Disc := First_Discriminant (Ent);
1493                   while Present (Disc) loop
1494
1495                      --  If this is a record extension and the discriminant is
1496                      --  the renaming of another discriminant, skip it.
1497
1498                      if Is_Extension
1499                        and then Present (Corresponding_Discriminant (Disc))
1500                      then
1501                         goto Continue_Disc;
1502                      end if;
1503
1504                      --  If this is the parent type of an extension, retrieve
1505                      --  the derived discriminant from the extension, if any.
1506
1507                      if Ent /= Ext_Ent then
1508                         Listed_Disc := Derived_Discriminant (Disc);
1509
1510                         if No (Listed_Disc) then
1511                            goto Continue_Disc;
1512                         end if;
1513                      else
1514                         Listed_Disc := Disc;
1515                      end if;
1516
1517                      Get_Decoded_Name_String (Chars (Listed_Disc));
1518                      Set_Casing (Unit_Casing);
1519
1520                      if First then
1521                         Write_Eol;
1522                         First := False;
1523                      else
1524                         Write_Line (",");
1525                      end if;
1526
1527                      List_Component_Layout (Listed_Disc, Indent => Indent);
1528
1529                   <<Continue_Disc>>
1530                      Next_Discriminant (Disc);
1531                   end loop;
1532                end if;
1533
1534                Comp_List := Component_List (Definition);
1535             end;
1536          end if;
1537
1538          --  Bail out for the null record
1539
1540          if No (Comp_List) then
1541             return;
1542          end if;
1543
1544          --  Now deal with the regular components, if any
1545
1546          if Present (Component_Items (Comp_List)) then
1547             Comp := First_Non_Pragma (Component_Items (Comp_List));
1548             while Present (Comp) loop
1549
1550                --  Skip _Parent component in extension (to avoid overlap)
1551
1552                if Chars (Defining_Identifier (Comp)) = Name_uParent then
1553                   goto Continue_Comp;
1554                end if;
1555
1556                Get_Decoded_Name_String (Chars (Defining_Identifier (Comp)));
1557                Set_Casing (Unit_Casing);
1558
1559                if First then
1560                   Write_Eol;
1561                   First := False;
1562                else
1563                   Write_Line (",");
1564                end if;
1565
1566                List_Component_Layout
1567                  (Defining_Identifier (Comp), Indent => Indent);
1568
1569             <<Continue_Comp>>
1570                Next_Non_Pragma (Comp);
1571             end loop;
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 1 .. Ext_Level 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;