gcc/ada/repinfo.adb

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