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                Npos : constant Uint      := Normalized_Position (Comp);
 996                Fbit : constant Uint      := Normalized_First_Bit (Comp);
 997                Spos : Uint;
 998                Sbit : Uint;
 999                Lbit : Uint;
1000
1001             begin
1002                Get_Decoded_Name_String (Chars (Comp));
1003                Set_Casing (Unit_Casing);
1004
1005                --  If extended information is requested, recurse fully into
1006                --  record components, i.e. skip the outer level.
1007
1008                if List_Representation_Info_Extended
1009                  and then Is_Record_Type (Ctyp)
1010                  and then Known_Static_Normalized_Position (Comp)
1011                  and then Known_Static_Normalized_First_Bit (Comp)
1012                then
1013                   Spos := Starting_Position  + Npos;
1014                   Sbit := Starting_First_Bit + Fbit;
1015
1016                   if Sbit >= SSU then
1017                      Spos := Spos + 1;
1018                      Sbit := Sbit - SSU;
1019                   end if;
1020
1021                   List_Record_Layout (Ctyp,
1022                     Spos, Sbit, Prefix & Name_Buffer (1 .. Name_Len) & ".");
1023
1024                   goto Continue;
1025                end if;
1026
1027                Write_Str ("   ");
1028                Write_Str (Prefix);
1029                Write_Str (Name_Buffer (1 .. Name_Len));
1030
1031                for J in 1 .. Max_Name_Length -  Prefix'Length - Name_Len loop
1032                   Write_Char (' ');
1033                end loop;
1034
1035                Write_Str (" at ");
1036
1037                if Known_Static_Normalized_Position (Comp) then
1038                   Spos := Starting_Position  + Npos;
1039                   Sbit := Starting_First_Bit + Fbit;
1040
1041                   if Sbit >= SSU then
1042                      Spos := Spos + 1;
1043                   end if;
1044
1045                   UI_Image (Spos);
1046                   Spaces (Max_Spos_Length - UI_Image_Length);
1047                   Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
1048
1049                elsif Known_Normalized_Position (Comp)
1050                  and then List_Representation_Info = 3
1051                then
1052                   Spaces (Max_Spos_Length - 2);
1053
1054                   if Starting_Position /= Uint_0 then
1055                      UI_Write (Starting_Position);
1056                      Write_Str (" + ");
1057                   end if;
1058
1059                   Write_Val (Npos);
1060
1061                else
1062                   --  For the packed case, we don't know the bit positions if
1063                   --  we don't know the starting position.
1064
1065                   if Is_Packed (Ent) then
1066                      Write_Line ("?? range  ? .. ??;");
1067                      goto Continue;
1068
1069                   --  Otherwise we can continue
1070
1071                   else
1072                      Write_Str ("??");
1073                   end if;
1074                end if;
1075
1076                Write_Str (" range  ");
1077                Sbit := Starting_First_Bit + Fbit;
1078
1079                if Sbit >= SSU then
1080                   Sbit := Sbit - SSU;
1081                end if;
1082
1083                UI_Write (Sbit);
1084                Write_Str (" .. ");
1085
1086                --  Allowing Uint_0 here is an annoying special case. Really
1087                --  this should be a fine Esize value but currently it means
1088                --  unknown, except that we know after gigi has back annotated
1089                --  that a size  of zero is real, since otherwise gigi back
1090                --  annotates using No_Uint as the value to indicate unknown).
1091
1092                if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
1093                  and then Known_Static_Normalized_First_Bit (Comp)
1094                then
1095                   Lbit := Sbit + Esiz - 1;
1096
1097                   if Lbit < 10 then
1098                      Write_Char (' ');
1099                   end if;
1100
1101                   UI_Write (Lbit);
1102
1103                --  The test for Esize (Comp) not Uint_0 here is an annoying
1104                --  special case. Officially a value of zero for Esize means
1105                --  unknown, but here we use the fact that we know that gigi
1106                --  annotates Esize with No_Uint, not Uint_0. Really everyone
1107                --  should use No_Uint???
1108
1109                elsif List_Representation_Info < 3
1110                  or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
1111                then
1112                   Write_Str ("??");
1113
1114                --  List_Representation >= 3 and Known_Esize (Comp)
1115
1116                else
1117                   Write_Val (Esiz, Paren => True);
1118
1119                   --  If in front end layout mode, then dynamic size is stored
1120                   --  in storage units, so renormalize for output
1121
1122                   if not Back_End_Layout then
1123                      Write_Str (" * ");
1124                      Write_Int (SSU);
1125                   end if;
1126
1127                   --  Add appropriate first bit offset
1128
1129                   if Sbit = 0 then
1130                      Write_Str (" - 1");
1131
1132                   elsif Sbit = 1 then
1133                      null;
1134
1135                   else
1136                      Write_Str (" + ");
1137                      Write_Int (UI_To_Int (Sbit) - 1);
1138                   end if;
1139                end if;
1140
1141                Write_Line (";");
1142             end;
1143
1144          <<Continue>>
1145             Next_Component_Or_Discriminant (Comp);
1146          end loop;
1147       end List_Record_Layout;
1148
1149    --  Start of processing for List_Record_Info
1150
1151    begin
1152       Blank_Line;
1153       List_Type_Info (Ent);
1154
1155       Write_Str ("for ");
1156       List_Name (Ent);
1157       Write_Line (" use record");
1158
1159       --  First find out max line length and max starting position
1160       --  length, for the purpose of lining things up nicely.
1161
1162       Compute_Max_Length (Ent);
1163
1164       --  Then do actual output based on those values
1165
1166       List_Record_Layout (Ent);
1167
1168       Write_Line ("end record;");
1169
1170       List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
1171    end List_Record_Info;
1172
1173    -------------------
1174    -- List_Rep_Info --
1175    -------------------
1176
1177    procedure List_Rep_Info (Bytes_Big_Endian : Boolean) is
1178       Col : Nat;
1179
1180    begin
1181       if List_Representation_Info /= 0
1182         or else List_Representation_Info_Mechanisms
1183       then
1184          for U in Main_Unit .. Last_Unit loop
1185             if In_Extended_Main_Source_Unit (Cunit_Entity (U)) then
1186                Unit_Casing := Identifier_Casing (Source_Index (U));
1187
1188                --  Normal case, list to standard output
1189
1190                if not List_Representation_Info_To_File then
1191                   Write_Eol;
1192                   Write_Str ("Representation information for unit ");
1193                   Write_Unit_Name (Unit_Name (U));
1194                   Col := Column;
1195                   Write_Eol;
1196
1197                   for J in 1 .. Col - 1 loop
1198                      Write_Char ('-');
1199                   end loop;
1200
1201                   Write_Eol;
1202                   List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1203
1204                --  List representation information to file
1205
1206                else
1207                   Create_Repinfo_File_Access.all
1208                     (Get_Name_String (File_Name (Source_Index (U))));
1209                   Set_Special_Output (Write_Info_Line'Access);
1210                   List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
1211                   Set_Special_Output (null);
1212                   Close_Repinfo_File_Access.all;
1213                end if;
1214             end if;
1215          end loop;
1216       end if;
1217    end List_Rep_Info;
1218
1219    -------------------------------
1220    -- List_Scalar_Storage_Order --
1221    -------------------------------
1222
1223    procedure List_Scalar_Storage_Order
1224      (Ent              : Entity_Id;
1225       Bytes_Big_Endian : Boolean)
1226    is
1227       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean);
1228       --  Show attribute definition clause for Attr_Name (an endianness
1229       --  attribute), depending on whether or not the endianness is reversed
1230       --  compared to native endianness.
1231
1232       ---------------
1233       -- List_Attr --
1234       ---------------
1235
1236       procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean) is
1237       begin
1238          Write_Str ("for ");
1239          List_Name (Ent);
1240          Write_Str ("'" & Attr_Name & " use System.");
1241
1242          if Bytes_Big_Endian xor Is_Reversed then
1243             Write_Str ("High");
1244          else
1245             Write_Str ("Low");
1246          end if;
1247
1248          Write_Line ("_Order_First;");
1249       end List_Attr;
1250
1251       List_SSO : constant Boolean :=
1252                    Has_Rep_Item (Ent, Name_Scalar_Storage_Order)
1253                      or else SSO_Set_Low_By_Default  (Ent)
1254                      or else SSO_Set_High_By_Default (Ent);
1255       --  Scalar_Storage_Order is displayed if specified explicitly
1256       --  or set by Default_Scalar_Storage_Order.
1257
1258    --  Start of processing for List_Scalar_Storage_Order
1259
1260    begin
1261       --  For record types, list Bit_Order if not default, or if SSO is shown
1262
1263       if Is_Record_Type (Ent)
1264         and then (List_SSO or else Reverse_Bit_Order (Ent))
1265       then
1266          List_Attr ("Bit_Order", Reverse_Bit_Order (Ent));
1267       end if;
1268
1269       --  List SSO if required. If not, then storage is supposed to be in
1270       --  native order.
1271
1272       if List_SSO then
1273          List_Attr ("Scalar_Storage_Order", Reverse_Storage_Order (Ent));
1274       else
1275          pragma Assert (not Reverse_Storage_Order (Ent));
1276          null;
1277       end if;
1278    end List_Scalar_Storage_Order;
1279
1280    --------------------
1281    -- List_Type_Info --
1282    --------------------
1283
1284    procedure List_Type_Info (Ent : Entity_Id) is
1285    begin
1286       Blank_Line;
1287
1288       --  Do not list size info for unconstrained arrays, not meaningful
1289
1290       if Is_Array_Type (Ent) and then not Is_Constrained (Ent) then
1291          null;
1292
1293       else
1294          --  If Esize and RM_Size are the same, list as Size. This is a common
1295          --  case, which we may as well list in simple form.
1296
1297          if Esize (Ent) = RM_Size (Ent) then
1298             Write_Str ("for ");
1299             List_Name (Ent);
1300             Write_Str ("'Size use ");
1301             Write_Val (Esize (Ent));
1302             Write_Line (";");
1303
1304          --  Otherwise list size values separately
1305
1306          else
1307             Write_Str ("for ");
1308             List_Name (Ent);
1309             Write_Str ("'Object_Size use ");
1310             Write_Val (Esize (Ent));
1311             Write_Line (";");
1312
1313             Write_Str ("for ");
1314             List_Name (Ent);
1315             Write_Str ("'Value_Size use ");
1316             Write_Val (RM_Size (Ent));
1317             Write_Line (";");
1318          end if;
1319       end if;
1320
1321       Write_Str ("for ");
1322       List_Name (Ent);
1323       Write_Str ("'Alignment use ");
1324       Write_Val (Alignment (Ent));
1325       Write_Line (";");
1326
1327       --  Special stuff for fixed-point
1328
1329       if Is_Fixed_Point_Type (Ent) then
1330
1331          --  Write small (always a static constant)
1332
1333          Write_Str ("for ");
1334          List_Name (Ent);
1335          Write_Str ("'Small use ");
1336          UR_Write (Small_Value (Ent));
1337          Write_Line (";");
1338
1339          --  Write range if static
1340
1341          declare
1342             R : constant Node_Id := Scalar_Range (Ent);
1343
1344          begin
1345             if Nkind (Low_Bound (R)) = N_Real_Literal
1346                  and then
1347                Nkind (High_Bound (R)) = N_Real_Literal
1348             then
1349                Write_Str ("for ");
1350                List_Name (Ent);
1351                Write_Str ("'Range use ");
1352                UR_Write (Realval (Low_Bound (R)));
1353                Write_Str (" .. ");
1354                UR_Write (Realval (High_Bound (R)));
1355                Write_Line (";");
1356             end if;
1357          end;
1358       end if;
1359    end List_Type_Info;
1360
1361    ----------------------
1362    -- Rep_Not_Constant --
1363    ----------------------
1364
1365    function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean is
1366    begin
1367       if Val = No_Uint or else Val < 0 then
1368          return True;
1369       else
1370          return False;
1371       end if;
1372    end Rep_Not_Constant;
1373
1374    ---------------
1375    -- Rep_Value --
1376    ---------------
1377
1378    function Rep_Value
1379      (Val : Node_Ref_Or_Val;
1380       D   : Discrim_List) return Uint
1381    is
1382       function B (Val : Boolean) return Uint;
1383       --  Returns Uint_0 for False, Uint_1 for True
1384
1385       function T (Val : Node_Ref_Or_Val) return Boolean;
1386       --  Returns True for 0, False for any non-zero (i.e. True)
1387
1388       function V (Val : Node_Ref_Or_Val) return Uint;
1389       --  Internal recursive routine to evaluate tree
1390
1391       function W (Val : Uint) return Word;
1392       --  Convert Val to Word, assuming Val is always in the Int range. This
1393       --  is a helper function for the evaluation of bitwise expressions like
1394       --  Bit_And_Expr, for which there is no direct support in uintp. Uint
1395       --  values out of the Int range are expected to be seen in such
1396       --  expressions only with overflowing byte sizes around, introducing
1397       --  inherent unreliabilities in computations anyway.
1398
1399       -------
1400       -- B --
1401       -------
1402
1403       function B (Val : Boolean) return Uint is
1404       begin
1405          if Val then
1406             return Uint_1;
1407          else
1408             return Uint_0;
1409          end if;
1410       end B;
1411
1412       -------
1413       -- T --
1414       -------
1415
1416       function T (Val : Node_Ref_Or_Val) return Boolean is
1417       begin
1418          if V (Val) = 0 then
1419             return False;
1420          else
1421             return True;
1422          end if;
1423       end T;
1424
1425       -------
1426       -- V --
1427       -------
1428
1429       function V (Val : Node_Ref_Or_Val) return Uint is
1430          L, R, Q : Uint;
1431
1432       begin
1433          if Val >= 0 then
1434             return Val;
1435
1436          else
1437             declare
1438                Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
1439
1440             begin
1441                case Node.Expr is
1442                   when Cond_Expr =>
1443                      if T (Node.Op1) then
1444                         return V (Node.Op2);
1445                      else
1446                         return V (Node.Op3);
1447                      end if;
1448
1449                   when Plus_Expr =>
1450                      return V (Node.Op1) + V (Node.Op2);
1451
1452                   when Minus_Expr =>
1453                      return V (Node.Op1) - V (Node.Op2);
1454
1455                   when Mult_Expr =>
1456                      return V (Node.Op1) * V (Node.Op2);
1457
1458                   when Trunc_Div_Expr =>
1459                      return V (Node.Op1) / V (Node.Op2);
1460
1461                   when Ceil_Div_Expr =>
1462                      return
1463                        UR_Ceiling
1464                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
1465
1466                   when Floor_Div_Expr =>
1467                      return
1468                        UR_Floor
1469                          (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
1470
1471                   when Trunc_Mod_Expr =>
1472                      return V (Node.Op1) rem V (Node.Op2);
1473
1474                   when Floor_Mod_Expr =>
1475                      return V (Node.Op1) mod V (Node.Op2);
1476
1477                   when Ceil_Mod_Expr =>
1478                      L := V (Node.Op1);
1479                      R := V (Node.Op2);
1480                      Q := UR_Ceiling (L / UR_From_Uint (R));
1481                      return L - R * Q;
1482
1483                   when Exact_Div_Expr =>
1484                      return V (Node.Op1) / V (Node.Op2);
1485
1486                   when Negate_Expr =>
1487                      return -V (Node.Op1);
1488
1489                   when Min_Expr =>
1490                      return UI_Min (V (Node.Op1), V (Node.Op2));
1491
1492                   when Max_Expr =>
1493                      return UI_Max (V (Node.Op1), V (Node.Op2));
1494
1495                   when Abs_Expr =>
1496                      return UI_Abs (V (Node.Op1));
1497
1498                   when Truth_Andif_Expr =>
1499                      return B (T (Node.Op1) and then T (Node.Op2));
1500
1501                   when Truth_Orif_Expr =>
1502                      return B (T (Node.Op1) or else T (Node.Op2));
1503
1504                   when Truth_And_Expr =>
1505                      return B (T (Node.Op1) and then T (Node.Op2));
1506
1507                   when Truth_Or_Expr =>
1508                      return B (T (Node.Op1) or else T (Node.Op2));
1509
1510                   when Truth_Xor_Expr =>
1511                      return B (T (Node.Op1) xor T (Node.Op2));
1512
1513                   when Truth_Not_Expr =>
1514                      return B (not T (Node.Op1));
1515
1516                   when Bit_And_Expr =>
1517                      L := V (Node.Op1);
1518                      R := V (Node.Op2);
1519                      return UI_From_Int (Int (W (L) and W (R)));
1520
1521                   when Lt_Expr =>
1522                      return B (V (Node.Op1) < V (Node.Op2));
1523
1524                   when Le_Expr =>
1525                      return B (V (Node.Op1) <= V (Node.Op2));
1526
1527                   when Gt_Expr =>
1528                      return B (V (Node.Op1) > V (Node.Op2));
1529
1530                   when Ge_Expr =>
1531                      return B (V (Node.Op1) >= V (Node.Op2));
1532
1533                   when Eq_Expr =>
1534                      return B (V (Node.Op1) = V (Node.Op2));
1535
1536                   when Ne_Expr =>
1537                      return B (V (Node.Op1) /= V (Node.Op2));
1538
1539                   when Discrim_Val =>
1540                      declare
1541                         Sub : constant Int := UI_To_Int (Node.Op1);
1542                      begin
1543                         pragma Assert (Sub in D'Range);
1544                         return D (Sub);
1545                      end;
1546
1547                   when Dynamic_Val =>
1548                      return No_Uint;
1549                end case;
1550             end;
1551          end if;
1552       end V;
1553
1554       -------
1555       -- W --
1556       -------
1557
1558       --  We use an unchecked conversion to map Int values to their Word
1559       --  bitwise equivalent, which we could not achieve with a normal type
1560       --  conversion for negative Ints. We want bitwise equivalents because W
1561       --  is used as a helper for bit operators like Bit_And_Expr, and can be
1562       --  called for negative Ints in the context of aligning expressions like
1563       --  X+Align & -Align.
1564
1565       function W (Val : Uint) return Word is
1566          function To_Word is new Ada.Unchecked_Conversion (Int, Word);
1567       begin
1568          return To_Word (UI_To_Int (Val));
1569       end W;
1570
1571    --  Start of processing for Rep_Value
1572
1573    begin
1574       if Val = No_Uint then
1575          return No_Uint;
1576
1577       else
1578          return V (Val);
1579       end if;
1580    end Rep_Value;
1581
1582    ------------
1583    -- Spaces --
1584    ------------
1585
1586    procedure Spaces (N : Natural) is
1587    begin
1588       for J in 1 .. N loop
1589          Write_Char (' ');
1590       end loop;
1591    end Spaces;
1592
1593    ---------------
1594    -- Tree_Read --
1595    ---------------
1596
1597    procedure Tree_Read is
1598    begin
1599       Rep_Table.Tree_Read;
1600    end Tree_Read;
1601
1602    ----------------
1603    -- Tree_Write --
1604    ----------------
1605
1606    procedure Tree_Write is
1607    begin
1608       Rep_Table.Tree_Write;
1609    end Tree_Write;
1610
1611    ---------------------
1612    -- Write_Info_Line --
1613    ---------------------
1614
1615    procedure Write_Info_Line (S : String) is
1616    begin
1617       Write_Repinfo_Line_Access.all (S (S'First .. S'Last - 1));
1618    end Write_Info_Line;
1619
1620    ---------------------
1621    -- Write_Mechanism --
1622    ---------------------
1623
1624    procedure Write_Mechanism (M : Mechanism_Type) is
1625    begin
1626       case M is
1627          when 0 =>
1628             Write_Str ("default");
1629
1630          when -1 =>
1631             Write_Str ("copy");
1632
1633          when -2 =>
1634             Write_Str ("reference");
1635
1636          when others =>
1637             raise Program_Error;
1638       end case;
1639    end Write_Mechanism;
1640
1641    ---------------
1642    -- Write_Val --
1643    ---------------
1644
1645    procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False) is
1646    begin
1647       if Rep_Not_Constant (Val) then
1648          if List_Representation_Info < 3 or else Val = No_Uint then
1649             Write_Str ("??");
1650
1651          else
1652             if Paren then
1653                Write_Char ('(');
1654             end if;
1655
1656             if Back_End_Layout then
1657                List_GCC_Expression (Val);
1658             else
1659                Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
1660             end if;
1661
1662             if Paren then
1663                Write_Char (')');
1664             end if;
1665          end if;
1666
1667       else
1668          UI_Write (Val);
1669       end if;
1670    end Write_Val;
1671
1672 end Repinfo;