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-2018, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Alloc;
  33 with Atree;   use Atree;
  34 with Casing;  use Casing;
  35 with Debug;   use Debug;
  36 with Einfo;   use Einfo;
  37 with Lib;     use Lib;
  38 with Namet;   use Namet;
  39 with Nlists;  use Nlists;
  40 with Opt;     use Opt;
  41 with Output;  use Output;
  42 with Sem_Aux; use Sem_Aux;
  43 with Sinfo;   use Sinfo;
  44 with Sinput;  use Sinput;
  45 with Snames;  use Snames;
  46 with Stand;   use Stand;
  47 with Stringt; use Stringt;
  48 with Table;
  49 with Uname;   use Uname;
  50 with Urealp;  use Urealp;
  51
  52 with Ada.Unchecked_Conversion;
  53
  54 package body Repinfo is
  55
  56    SSU : constant := 8;
  57    --  Value for Storage_Unit, we do not want to get this from TTypes, since
  58    --  this introduces problematic dependencies in ASIS, and in any case this
  59    --  value is assumed to be 8 for the implementation of the DDA.
  60
  61    ---------------------------------------
  62    -- Representation of GCC Expressions --
  63    ---------------------------------------
  64
  65    --    A table internal to this unit is used to hold the values of back
  66    --    annotated expressions. This table is written out by -gnatt and read
  67    --    back in for ASIS processing.
  68
  69    --    Node values are stored as Uint values using the negative of the node
  70    --    index in this table. Constants appear as non-negative Uint values.
  71
  72    type Exp_Node is record
  73       Expr : TCode;
  74       Op1  : Node_Ref_Or_Val;
  75       Op2  : Node_Ref_Or_Val;
  76       Op3  : Node_Ref_Or_Val;
  77    end record;
  78
  79    --  The following representation clause ensures that the above record
  80    --  has no holes. We do this so that when instances of this record are
  81    --  written by Tree_Gen, we do not write uninitialized values to the file.
  82
  83    for Exp_Node use record
  84       Expr at  0 range 0 .. 31;
  85       Op1  at  4 range 0 .. 31;
  86       Op2  at  8 range 0 .. 31;
  87       Op3  at 12 range 0 .. 31;
  88    end record;
  89
  90    for Exp_Node'Size use 16 * 8;
  91    --  This ensures that we did not leave out any fields
  92
  93    package Rep_Table is new Table.Table (
  94       Table_Component_Type => Exp_Node,
  95       Table_Index_Type     => Nat,
  96       Table_Low_Bound      => 1,
  97       Table_Initial        => Alloc.Rep_Table_Initial,
  98       Table_Increment      => Alloc.Rep_Table_Increment,
  99       Table_Name           => "BE_Rep_Table");
 100
 101    --------------------------------------------------------------
 102    -- Representation of Front-End Dynamic Size/Offset Entities --
 103    --------------------------------------------------------------
 104
 105    package Dynamic_SO_Entity_Table is new Table.Table (
 106       Table_Component_Type => Entity_Id,
 107       Table_Index_Type     => Nat,
 108       Table_Low_Bound      => 1,
 109       Table_Initial        => Alloc.Rep_Table_Initial,
 110       Table_Increment      => Alloc.Rep_Table_Increment,
 111       Table_Name           => "FE_Rep_Table");
 112
 113    Unit_Casing : Casing_Type;
 114    --  Identifier casing for current unit. This is set by List_Rep_Info for
 115    --  each unit, before calling subprograms which may read it.
 116
 117    Need_Blank_Line : Boolean;
 118    --  Set True if a blank line is needed before outputting any information for
 119    --  the current entity. Set True when a new entity is processed, and false
 120    --  when the blank line is output.
 121
 122    -----------------------
 123    -- Local Subprograms --
 124    -----------------------
 125
 126    function Back_End_Layout return Boolean;
 127    --  Test for layout mode, True = back end, False = front end. This function
 128    --  is used rather than checking the configuration parameter because we do
 129    --  not want Repinfo to depend on Targparm (for ASIS)
 130
 131    procedure Blank_Line;
 132    --  Called before outputting anything for an entity. Ensures that
 133    --  a blank line precedes the output for a particular entity.
 134
 135    procedure List_Entities
 136      (Ent              : Entity_Id;
 137       Bytes_Big_Endian : Boolean;
 138       In_Subprogram    : Boolean := False);
 139    --  This procedure lists the entities associated with the entity E, starting
 140    --  with the First_Entity and using the Next_Entity link. If a nested
 141    --  package is found, entities within the package are recursively processed.
 142    --  When recursing within a subprogram body, Is_Subprogram suppresses
 143    --  duplicate information about signature.
 144
 145    procedure List_Name (Ent : Entity_Id);
 146    --  List name of entity Ent in appropriate case. The name is listed with
 147    --  full qualification up to but not including the compilation unit name.
 148
 149    procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
 150    --  List representation info for array type Ent
 151
 152    procedure List_Linker_Section (Ent : Entity_Id);
 153    --  List linker section for Ent (caller has checked that Ent is an entity
 154    --  for which the Linker_Section_Pragma field is defined).
 155
 156    procedure List_Mechanisms (Ent : Entity_Id);
 157    --  List mechanism information for parameters of Ent, which is subprogram,
 158    --  subprogram type, or an entry or entry family.
 159
 160    procedure List_Object_Info (Ent : Entity_Id);
 161    --  List representation info for object Ent
 162
 163    procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
 164    --  List representation info for record type Ent
 165
 166    procedure List_Scalar_Storage_Order
 167      (Ent              : Entity_Id;
 168       Bytes_Big_Endian : Boolean);
 169    --  List scalar storage order information for record or array type Ent.
 170    --  Also includes bit order information for record types, if necessary.
 171
 172    procedure List_Type_Info (Ent : Entity_Id);
 173    --  List type info for type Ent
 174
 175    function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean;
 176    --  Returns True if Val represents a variable value, and False if it
 177    --  represents a value that is fixed at compile time.
 178
 179    procedure Spaces (N : Natural);
 180    --  Output given number of spaces
 181
 182    procedure Write_Info_Line (S : String);
 183    --  Routine to write a line to Repinfo output file. This routine is passed
 184    --  as a special output procedure to Output.Set_Special_Output. Note that
 185    --  Write_Info_Line is called with an EOL character at the end of each line,
 186    --  as per the Output spec, but the internal call to the appropriate routine
 187    --  in Osint requires that the end of line sequence be stripped off.
 188
 189    procedure Write_Mechanism (M : Mechanism_Type);
 190    --  Writes symbolic string for mechanism represented by M
 191
 192    procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False);
 193    --  Given a representation value, write it out. No_Uint values or values
 194    --  dependent on discriminants are written as two question marks. If the
 195    --  flag Paren is set, then the output is surrounded in parentheses if it is
 196    --  other than a simple value.
 197
 198    ---------------------
 199    -- Back_End_Layout --
 200    ---------------------
 201
 202    function Back_End_Layout return Boolean is
 203    begin
 204       --  We have back end layout if the back end has made any entries in the
 205       --  table of GCC expressions, otherwise we have front end layout.
 206
 207       return Rep_Table.Last > 0;
 208    end Back_End_Layout;
 209
 210    ----------------
 211    -- Blank_Line --
 212    ----------------
 213
 214    procedure Blank_Line is
 215    begin
 216       if Need_Blank_Line then
 217          Write_Eol;
 218          Need_Blank_Line := False;
 219       end if;
 220    end Blank_Line;
 221
 222    ------------------------
 223    -- Create_Discrim_Ref --
 224    ------------------------
 225
 226    function Create_Discrim_Ref (Discr : Entity_Id) return Node_Ref is
 227    begin
 228       return Create_Node
 229         (Expr => Discrim_Val,
 230          Op1  => Discriminant_Number (Discr));
 231    end Create_Discrim_Ref;
 232
 233    ---------------------------
 234    -- Create_Dynamic_SO_Ref --
 235    ---------------------------
 236
 237    function Create_Dynamic_SO_Ref (E : Entity_Id) return Dynamic_SO_Ref is
 238    begin
 239       Dynamic_SO_Entity_Table.Append (E);
 240       return UI_From_Int (-Dynamic_SO_Entity_Table.Last);
 241    end Create_Dynamic_SO_Ref;
 242
 243    -----------------
 244    -- Create_Node --
 245    -----------------
 246
 247    function Create_Node
 248      (Expr : TCode;
 249       Op1  : Node_Ref_Or_Val;
 250       Op2  : Node_Ref_Or_Val := No_Uint;
 251       Op3  : Node_Ref_Or_Val := No_Uint) return Node_Ref
 252    is
 253    begin
 254       Rep_Table.Append (
 255         (Expr => Expr,
 256          Op1  => Op1,
 257          Op2  => Op2,
 258          Op3  => Op3));
 259       return UI_From_Int (-Rep_Table.Last);
 260    end Create_Node;
 261
 262    ---------------------------
 263    -- Get_Dynamic_SO_Entity --
 264    ---------------------------
 265
 266    function Get_Dynamic_SO_Entity (U : Dynamic_SO_Ref) return Entity_Id is
 267    begin
 268       return Dynamic_SO_Entity_Table.Table (-UI_To_Int (U));
 269    end Get_Dynamic_SO_Entity;
 270
 271    -----------------------
 272    -- Is_Dynamic_SO_Ref --
 273    -----------------------
 274
 275    function Is_Dynamic_SO_Ref (U : SO_Ref) return Boolean is
 276    begin
 277       return U < Uint_0;
 278    end Is_Dynamic_SO_Ref;
 279
 280    ----------------------
 281    -- Is_Static_SO_Ref --
 282    ----------------------
 283
 284    function Is_Static_SO_Ref (U : SO_Ref) return Boolean is
 285    begin
 286       return U >= Uint_0;
 287    end Is_Static_SO_Ref;
 288
 289    ---------
 290    -- lgx --
 291    ---------
 292
 293    procedure lgx (U : Node_Ref_Or_Val) is
 294    begin
 295       List_GCC_Expression (U);
 296       Write_Eol;
 297    end lgx;
 298
 299    ----------------------
 300    -- List_Array_Info --
 301    ----------------------
 302
 303    procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
 304    begin
 305       List_Type_Info (Ent);
 306       Write_Str ("for ");
 307       List_Name (Ent);
 308       Write_Str ("'Component_Size use ");
 309       Write_Val (Component_Size (Ent));
 310       Write_Line (";");
 311
 312       List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
 313    end List_Array_Info;
 314
 315    -------------------
 316    -- List_Entities --
 317    -------------------
 318
 319    procedure List_Entities
 320      (Ent              : Entity_Id;
 321       Bytes_Big_Endian : Boolean;
 322       In_Subprogram    : Boolean := False)
 323    is
 324       Body_E : Entity_Id;
 325       E      : Entity_Id;
 326
 327       function Find_Declaration (E : Entity_Id) return Node_Id;
 328       --  Utility to retrieve declaration node for entity in the
 329       --  case of package bodies and subprograms.
 330
 331       ----------------------
 332       -- Find_Declaration --
 333       ----------------------
 334
 335       function Find_Declaration (E : Entity_Id) return Node_Id is
 336          Decl : Node_Id;
 337
 338       begin
 339          Decl := Parent (E);
 340          while Present (Decl)
 341            and then Nkind (Decl) /= N_Package_Body
 342            and then Nkind (Decl) /= N_Subprogram_Declaration
 343            and then Nkind (Decl) /= N_Subprogram_Body
 344          loop
 345             Decl := Parent (Decl);
 346          end loop;
 347
 348          return Decl;
 349       end Find_Declaration;
 350
 351    --  Start of processing for List_Entities
 352
 353    begin
 354       --  List entity if we have one, and it is not a renaming declaration.
 355       --  For renamings, we don't get proper information, and really it makes
 356       --  sense to restrict the output to the renamed entity.
 357
 358       if Present (Ent)
 359         and then Nkind (Declaration_Node (Ent)) not in N_Renaming_Declaration
 360       then
 361          --  If entity is a subprogram and we are listing mechanisms,
 362          --  then we need to list mechanisms for this entity. We skip this
 363          --  if it is a nested subprogram, as the information has already
 364          --  been produced when listing the enclosing scope.
 365
 366          if List_Representation_Info_Mechanisms
 367            and then (Is_Subprogram (Ent)
 368                       or else Ekind (Ent) = E_Entry
 369                       or else Ekind (Ent) = E_Entry_Family)
 370            and then not In_Subprogram
 371          then
 372             Need_Blank_Line := True;
 373             List_Mechanisms (Ent);
 374          end if;
 375
 376          E := First_Entity (Ent);
 377          while Present (E) loop
 378             Need_Blank_Line := True;
 379
 380             --  We list entities that come from source (excluding private or
 381             --  incomplete types or deferred constants, where we will list the
 382             --  info for the full view). If debug flag A is set, then all
 383             --  entities are listed
 384
 385             if (Comes_From_Source (E)
 386               and then not Is_Incomplete_Or_Private_Type (E)
 387               and then not (Ekind (E) = E_Constant
 388                               and then Present (Full_View (E))))
 389               or else Debug_Flag_AA
 390             then
 391                if Is_Subprogram (E) then
 392                   List_Linker_Section (E);
 393
 394                   if List_Representation_Info_Mechanisms then
 395                      List_Mechanisms (E);
 396                   end if;
 397
 398                   --  Recurse into entities local to subprogram
 399
 400                   List_Entities (E, Bytes_Big_Endian, True);
 401
 402                elsif Ekind (E) in Formal_Kind and then In_Subprogram then
 403                   null;
 404
 405                elsif Ekind_In (E, E_Entry,
 406                                   E_Entry_Family,
 407                                   E_Subprogram_Type)
 408                then
 409                   if List_Representation_Info_Mechanisms then
 410                      List_Mechanisms (E);
 411                   end if;
 412
 413                elsif Is_Record_Type (E) then
 414                   if List_Representation_Info >= 1 then
 415                      List_Record_Info (E, Bytes_Big_Endian);
 416                   end if;
 417
 418                   List_Linker_Section (E);
 419
 420                elsif Is_Array_Type (E) then
 421                   if List_Representation_Info >= 1 then
 422                      List_Array_Info (E, Bytes_Big_Endian);
 423                   end if;
 424
 425                   List_Linker_Section (E);
 426
 427                elsif Is_Type (E) then
 428                   if List_Representation_Info >= 2 then
 429                      List_Type_Info (E);
 430                      List_Linker_Section (E);
 431                   end if;
 432
 433                elsif Ekind_In (E, E_Variable, E_Constant) then
 434                   if List_Representation_Info >= 2 then
 435                      List_Object_Info (E);
 436                      List_Linker_Section (E);
 437                   end if;
 438
 439                elsif Ekind (E) = E_Loop_Parameter or else Is_Formal (E) then
 440                   if List_Representation_Info >= 2 then
 441                      List_Object_Info (E);
 442                   end if;
 443                end if;
 444
 445                --  Recurse into nested package, but not if they are package
 446                --  renamings (in particular renamings of the enclosing package,
 447                --  as for some Java bindings and for generic instances).
 448
 449                if Ekind (E) = E_Package then
 450                   if No (Renamed_Object (E)) then
 451                      List_Entities (E, Bytes_Big_Endian);
 452                   end if;
 453
 454                --  Recurse into bodies
 455
 456                elsif Ekind_In (E, E_Protected_Type,
 457                                   E_Task_Type,
 458                                   E_Subprogram_Body,
 459                                   E_Package_Body,
 460                                   E_Task_Body,
 461                                   E_Protected_Body)
 462                then
 463                   List_Entities (E, Bytes_Big_Endian);
 464
 465                --  Recurse into blocks
 466
 467                elsif Ekind (E) = E_Block then
 468                   List_Entities (E, Bytes_Big_Endian);
 469                end if;
 470             end if;
 471
 472             E := Next_Entity (E);
 473          end loop;
 474
 475          --  For a package body, the entities of the visible subprograms are
 476          --  declared in the corresponding spec. Iterate over its entities in
 477          --  order to handle properly the subprogram bodies. Skip bodies in
 478          --  subunits, which are listed independently.
 479
 480          if Ekind (Ent) = E_Package_Body
 481            and then Present (Corresponding_Spec (Find_Declaration (Ent)))
 482          then
 483             E := First_Entity (Corresponding_Spec (Find_Declaration (Ent)));
 484             while Present (E) loop
 485                if Is_Subprogram (E)
 486                  and then
 487                    Nkind (Find_Declaration (E)) = N_Subprogram_Declaration
 488                then
 489                   Body_E := Corresponding_Body (Find_Declaration (E));
 490
 491                   if Present (Body_E)
 492                     and then
 493                       Nkind (Parent (Find_Declaration (Body_E))) /= N_Subunit
 494                   then
 495                      List_Entities (Body_E, Bytes_Big_Endian);
 496                   end if;
 497                end if;
 498
 499                Next_Entity (E);
 500             end loop;
 501          end if;
 502       end if;
 503    end List_Entities;
 504
 505    -------------------------
 506    -- List_GCC_Expression --
 507    -------------------------
 508
 509    procedure List_GCC_Expression (U : Node_Ref_Or_Val) is
 510
 511       procedure Print_Expr (Val : Node_Ref_Or_Val);
 512       --  Internal recursive procedure to print expression
 513
 514       ----------------
 515       -- Print_Expr --
 516       ----------------
 517
 518       procedure Print_Expr (Val : Node_Ref_Or_Val) is
 519       begin
 520          if Val >= 0 then
 521             UI_Write (Val, Decimal);
 522
 523          else
 524             declare
 525                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
 526
 527                procedure Binop (S : String);
 528                --  Output text for binary operator with S being operator name
 529
 530                -----------
 531                -- Binop --
 532                -----------
 533
 534                procedure Binop (S : String) is
 535                begin
 536                   Write_Char ('(');
 537                   Print_Expr (Node.Op1);
 538                   Write_Str (S);
 539                   Print_Expr (Node.Op2);
 540                   Write_Char (')');
 541                end Binop;
 542
 543             --  Start of processing for Print_Expr
 544
 545             begin
 546                case Node.Expr is
 547                   when Cond_Expr =>
 548                      Write_Str ("(if ");
 549                      Print_Expr (Node.Op1);
 550                      Write_Str (" then ");
 551                      Print_Expr (Node.Op2);
 552                      Write_Str (" else ");
 553                      Print_Expr (Node.Op3);
 554                      Write_Str (" end)");
 555
 556                   when Plus_Expr =>
 557                      Binop (" + ");
 558
 559                   when Minus_Expr =>
 560                      Binop (" - ");
 561
 562                   when Mult_Expr =>
 563                      Binop (" * ");
 564
 565                   when Trunc_Div_Expr =>
 566                      Binop (" /t ");
 567
 568                   when Ceil_Div_Expr =>
 569                      Binop (" /c ");
 570
 571                   when Floor_Div_Expr =>
 572                      Binop (" /f ");
 573
 574                   when Trunc_Mod_Expr =>
 575                      Binop (" modt ");
 576
 577                   when Floor_Mod_Expr =>
 578                      Binop (" modf ");
 579
 580                   when Ceil_Mod_Expr =>
 581                      Binop (" modc ");
 582
 583                   when Exact_Div_Expr =>
 584                      Binop (" /e ");
 585
 586                   when Negate_Expr =>
 587                      Write_Char ('-');
 588                      Print_Expr (Node.Op1);
 589
 590                   when Min_Expr =>
 591                      Binop (" min ");
 592
 593                   when Max_Expr =>
 594                      Binop (" max ");
 595
 596                   when Abs_Expr =>
 597                      Write_Str ("abs ");
 598                      Print_Expr (Node.Op1);
 599
 600                   when Truth_Andif_Expr =>
 601                      Binop (" and if ");
 602
 603                   when Truth_Orif_Expr =>
 604                      Binop (" or if ");
 605
 606                   when Truth_And_Expr =>
 607                      Binop (" and ");
 608
 609                   when Truth_Or_Expr =>
 610                      Binop (" or ");
 611
 612                   when Truth_Xor_Expr =>
 613                      Binop (" xor ");
 614
 615                   when Truth_Not_Expr =>
 616                      Write_Str ("not ");
 617                      Print_Expr (Node.Op1);
 618
 619                   when Bit_And_Expr =>
 620                      Binop (" & ");
 621
 622                   when Lt_Expr =>
 623                      Binop (" < ");
 624
 625                   when Le_Expr =>
 626                      Binop (" <= ");
 627
 628                   when Gt_Expr =>
 629                      Binop (" > ");
 630
 631                   when Ge_Expr =>
 632                      Binop (" >= ");
 633
 634                   when Eq_Expr =>
 635                      Binop (" == ");
 636
 637                   when Ne_Expr =>
 638                      Binop (" != ");
 639
 640                   when Discrim_Val =>
 641                      Write_Char ('#');
 642                      UI_Write (Node.Op1);
 643
 644                   when Dynamic_Val =>
 645                      Write_Str ("Var");
 646                      UI_Write (Node.Op1);
 647                end case;
 648             end;
 649          end if;
 650       end Print_Expr;
 651
 652    --  Start of processing for List_GCC_Expression
 653
 654    begin
 655       if U = No_Uint then
 656          Write_Str ("??");
 657       else
 658          Print_Expr (U);
 659       end if;
 660    end List_GCC_Expression;
 661
 662    -------------------------
 663    -- List_Linker_Section --
 664    -------------------------
 665
 666    procedure List_Linker_Section (Ent : Entity_Id) is
 667       Arg : Node_Id;
 668
 669    begin
 670       if Present (Linker_Section_Pragma (Ent)) then
 671          Write_Str ("pragma Linker_Section (");
 672          List_Name (Ent);
 673          Write_Str (", """);
 674
 675          Arg :=
 676            Last (Pragma_Argument_Associations (Linker_Section_Pragma (Ent)));
 677
 678          if Nkind (Arg) = N_Pragma_Argument_Association then
 679             Arg := Expression (Arg);
 680          end if;
 681
 682          pragma Assert (Nkind (Arg) = N_String_Literal);
 683          String_To_Name_Buffer (Strval (Arg));
 684          Write_Str (Name_Buffer (1 .. Name_Len));
 685          Write_Str (""");");
 686          Write_Eol;
 687       end if;
 688    end List_Linker_Section;
 689
 690    ---------------------
 691    -- List_Mechanisms --
 692    ---------------------
 693
 694    procedure List_Mechanisms (Ent : Entity_Id) is
 695       Plen : Natural;
 696       Form : Entity_Id;
 697
 698    begin
 699       Blank_Line;
 700
 701       case Ekind (Ent) is
 702          when E_Function =>
 703             Write_Str ("function ");
 704
 705          when E_Operator =>
 706             Write_Str ("operator ");
 707
 708          when E_Procedure =>
 709             Write_Str ("procedure ");
 710
 711          when E_Subprogram_Type =>
 712             Write_Str ("type ");
 713
 714          when E_Entry
 715             | E_Entry_Family
 716          =>
 717             Write_Str ("entry ");
 718
 719          when others =>
 720             raise Program_Error;
 721       end case;
 722
 723       Get_Unqualified_Decoded_Name_String (Chars (Ent));
 724       Write_Str (Name_Buffer (1 .. Name_Len));
 725       Write_Str (" declared at ");
 726       Write_Location (Sloc (Ent));
 727       Write_Eol;
 728
 729       Write_Str ("  convention : ");
 730
 731       case Convention (Ent) is
 732          when Convention_Ada =>
 733             Write_Line ("Ada");
 734
 735          when Convention_Ada_Pass_By_Copy =>
 736             Write_Line ("Ada_Pass_By_Copy");
 737
 738          when Convention_Ada_Pass_By_Reference =>
 739             Write_Line ("Ada_Pass_By_Reference");
 740
 741          when Convention_Intrinsic =>
 742             Write_Line ("Intrinsic");
 743
 744          when Convention_Entry =>
 745             Write_Line ("Entry");
 746
 747          when Convention_Protected =>
 748             Write_Line ("Protected");
 749
 750          when Convention_Assembler =>
 751             Write_Line ("Assembler");
 752
 753          when Convention_C =>
 754             Write_Line ("C");
 755
 756          when Convention_COBOL =>
 757             Write_Line ("COBOL");
 758
 759          when Convention_CPP =>
 760             Write_Line ("C++");
 761
 762          when Convention_Fortran =>
 763             Write_Line ("Fortran");
 764
 765          when Convention_Stdcall =>
 766             Write_Line ("Stdcall");
 767
 768          when Convention_Stubbed =>
 769             Write_Line ("Stubbed");
 770       end case;
 771
 772       --  Find max length of formal name
 773
 774       Plen := 0;
 775       Form := First_Formal (Ent);
 776       while Present (Form) loop
 777          Get_Unqualified_Decoded_Name_String (Chars (Form));
 778
 779          if Name_Len > Plen then
 780             Plen := Name_Len;
 781          end if;
 782
 783          Next_Formal (Form);
 784       end loop;
 785
 786       --  Output formals and mechanisms
 787
 788       Form := First_Formal (Ent);
 789       while Present (Form) loop
 790          Get_Unqualified_Decoded_Name_String (Chars (Form));
 791          while Name_Len <= Plen loop
 792             Name_Len := Name_Len + 1;
 793             Name_Buffer (Name_Len) := ' ';
 794          end loop;
 795
 796          Write_Str ("  ");
 797          Write_Str (Name_Buffer (1 .. Plen + 1));
 798          Write_Str (": passed by ");
 799
 800          Write_Mechanism (Mechanism (Form));
 801          Write_Eol;
 802          Next_Formal (Form);
 803       end loop;
 804
 805       if Etype (Ent) /= Standard_Void_Type then
 806          Write_Str ("  returns by ");
 807          Write_Mechanism (Mechanism (Ent));
 808          Write_Eol;
 809       end if;
 810    end List_Mechanisms;
 811
 812    ---------------
 813    -- List_Name --
 814    ---------------
 815
 816    procedure List_Name (Ent : Entity_Id) is
 817    begin
 818       if not Is_Compilation_Unit (Scope (Ent)) then
 819          List_Name (Scope (Ent));
 820          Write_Char ('.');
 821       end if;
 822
 823       Get_Unqualified_Decoded_Name_String (Chars (Ent));
 824       Set_Casing (Unit_Casing);
 825       Write_Str (Name_Buffer (1 .. Name_Len));
 826    end List_Name;
 827
 828    ---------------------
 829    -- List_Object_Info --
 830    ---------------------
 831
 832    procedure List_Object_Info (Ent : Entity_Id) is
 833    begin
 834       Blank_Line;
 835
 836       Write_Str ("for ");
 837       List_Name (Ent);
 838       Write_Str ("'Size use ");
 839       Write_Val (Esize (Ent));
 840       Write_Line (";");
 841
 842       Write_Str ("for ");
 843       List_Name (Ent);
 844       Write_Str ("'Alignment use ");
 845       Write_Val (Alignment (Ent));
 846       Write_Line (";");
 847    end List_Object_Info;
 848
 849    ----------------------
 850    -- List_Record_Info --
 851    ----------------------
 852
 853    procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
 854       procedure Compute_Max_Length
 855         (Ent                : Entity_Id;
 856          Starting_Position  : Uint := Uint_0;
 857          Starting_First_Bit : Uint := Uint_0;
 858          Prefix_Length      : Natural := 0);
 859       --  Internal recursive procedure to compute the max length
 860
 861       procedure List_Record_Layout
 862         (Ent                : Entity_Id;
 863          Starting_Position  : Uint := Uint_0;
 864          Starting_First_Bit : Uint := Uint_0;
 865          Prefix             : String := "");
 866       --  Internal recursive procedure to display the layout
 867
 868       Max_Name_Length : Natural := 0;
 869       Max_Spos_Length : Natural := 0;
 870
 871       ------------------------
 872       -- Compute_Max_Length --
 873       ------------------------
 874
 875       procedure Compute_Max_Length
 876         (Ent                : Entity_Id;
 877          Starting_Position  : Uint := Uint_0;
 878          Starting_First_Bit : Uint := Uint_0;
 879          Prefix_Length      : Natural := 0)
 880       is
 881          Comp : Entity_Id;
 882
 883       begin
 884          Comp := First_Component_Or_Discriminant (Ent);
 885          while Present (Comp) loop
 886
 887             --  Skip discriminant in unchecked union (since it is not there!)
 888
 889             if Ekind (Comp) = E_Discriminant
 890               and then Is_Unchecked_Union (Ent)
 891             then
 892                goto Continue;
 893             end if;
 894
 895             --  All other cases
 896
 897             declare
 898                Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
 899                Bofs : constant Uint      := Component_Bit_Offset (Comp);
 900                Npos : Uint;
 901                Fbit : Uint;
 902                Spos : Uint;
 903                Sbit : Uint;
 904
 905                Name_Length : Natural;
 906
 907             begin
 908                Get_Decoded_Name_String (Chars (Comp));
 909                Name_Length := Prefix_Length + Name_Len;
 910
 911                if Rep_Not_Constant (Bofs) then
 912
 913                   --  If the record is not packed, then we know that all fields
 914                   --  whose position is not specified have starting normalized
 915                   --  bit position of zero.
 916
 917                   if Unknown_Normalized_First_Bit (Comp)
 918                     and then not Is_Packed (Ent)
 919                   then
 920                      Set_Normalized_First_Bit (Comp, Uint_0);
 921                   end if;
 922
 923                   UI_Image_Length := 2; -- For "??" marker
 924                else
 925                   Npos := Bofs / SSU;
 926                   Fbit := Bofs mod SSU;
 927
 928                   --  Complete annotation in case not done
 929
 930                   if Unknown_Normalized_First_Bit (Comp) then
 931                      Set_Normalized_Position  (Comp, Npos);
 932                      Set_Normalized_First_Bit (Comp, Fbit);
 933                   end if;
 934
 935                   Spos := Starting_Position  + Npos;
 936                   Sbit := Starting_First_Bit + Fbit;
 937
 938                   if Sbit >= SSU then
 939                      Spos := Spos + 1;
 940                      Sbit := Sbit - SSU;
 941                   end if;
 942
 943                   --  If extended information is requested, recurse fully into
 944                   --  record components, i.e. skip the outer level.
 945
 946                   if List_Representation_Info_Extended
 947                     and then Is_Record_Type (Ctyp)
 948                   then
 949                      Compute_Max_Length (Ctyp, Spos, Sbit, Name_Length + 1);
 950                      goto Continue;
 951                   end if;
 952
 953                   UI_Image (Spos);
 954                end if;
 955
 956                Max_Name_Length := Natural'Max (Max_Name_Length, Name_Length);
 957                Max_Spos_Length :=
 958                  Natural'Max (Max_Spos_Length, UI_Image_Length);
 959             end;
 960
 961          <<Continue>>
 962             Next_Component_Or_Discriminant (Comp);
 963          end loop;
 964       end Compute_Max_Length;
 965
 966       ------------------------
 967       -- List_Record_Layout --
 968       ------------------------
 969
 970       procedure List_Record_Layout
 971         (Ent                : Entity_Id;
 972          Starting_Position  : Uint := Uint_0;
 973          Starting_First_Bit : Uint := Uint_0;
 974          Prefix             : String := "")
 975       is
 976          Comp : Entity_Id;
 977
 978       begin
 979          Comp := First_Component_Or_Discriminant (Ent);
 980          while Present (Comp) loop
 981
 982             --  Skip discriminant in unchecked union (since it is not there!)
 983
 984             if Ekind (Comp) = E_Discriminant
 985               and then Is_Unchecked_Union (Ent)
 986             then
 987                goto Continue;
 988             end if;
 989
 990             --  All other cases
 991
 992             declare
 993                Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
 994                Esiz : constant Uint      := Esize (Comp);
 995                Bofs : constant Uint      := Component_Bit_Offset (Comp);
 996                Npos : constant Uint      := Normalized_Position (Comp);
 997                Fbit : constant Uint      := Normalized_First_Bit (Comp);
 998                Spos : Uint;
 999                Sbit : Uint;
1000                Lbit : Uint;
1001
1002             begin
1003                Get_Decoded_Name_String (Chars (Comp));
1004                Set_Casing (Unit_Casing);
1005
1006                --  If extended information is requested, recurse fully into
1007                --  record components, i.e. skip the outer level.
1008
1009                if List_Representation_Info_Extended
1010                  and then Is_Record_Type (Ctyp)
1011                  and then Known_Static_Normalized_Position (Comp)
1012                  and then Known_Static_Normalized_First_Bit (Comp)
1013                then
1014                   Spos := Starting_Position  + Npos;
1015                   Sbit := Starting_First_Bit + Fbit;
1016
1017                   if Sbit >= SSU then
1018                      Spos := Spos + 1;
1019                      Sbit := Sbit - SSU;
1020                   end if;
1021
1022                   List_Record_Layout (Ctyp,
1023                     Spos, Sbit, Prefix & Name_Buffer (1 .. Name_Len) & ".");
1024
1025                   goto Continue;
1026                end if;
1027
1028                Write_Str ("   ");
1029                Write_Str (Prefix);
1030                Write_Str (Name_Buffer (1 .. Name_Len));
1031
1032                for J in 1 .. Max_Name_Length -  Prefix'Length - Name_Len loop
1033                   Write_Char (' ');
1034                end loop;
1035
1036                Write_Str (" at ");
1037
1038                if Known_Static_Normalized_Position (Comp) then
1039                   Spos := Starting_Position  + Npos;
1040                   Sbit := Starting_First_Bit + Fbit;
1041
1042                   if Sbit >= SSU then
1043                      Spos := Spos + 1;
1044                   end if;
1045
1046                   UI_Image (Spos);
1047                   Spaces (Max_Spos_Length - UI_Image_Length);
1048                   Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
1049
1050                elsif Known_Component_Bit_Offset (Comp)
1051                  and then List_Representation_Info = 3
1052                then
1053                   Spaces (Max_Spos_Length - 2);
1054                   Write_Str ("bit offset ");
1055
1056                   if Starting_Position /= Uint_0
1057                     or else Starting_First_Bit /= Uint_0
1058                   then
1059                      UI_Write (Starting_Position * SSU + Starting_First_Bit);
1060                      Write_Str (" + ");
1061                   end if;
1062
1063                   Write_Val (Bofs, Paren => True);
1064                   Write_Str (" size in bits = ");
1065                   Write_Val (Esiz, Paren => True);
1066                   Write_Eol;
1067
1068                   goto Continue;
1069
1070                elsif Known_Normalized_Position (Comp)
1071                  and then List_Representation_Info = 3
1072                then
1073                   Spaces (Max_Spos_Length - 2);
1074
1075                   if Starting_Position /= Uint_0 then
1076                      Write_Char (' ');
1077                      UI_Write (Starting_Position);
1078                      Write_Str (" +");
1079                   end if;
1080
1081                   Write_Val (Npos);
1082
1083                else
1084                   --  For the packed case, we don't know the bit positions if
1085                   --  we don't know the starting position.
1086
1087                   if Is_Packed (Ent) then
1088                      Write_Line ("?? range  ? .. ??;");
1089                      goto Continue;
1090
1091                   --  Otherwise we can continue
1092
1093                   else
1094                      Write_Str ("??");
1095                   end if;
1096                end if;
1097
1098                Write_Str (" range  ");
1099                Sbit := Starting_First_Bit + Fbit;
1100
1101                if Sbit >= SSU then
1102                   Sbit := Sbit - SSU;
1103                end if;
1104
1105                UI_Write (Sbit);
1106                Write_Str (" .. ");
1107
1108                --  Allowing Uint_0 here is an annoying special case. Really
1109                --  this should be a fine Esize value but currently it means
1110                --  unknown, except that we know after gigi has back annotated
1111                --  that a size  of zero is real, since otherwise gigi back
1112                --  annotates using No_Uint as the value to indicate unknown).
1113
1114                if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
1115                  and then Known_Static_Normalized_First_Bit (Comp)
1116                then
1117                   Lbit := Sbit + Esiz - 1;
1118
1119                   if Lbit < 10 then
1120                      Write_Char (' ');
1121                   end if;
1122
1123                   UI_Write (Lbit);
1124
1125                --  The test for Esize (Comp) not Uint_0 here is an annoying
1126                --  special case. Officially a value of zero for Esize means
1127                --  unknown, but here we use the fact that we know that gigi
1128                --  annotates Esize with No_Uint, not Uint_0. Really everyone
1129                --  should use No_Uint???
1130
1131                elsif List_Representation_Info < 3
1132                  or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
1133                then
1134                   Write_Str ("??");
1135
1136                --  List_Representation >= 3 and Known_Esize (Comp)
1137
1138                else
1139                   Write_Val (Esiz, Paren => True);
1140
1141                   --  If in front end layout mode, then dynamic size is stored
1142                   --  in storage units, so renormalize for output
1143
1144                   if not Back_End_Layout then
1145                      Write_Str (" * ");
1146                      Write_Int (SSU);
1147                   end if;
1148
1149                   --  Add appropriate first bit offset
1150
1151                   if Sbit = 0 then
1152                      Write_Str (" - 1");
1153
1154                   elsif Sbit = 1 then
1155                      null;
1156
1157                   else
1158                      Write_Str (" + ");
1159                      Write_Int (UI_To_Int (Sbit) - 1);
1160                   end if;
1161                end if;
1162
1163                Write_Line (";");
1164             end;
1165
1166          <<Continue>>
1167             Next_Component_Or_Discriminant (Comp);
1168          end loop;
1169       end List_Record_Layout;
1170
1171    --  Start of processing for List_Record_Info
1172
1173    begin
1174       Blank_Line;
1175       List_Type_Info (Ent);
1176
1177       Write_Str ("for ");
1178       List_Name (Ent);
1179       Write_Line (" use record");
1180
1181       --  First find out max line length and max starting position
1182       --  length, for the purpose of lining things up nicely.
1183
1184       Compute_Max_Length (Ent);
1185
1186       --  Then do actual output based on those values
1187
1188       List_Record_Layout (Ent);
1189
1190       Write_Line ("end record;");
1191
1192       List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
1193    end List_Record_Info;
1194
1195    -------------------
1196    -- List_Rep_Info --
1197    -------------------
1198
1199    procedure List_Rep_Info (Bytes_Big_Endian : Boolean) is
1200       Col : Nat;
1201
1202    begin
1203       if List_Representation_Info /= 0
1204         or else List_Representation_Info_Mechanisms
1205       then
1206          for U in Main_Unit .. Last_Unit loop
1207             if In_Extended_Main_Source_Unit (Cunit_Entity (U)) then
1208                Unit_Casing := Identifier_Casing (Source_Index (U));
1209
1210                --  Normal case, list to standard output
1211
1212                if not List_Representation_Info_To_File then
1213                   Write_Eol;
1214                   Write_Str ("Representation information for unit ");
1215                   Write_Unit_Name (Unit_Name (U));
1216                   Col := Column;
1217                   Write_Eol;
1218
1219                   for J in 1 .. Col - 1 loop
1220                      Write_Char ('-');
1221                   end loop;
1222
1223                   Write_Eol;
1224                   List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1225
1226                --  List representation information to file
1227
1228                else
1229                   Create_Repinfo_File_Access.all
1230                     (Get_Name_String (File_Name (Source_Index (U))));
1231                   Set_Special_Output (Write_Info_Line'Access);
1232                   List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1233                   Set_Special_Output (null);
1234                   Close_Repinfo_File_Access.all;
1235                end if;
1236             end if;
1237          end loop;
1238       end if;
1239    end List_Rep_Info;
1240
1241    -------------------------------
1242    -- List_Scalar_Storage_Order --
1243    -------------------------------
1244
1245    procedure List_Scalar_Storage_Order
1246      (Ent              : Entity_Id;
1247       Bytes_Big_Endian : Boolean)
1248    is
1249       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean);
1250       --  Show attribute definition clause for Attr_Name (an endianness
1251       --  attribute), depending on whether or not the endianness is reversed
1252       --  compared to native endianness.
1253
1254       ---------------
1255       -- List_Attr --
1256       ---------------
1257
1258       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean) is
1259       begin
1260          Write_Str ("for ");
1261          List_Name (Ent);
1262          Write_Str ("'" & Attr_Name & " use System.");
1263
1264          if Bytes_Big_Endian xor Is_Reversed then
1265             Write_Str ("High");
1266          else
1267             Write_Str ("Low");
1268          end if;
1269
1270          Write_Line ("_Order_First;");
1271       end List_Attr;
1272
1273       List_SSO : constant Boolean :=
1274                    Has_Rep_Item (Ent, Name_Scalar_Storage_Order)
1275                      or else SSO_Set_Low_By_Default  (Ent)
1276                      or else SSO_Set_High_By_Default (Ent);
1277       --  Scalar_Storage_Order is displayed if specified explicitly
1278       --  or set by Default_Scalar_Storage_Order.
1279
1280    --  Start of processing for List_Scalar_Storage_Order
1281
1282    begin
1283       --  For record types, list Bit_Order if not default, or if SSO is shown
1284
1285       if Is_Record_Type (Ent)
1286         and then (List_SSO or else Reverse_Bit_Order (Ent))
1287       then
1288          List_Attr ("Bit_Order", Reverse_Bit_Order (Ent));
1289       end if;
1290
1291       --  List SSO if required. If not, then storage is supposed to be in
1292       --  native order.
1293
1294       if List_SSO then
1295          List_Attr ("Scalar_Storage_Order", Reverse_Storage_Order (Ent));
1296       else
1297          pragma Assert (not Reverse_Storage_Order (Ent));
1298          null;
1299       end if;
1300    end List_Scalar_Storage_Order;
1301
1302    --------------------
1303    -- List_Type_Info --
1304    --------------------
1305
1306    procedure List_Type_Info (Ent : Entity_Id) is
1307    begin
1308       Blank_Line;
1309
1310       --  Do not list size info for unconstrained arrays, not meaningful
1311
1312       if Is_Array_Type (Ent) and then not Is_Constrained (Ent) then
1313          null;
1314
1315       else
1316          --  If Esize and RM_Size are the same and known, list as Size. This
1317          --  is a common case, which we may as well list in simple form.
1318
1319          if Esize (Ent) = RM_Size (Ent) then
1320             Write_Str ("for ");
1321             List_Name (Ent);
1322             Write_Str ("'Size use ");
1323             Write_Val (Esize (Ent));
1324             Write_Line (";");
1325
1326          --  For now, temporary case, to be removed when gigi properly back
1327          --  annotates RM_Size, if RM_Size is not set, then list Esize as Size.
1328          --  This avoids odd Object_Size output till we fix things???
1329
1330          elsif Unknown_RM_Size (Ent) then
1331             Write_Str ("for ");
1332             List_Name (Ent);
1333             Write_Str ("'Size use ");
1334             Write_Val (Esize (Ent));
1335             Write_Line (";");
1336
1337          --  Otherwise list size values separately if they are set
1338
1339          else
1340             Write_Str ("for ");
1341             List_Name (Ent);
1342             Write_Str ("'Object_Size use ");
1343             Write_Val (Esize (Ent));
1344             Write_Line (";");
1345
1346             --  Note on following check: The RM_Size of a discrete type can
1347             --  legitimately be set to zero, so a special check is needed.
1348
1349             Write_Str ("for ");
1350             List_Name (Ent);
1351             Write_Str ("'Value_Size use ");
1352             Write_Val (RM_Size (Ent));
1353             Write_Line (";");
1354          end if;
1355       end if;
1356
1357       Write_Str ("for ");
1358       List_Name (Ent);
1359       Write_Str ("'Alignment use ");
1360       Write_Val (Alignment (Ent));
1361       Write_Line (";");
1362
1363       --  Special stuff for fixed-point
1364
1365       if Is_Fixed_Point_Type (Ent) then
1366
1367          --  Write small (always a static constant)
1368
1369          Write_Str ("for ");
1370          List_Name (Ent);
1371          Write_Str ("'Small use ");
1372          UR_Write (Small_Value (Ent));
1373          Write_Line (";");
1374
1375          --  Write range if static
1376
1377          declare
1378             R : constant Node_Id := Scalar_Range (Ent);
1379
1380          begin
1381             if Nkind (Low_Bound (R)) = N_Real_Literal
1382                  and then
1383                Nkind (High_Bound (R)) = N_Real_Literal
1384             then
1385                Write_Str ("for ");
1386                List_Name (Ent);
1387                Write_Str ("'Range use ");
1388                UR_Write (Realval (Low_Bound (R)));
1389                Write_Str (" .. ");
1390                UR_Write (Realval (High_Bound (R)));
1391                Write_Line (";");
1392             end if;
1393          end;
1394       end if;
1395    end List_Type_Info;
1396
1397    ----------------------
1398    -- Rep_Not_Constant --
1399    ----------------------
1400
1401    function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean is
1402    begin
1403       if Val = No_Uint or else Val < 0 then
1404          return True;
1405       else
1406          return False;
1407       end if;
1408    end Rep_Not_Constant;
1409
1410    ---------------
1411    -- Rep_Value --
1412    ---------------
1413
1414    function Rep_Value
1415      (Val : Node_Ref_Or_Val;
1416       D   : Discrim_List) return Uint
1417    is
1418       function B (Val : Boolean) return Uint;
1419       --  Returns Uint_0 for False, Uint_1 for True
1420
1421       function T (Val : Node_Ref_Or_Val) return Boolean;
1422       --  Returns True for 0, False for any non-zero (i.e. True)
1423
1424       function V (Val : Node_Ref_Or_Val) return Uint;
1425       --  Internal recursive routine to evaluate tree
1426
1427       function W (Val : Uint) return Word;
1428       --  Convert Val to Word, assuming Val is always in the Int range. This
1429       --  is a helper function for the evaluation of bitwise expressions like
1430       --  Bit_And_Expr, for which there is no direct support in uintp. Uint
1431       --  values out of the Int range are expected to be seen in such
1432       --  expressions only with overflowing byte sizes around, introducing
1433       --  inherent unreliabilities in computations anyway.
1434
1435       -------
1436       -- B --
1437       -------
1438
1439       function B (Val : Boolean) return Uint is
1440       begin
1441          if Val then
1442             return Uint_1;
1443          else
1444             return Uint_0;
1445          end if;
1446       end B;
1447
1448       -------
1449       -- T --
1450       -------
1451
1452       function T (Val : Node_Ref_Or_Val) return Boolean is
1453       begin
1454          if V (Val) = 0 then
1455             return False;
1456          else
1457             return True;
1458          end if;
1459       end T;
1460
1461       -------
1462       -- V --
1463       -------
1464
1465       function V (Val : Node_Ref_Or_Val) return Uint is
1466          L, R, Q : Uint;
1467
1468       begin
1469          if Val >= 0 then
1470             return Val;
1471
1472          else
1473             declare
1474                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
1475
1476             begin
1477                case Node.Expr is
1478                   when Cond_Expr =>
1479                      if T (Node.Op1) then
1480                         return V (Node.Op2);
1481                      else
1482                         return V (Node.Op3);
1483                      end if;
1484
1485                   when Plus_Expr =>
1486                      return V (Node.Op1) + V (Node.Op2);
1487
1488                   when Minus_Expr =>
1489                      return V (Node.Op1) - V (Node.Op2);
1490
1491                   when Mult_Expr =>
1492                      return V (Node.Op1) * V (Node.Op2);
1493
1494                   when Trunc_Div_Expr =>
1495                      return V (Node.Op1) / V (Node.Op2);
1496
1497                   when Ceil_Div_Expr =>
1498                      return
1499                        UR_Ceiling
1500                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
1501
1502                   when Floor_Div_Expr =>
1503                      return
1504                        UR_Floor
1505                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
1506
1507                   when Trunc_Mod_Expr =>
1508                      return V (Node.Op1) rem V (Node.Op2);
1509
1510                   when Floor_Mod_Expr =>
1511                      return V (Node.Op1) mod V (Node.Op2);
1512
1513                   when Ceil_Mod_Expr =>
1514                      L := V (Node.Op1);
1515                      R := V (Node.Op2);
1516                      Q := UR_Ceiling (L / UR_From_Uint (R));
1517                      return L - R * Q;
1518
1519                   when Exact_Div_Expr =>
1520                      return V (Node.Op1) / V (Node.Op2);
1521
1522                   when Negate_Expr =>
1523                      return -V (Node.Op1);
1524
1525                   when Min_Expr =>
1526                      return UI_Min (V (Node.Op1), V (Node.Op2));
1527
1528                   when Max_Expr =>
1529                      return UI_Max (V (Node.Op1), V (Node.Op2));
1530
1531                   when Abs_Expr =>
1532                      return UI_Abs (V (Node.Op1));
1533
1534                   when Truth_Andif_Expr =>
1535                      return B (T (Node.Op1) and then T (Node.Op2));
1536
1537                   when Truth_Orif_Expr =>
1538                      return B (T (Node.Op1) or else T (Node.Op2));
1539
1540                   when Truth_And_Expr =>
1541                      return B (T (Node.Op1) and then T (Node.Op2));
1542
1543                   when Truth_Or_Expr =>
1544                      return B (T (Node.Op1) or else T (Node.Op2));
1545
1546                   when Truth_Xor_Expr =>
1547                      return B (T (Node.Op1) xor T (Node.Op2));
1548
1549                   when Truth_Not_Expr =>
1550                      return B (not T (Node.Op1));
1551
1552                   when Bit_And_Expr =>
1553                      L := V (Node.Op1);
1554                      R := V (Node.Op2);
1555                      return UI_From_Int (Int (W (L) and W (R)));
1556
1557                   when Lt_Expr =>
1558                      return B (V (Node.Op1) < V (Node.Op2));
1559
1560                   when Le_Expr =>
1561                      return B (V (Node.Op1) <= V (Node.Op2));
1562
1563                   when Gt_Expr =>
1564                      return B (V (Node.Op1) > V (Node.Op2));
1565
1566                   when Ge_Expr =>
1567                      return B (V (Node.Op1) >= V (Node.Op2));
1568
1569                   when Eq_Expr =>
1570                      return B (V (Node.Op1) = V (Node.Op2));
1571
1572                   when Ne_Expr =>
1573                      return B (V (Node.Op1) /= V (Node.Op2));
1574
1575                   when Discrim_Val =>
1576                      declare
1577                         Sub : constant Int := UI_To_Int (Node.Op1);
1578                      begin
1579                         pragma Assert (Sub in D'Range);
1580                         return D (Sub);
1581                      end;
1582
1583                   when Dynamic_Val =>
1584                      return No_Uint;
1585                end case;
1586             end;
1587          end if;
1588       end V;
1589
1590       -------
1591       -- W --
1592       -------
1593
1594       --  We use an unchecked conversion to map Int values to their Word
1595       --  bitwise equivalent, which we could not achieve with a normal type
1596       --  conversion for negative Ints. We want bitwise equivalents because W
1597       --  is used as a helper for bit operators like Bit_And_Expr, and can be
1598       --  called for negative Ints in the context of aligning expressions like
1599       --  X+Align & -Align.
1600
1601       function W (Val : Uint) return Word is
1602          function To_Word is new Ada.Unchecked_Conversion (Int, Word);
1603       begin
1604          return To_Word (UI_To_Int (Val));
1605       end W;
1606
1607    --  Start of processing for Rep_Value
1608
1609    begin
1610       if Val = No_Uint then
1611          return No_Uint;
1612
1613       else
1614          return V (Val);
1615       end if;
1616    end Rep_Value;
1617
1618    ------------
1619    -- Spaces --
1620    ------------
1621
1622    procedure Spaces (N : Natural) is
1623    begin
1624       for J in 1 .. N loop
1625          Write_Char (' ');
1626       end loop;
1627    end Spaces;
1628
1629    ---------------
1630    -- Tree_Read --
1631    ---------------
1632
1633    procedure Tree_Read is
1634    begin
1635       Rep_Table.Tree_Read;
1636    end Tree_Read;
1637
1638    ----------------
1639    -- Tree_Write --
1640    ----------------
1641
1642    procedure Tree_Write is
1643    begin
1644       Rep_Table.Tree_Write;
1645    end Tree_Write;
1646
1647    ---------------------
1648    -- Write_Info_Line --
1649    ---------------------
1650
1651    procedure Write_Info_Line (S : String) is
1652    begin
1653       Write_Repinfo_Line_Access.all (S (S'First .. S'Last - 1));
1654    end Write_Info_Line;
1655
1656    ---------------------
1657    -- Write_Mechanism --
1658    ---------------------
1659
1660    procedure Write_Mechanism (M : Mechanism_Type) is
1661    begin
1662       case M is
1663          when 0 =>
1664             Write_Str ("default");
1665
1666          when -1 =>
1667             Write_Str ("copy");
1668
1669          when -2 =>
1670             Write_Str ("reference");
1671
1672          when others =>
1673             raise Program_Error;
1674       end case;
1675    end Write_Mechanism;
1676
1677    ---------------
1678    -- Write_Val --
1679    ---------------
1680
1681    procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False) is
1682    begin
1683       if Rep_Not_Constant (Val) then
1684          if List_Representation_Info < 3 or else Val = No_Uint then
1685             Write_Str ("??");
1686
1687          else
1688             if Paren then
1689                Write_Char ('(');
1690             end if;
1691
1692             if Back_End_Layout then
1693                List_GCC_Expression (Val);
1694             else
1695                Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
1696             end if;
1697
1698             if Paren then
1699                Write_Char (')');
1700             end if;
1701          end if;
1702
1703       else
1704          UI_Write (Val);
1705       end if;
1706    end Write_Val;
1707
1708 end Repinfo;