path: root/gcc/ada/repinfo.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              R E P I N F O                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision$
--                                                                          --
--          Copyright (C) 1999-2002 Free Software Foundation, Inc.          --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

with Alloc;    use Alloc;
with Atree;    use Atree;
with Casing;   use Casing;
with Debug;    use Debug;
with Einfo;    use Einfo;
with Lib;      use Lib;
with Namet;    use Namet;
with Opt;      use Opt;
with Output;   use Output;
with Sinfo;    use Sinfo;
with Sinput;   use Sinput;
with Table;    use Table;
with Uname;    use Uname;
with Urealp;   use Urealp;

package body Repinfo is

   SSU : constant := 8;
   --  Value for Storage_Unit, we do not want to get this from TTypes, since
   --  this introduces problematic dependencies in ASIS, and in any case this
   --  value is assumed to be 8 for the implementation of the DDA.
   --  This is wrong for AAMP???

   ---------------------------------------
   -- Representation of gcc Expressions --
   ---------------------------------------

   --    This table is used only if Frontend_Layout_On_Target is False,
   --    so that gigi lays out dynamic size/offset fields using encoded
   --    gcc expressions.

   --    A table internal to this unit is used to hold the values of
   --    back annotated expressions. This table is written out by -gnatt
   --    and read back in for ASIS processing.

   --    Node values are stored as Uint values which are the negative of
   --    the node index in this table. Constants appear as non-negative
   --    Uint values.

   type Exp_Node is record
      Expr : TCode;
      Op1  : Node_Ref_Or_Val;
      Op2  : Node_Ref_Or_Val;
      Op3  : Node_Ref_Or_Val;
   end record;

   package Rep_Table is new Table.Table (
      Table_Component_Type => Exp_Node,
      Table_Index_Type     => Nat,
      Table_Low_Bound      => 1,
      Table_Initial        => Alloc.Rep_Table_Initial,
      Table_Increment      => Alloc.Rep_Table_Increment,
      Table_Name           => "BE_Rep_Table");

   --------------------------------------------------------------
   -- Representation of Front-End Dynamic Size/Offset Entities --
   --------------------------------------------------------------

   package Dynamic_SO_Entity_Table is new Table.Table (
      Table_Component_Type => Entity_Id,
      Table_Index_Type     => Nat,
      Table_Low_Bound      => 1,
      Table_Initial        => Alloc.Rep_Table_Initial,
      Table_Increment      => Alloc.Rep_Table_Increment,
      Table_Name           => "FE_Rep_Table");

   -----------------------
   -- Local Subprograms --
   -----------------------

   Unit_Casing : Casing_Type;
   --  Identifier casing for current unit

   procedure Spaces (N : Natural);
   --  Output given number of spaces

   function Back_End_Layout return Boolean;
   --  Test for layout mode, True = back end, False = front end. This
   --  function is used rather than checking the configuration parameter
   --  because we do not want Repinfo to depend on Targparm (for ASIS)

   procedure List_Entities (Ent : Entity_Id);
   --  This procedure lists the entities associated with the entity E,
   --  starting with the First_Entity and using the Next_Entity link.
   --  If a nested package is found, entities within the package are
   --  recursively processed.

   procedure List_Name (Ent : Entity_Id);
   --  List name of entity Ent in appropriate case. The name is listed with
   --  full qualification up to but not including the compilation unit name.

   procedure List_Array_Info (Ent : Entity_Id);
   --  List representation info for array type Ent

   procedure List_Object_Info (Ent : Entity_Id);
   --  List representation info for object Ent

   procedure List_Record_Info (Ent : Entity_Id);
   --  List representation info for record type Ent

   procedure List_Type_Info (Ent : Entity_Id);
   --  List type info for type Ent

   function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean;
   --  Returns True if Val represents a variable value, and False if it
   --  represents a value that is fixed at compile time.

   procedure Write_Info_Line (S : String);
   --  Routine to write a line to Repinfo output file. This routine is
   --  passed as a special output procedure to Output.Set_Special_Output.
   --  Note that Write_Info_Line is called with an EOL character at the
   --  end of each line, as per the Output spec, but the internal call
   --  to the appropriate routine in Osint requires that the end of line
   --  sequence be stripped off.

   procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False);
   --  Given a representation value, write it out. No_Uint values or values
   --  dependent on discriminants are written as two question marks. If the
   --  flag Paren is set, then the output is surrounded in parentheses if
   --  it is other than a simple value.

   ---------------------
   -- Back_End_Layout --
   ---------------------

   function Back_End_Layout return Boolean is
   begin
      --  We have back end layout if the back end has made any entries in
      --  the table of GCC expressions, otherwise we have front end layout.

      return Rep_Table.Last > 0;
   end Back_End_Layout;

   ------------------------
   -- Create_Discrim_Ref --
   ------------------------

   function Create_Discrim_Ref
     (Discr : Entity_Id)
      return  Node_Ref
   is
      N : constant Uint := Discriminant_Number (Discr);
      T : Nat;

   begin
      Rep_Table.Increment_Last;
      T := Rep_Table.Last;
      Rep_Table.Table (T).Expr := Discrim_Val;
      Rep_Table.Table (T).Op1  := N;
      Rep_Table.Table (T).Op2  := No_Uint;
      Rep_Table.Table (T).Op3  := No_Uint;
      return UI_From_Int (-T);
   end Create_Discrim_Ref;

   ---------------------------
   -- Create_Dynamic_SO_Ref --
   ---------------------------

   function Create_Dynamic_SO_Ref
     (E    : Entity_Id)
      return Dynamic_SO_Ref
   is
      T : Nat;

   begin
      Dynamic_SO_Entity_Table.Increment_Last;
      T := Dynamic_SO_Entity_Table.Last;
      Dynamic_SO_Entity_Table.Table (T) := E;
      return UI_From_Int (-T);
   end Create_Dynamic_SO_Ref;

   -----------------
   -- Create_Node --
   -----------------

   function Create_Node
     (Expr : TCode;
      Op1  : Node_Ref_Or_Val;
      Op2  : Node_Ref_Or_Val := No_Uint;
      Op3  : Node_Ref_Or_Val := No_Uint)
      return  Node_Ref
   is
      T : Nat;

   begin
      Rep_Table.Increment_Last;
      T := Rep_Table.Last;
      Rep_Table.Table (T).Expr := Expr;
      Rep_Table.Table (T).Op1  := Op1;
      Rep_Table.Table (T).Op2  := Op2;
      Rep_Table.Table (T).Op3  := Op3;

      return UI_From_Int (-T);
   end Create_Node;

   ---------------------------
   -- Get_Dynamic_SO_Entity --
   ---------------------------

   function Get_Dynamic_SO_Entity
     (U    : Dynamic_SO_Ref)
      return Entity_Id
   is
   begin
      return Dynamic_SO_Entity_Table.Table (-UI_To_Int (U));
   end Get_Dynamic_SO_Entity;

   -----------------------
   -- Is_Dynamic_SO_Ref --
   -----------------------

   function Is_Dynamic_SO_Ref (U : SO_Ref) return Boolean is
   begin
      return U < Uint_0;
   end Is_Dynamic_SO_Ref;

   ----------------------
   -- Is_Static_SO_Ref --
   ----------------------

   function Is_Static_SO_Ref (U : SO_Ref) return Boolean is
   begin
      return U >= Uint_0;
   end Is_Static_SO_Ref;

   ---------
   -- lgx --
   ---------

   procedure lgx (U : Node_Ref_Or_Val) is
   begin
      List_GCC_Expression (U);
      Write_Eol;
   end lgx;

   ----------------------
   -- List_Array_Info --
   ----------------------

   procedure List_Array_Info (Ent : Entity_Id) is
   begin
      List_Type_Info (Ent);

      Write_Str ("for ");
      List_Name (Ent);
      Write_Str ("'Component_Size use ");
      Write_Val (Component_Size (Ent));
      Write_Line (";");
   end List_Array_Info;

   -------------------
   -- List_Entities --
   -------------------

   procedure List_Entities (Ent : Entity_Id) is
      E : Entity_Id;

   begin
      if Present (Ent) then
         E := First_Entity (Ent);
         while Present (E) loop

            --  We list entities that come from source (excluding private
            --  types, where we will list the info for the full view). If
            --  debug flag A is set, all entities are listed

            if (Comes_From_Source (E) and then not Is_Private_Type (E))
              or else Debug_Flag_AA
            then
               if Is_Record_Type (E) then
                  List_Record_Info (E);

               elsif Is_Array_Type (E) then
                  List_Array_Info (E);

               elsif List_Representation_Info >= 2 then
                  if Is_Type (E) then
                     List_Type_Info (E);

                  elsif Ekind (E) = E_Variable
                          or else
                        Ekind (E) = E_Constant
                          or else
                        Ekind (E) = E_Loop_Parameter
                          or else
                        Is_Formal (E)
                  then
                     List_Object_Info (E);
                  end if;
               end if;

               --  Recurse into nested package, but not if they are
               --  package renamings (in particular renamings of the
               --  enclosing package, as for some Java bindings and
               --  for generic instances).

               if Ekind (E) = E_Package then
                  if No (Renamed_Object (E)) then
                     List_Entities (E);
                  end if;

               --  Recurse into bodies

               elsif Ekind (E) = E_Protected_Type
                       or else
                     Ekind (E) = E_Task_Type
                       or else
                     Ekind (E) = E_Subprogram_Body
                       or else
                     Ekind (E) = E_Package_Body
                       or else
                     Ekind (E) = E_Task_Body
                       or else
                     Ekind (E) = E_Protected_Body
               then
                  List_Entities (E);

               --  Recurse into blocks

               elsif Ekind (E) = E_Block then
                  List_Entities (E);
               end if;
            end if;

            E := Next_Entity (E);
         end loop;
      end if;
   end List_Entities;

   -------------------------
   -- List_GCC_Expression --
   -------------------------

   procedure List_GCC_Expression (U : Node_Ref_Or_Val) is

      procedure P (Val : Node_Ref_Or_Val);
      --  Internal recursive procedure to print expression

      procedure P (Val : Node_Ref_Or_Val) is
      begin
         if Val >= 0 then
            UI_Write (Val, Decimal);

         else
            declare
               Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));

               procedure Binop (S : String);
               --  Output text for binary operator with S being operator name

               procedure Binop (S : String) is
               begin
                  Write_Char ('(');
                  P (Node.Op1);
                  Write_Str (S);
                  P (Node.Op2);
                  Write_Char (')');
               end Binop;

            --  Start of processing for P

            begin
               case Node.Expr is
                  when Cond_Expr =>
                     Write_Str ("(if ");
                     P (Node.Op1);
                     Write_Str (" then ");
                     P (Node.Op2);
                     Write_Str (" else ");
                     P (Node.Op3);
                     Write_Str (" end)");

                  when Plus_Expr =>
                     Binop (" + ");

                  when Minus_Expr =>
                     Binop (" - ");

                  when Mult_Expr =>
                     Binop (" * ");

                  when Trunc_Div_Expr =>
                     Binop (" /t ");

                  when Ceil_Div_Expr =>
                     Binop (" /c ");

                  when Floor_Div_Expr =>
                     Binop (" /f ");

                  when Trunc_Mod_Expr =>
                     Binop (" modt ");

                  when Floor_Mod_Expr =>
                     Binop (" modf ");

                  when Ceil_Mod_Expr =>
                     Binop (" modc ");

                  when Exact_Div_Expr =>
                     Binop (" /e ");

                  when Negate_Expr =>
                     Write_Char ('-');
                     P (Node.Op1);

                  when Min_Expr =>
                     Binop (" min ");

                  when Max_Expr =>
                     Binop (" max ");

                  when Abs_Expr =>
                     Write_Str ("abs ");
                     P (Node.Op1);

                  when Truth_Andif_Expr =>
                     Binop (" and if ");

                  when Truth_Orif_Expr =>
                     Binop (" or if ");

                  when Truth_And_Expr =>
                     Binop (" and ");

                  when Truth_Or_Expr =>
                     Binop (" or ");

                  when Truth_Xor_Expr =>
                     Binop (" xor ");

                  when Truth_Not_Expr =>
                     Write_Str ("not ");
                     P (Node.Op1);

                  when Lt_Expr =>
                     Binop (" < ");

                  when Le_Expr =>
                     Binop (" <= ");

                  when Gt_Expr =>
                     Binop (" > ");

                  when Ge_Expr =>
                     Binop (" >= ");

                  when Eq_Expr =>
                     Binop (" == ");

                  when Ne_Expr =>
                     Binop (" != ");

                  when Discrim_Val =>
                     Write_Char ('#');
                     UI_Write (Node.Op1);

               end case;
            end;
         end if;
      end P;

   --  Start of processing for List_GCC_Expression

   begin
      if U = No_Uint then
         Write_Str ("??");
      else
         P (U);
      end if;
   end List_GCC_Expression;

   ---------------
   -- List_Name --
   ---------------

   procedure List_Name (Ent : Entity_Id) is
   begin
      if not Is_Compilation_Unit (Scope (Ent)) then
         List_Name (Scope (Ent));
         Write_Char ('.');
      end if;

      Get_Unqualified_Decoded_Name_String (Chars (Ent));
      Set_Casing (Unit_Casing);
      Write_Str (Name_Buffer (1 .. Name_Len));
   end List_Name;

   ---------------------
   -- List_Object_Info --
   ---------------------

   procedure List_Object_Info (Ent : Entity_Id) is
   begin
      Write_Eol;

      Write_Str ("for ");
      List_Name (Ent);
      Write_Str ("'Size use ");
      Write_Val (Esize (Ent));
      Write_Line (";");

      Write_Str ("for ");
      List_Name (Ent);
      Write_Str ("'Alignment use ");
      Write_Val (Alignment (Ent));
      Write_Line (";");
   end List_Object_Info;

   ----------------------
   -- List_Record_Info --
   ----------------------

   procedure List_Record_Info (Ent : Entity_Id) is
      Comp  : Entity_Id;
      Esiz  : Uint;
      Cfbit : Uint;
      Sunit : Uint;

      Max_Name_Length : Natural;
      Max_Suni_Length : Natural;

   begin
      List_Type_Info (Ent);

      Write_Str ("for ");
      List_Name (Ent);
      Write_Line (" use record");

      --  First loop finds out max line length and max starting position
      --  length, for the purpose of lining things up nicely.

      Max_Name_Length := 0;
      Max_Suni_Length   := 0;

      Comp := First_Entity (Ent);
      while Present (Comp) loop
         if Ekind (Comp) = E_Component
           or else Ekind (Comp) = E_Discriminant
         then
            Get_Decoded_Name_String (Chars (Comp));
            Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);

            Cfbit := Component_Bit_Offset (Comp);

            if Rep_Not_Constant (Cfbit) then
               UI_Image_Length := 2;

            else
               --  Complete annotation in case not done

               Set_Normalized_Position (Comp, Cfbit / SSU);
               Set_Normalized_First_Bit (Comp, Cfbit mod SSU);

               Esiz  := Esize (Comp);
               Sunit := Cfbit / SSU;
               UI_Image (Sunit);
            end if;

            --  If the record is not packed, then we know that all
            --  fields whose position is not specified have a starting
            --  normalized bit position of zero

            if Unknown_Normalized_First_Bit (Comp)
              and then not Is_Packed (Ent)
            then
               Set_Normalized_First_Bit (Comp, Uint_0);
            end if;

            Max_Suni_Length :=
              Natural'Max (Max_Suni_Length, UI_Image_Length);
         end if;

         Comp := Next_Entity (Comp);
      end loop;

      --  Second loop does actual output based on those values

      Comp := First_Entity (Ent);
      while Present (Comp) loop
         if Ekind (Comp) = E_Component
           or else Ekind (Comp) = E_Discriminant
         then
            declare
               Esiz : constant Uint := Esize (Comp);
               Bofs : constant Uint := Component_Bit_Offset (Comp);
               Npos : constant Uint := Normalized_Position (Comp);
               Fbit : constant Uint := Normalized_First_Bit (Comp);
               Lbit : Uint;

            begin
               Write_Str ("   ");
               Get_Decoded_Name_String (Chars (Comp));
               Set_Casing (Unit_Casing);
               Write_Str (Name_Buffer (1 .. Name_Len));

               for J in 1 .. Max_Name_Length - Name_Len loop
                  Write_Char (' ');
               end loop;

               Write_Str (" at ");

               if Known_Static_Normalized_Position (Comp) then
                  UI_Image (Npos);
                  Spaces (Max_Suni_Length - UI_Image_Length);
                  Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));

               elsif Known_Component_Bit_Offset (Comp)
                 and then List_Representation_Info = 3
               then
                  Spaces (Max_Suni_Length - 2);
                  Write_Str ("bit offset");
                  Write_Val (Bofs, Paren => True);
                  Write_Str (" size in bits = ");
                  Write_Val (Esiz, Paren => True);
                  Write_Eol;
                  goto Continue;

               elsif Known_Normalized_Position (Comp)
                 and then List_Representation_Info = 3
               then
                  Spaces (Max_Suni_Length - 2);
                  Write_Val (Npos);

               else
                  --  For the packed case, we don't know the bit positions
                  --  if we don't know the starting position!

                  if Is_Packed (Ent) then
                     Write_Line ("?? range  ? .. ??;");
                     goto Continue;

                  --  Otherwise we can continue

                  else
                     Write_Str ("??");
                  end if;
               end if;

               Write_Str (" range  ");
               UI_Write (Fbit);
               Write_Str (" .. ");

               --  Allowing Uint_0 here is a kludge, really this should be
               --  a fine Esize value but currently it means unknown, except
               --  that we know after gigi has back annotated that a size of
               --  zero is real, since otherwise gigi back annotates using
               --  No_Uint as the value to indicate unknown).

               if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
                 and then Known_Static_Normalized_First_Bit (Comp)
               then
                  Lbit := Fbit + Esiz - 1;

                  if Lbit < 10 then
                     Write_Char (' ');
                  end if;

                  UI_Write (Lbit);

               --  The test for Esize (Comp) not being Uint_0 here is a kludge.
               --  Officially a value of zero for Esize means unknown, but here
               --  we use the fact that we know that gigi annotates Esize with
               --  No_Uint, not Uint_0. Really everyone should use No_Uint???

               elsif List_Representation_Info < 3
                 or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
               then
                  Write_Str ("??");

               else -- List_Representation >= 3 and Known_Esize (Comp)

                  Write_Val (Esiz, Paren => True);

                  --  If in front end layout mode, then dynamic size is
                  --  stored in storage units, so renormalize for output

                  if not Back_End_Layout then
                     Write_Str (" * ");
                     Write_Int (SSU);
                  end if;

                  --  Add appropriate first bit offset

                  if Fbit = 0 then
                     Write_Str (" - 1");

                  elsif Fbit = 1 then
                     null;

                  else
                     Write_Str (" + ");
                     Write_Int (UI_To_Int (Fbit) - 1);
                  end if;
               end if;

               Write_Line (";");
            end;
         end if;

      <<Continue>>
         Comp := Next_Entity (Comp);
      end loop;

      Write_Line ("end record;");
   end List_Record_Info;

   -------------------
   -- List_Rep_Info --
   -------------------

   procedure List_Rep_Info is
      Col : Nat;

   begin
      for U in Main_Unit .. Last_Unit loop
         if In_Extended_Main_Source_Unit (Cunit_Entity (U)) then

            --  Normal case, list to standard output

            if not List_Representation_Info_To_File then
               Unit_Casing := Identifier_Casing (Source_Index (U));
               Write_Eol;
               Write_Str ("Representation information for unit ");
               Write_Unit_Name (Unit_Name (U));
               Col := Column;
               Write_Eol;

               for J in 1 .. Col - 1 loop
                  Write_Char ('-');
               end loop;

               Write_Eol;
               List_Entities (Cunit_Entity (U));

            --  List representation information to file

            else
               Creat_Repinfo_File_Access.all (File_Name (Source_Index (U)));
               Set_Special_Output (Write_Info_Line'Access);
               List_Entities (Cunit_Entity (U));
               Set_Special_Output (null);
               Close_Repinfo_File_Access.all;
            end if;
         end if;
      end loop;
   end List_Rep_Info;

   ---------------------
   -- Write_Info_Line --
   ---------------------

   procedure Write_Info_Line (S : String) is
   begin
      Write_Repinfo_Line_Access.all (S (S'First .. S'Last - 1));
   end Write_Info_Line;

   --------------------
   -- List_Type_Info --
   --------------------

   procedure List_Type_Info (Ent : Entity_Id) is
   begin
      Write_Eol;

      --  Do not list size info for unconstrained arrays, not meaningful

      if Is_Array_Type (Ent) and then not Is_Constrained (Ent) then
         null;

      else
         --  If Esize and RM_Size are the same and known, list as Size. This
         --  is a common case, which we may as well list in simple form.

         if Esize (Ent) = RM_Size (Ent) then
            Write_Str ("for ");
            List_Name (Ent);
            Write_Str ("'Size use ");
            Write_Val (Esize (Ent));
            Write_Line (";");

         --  For now, temporary case, to be removed when gigi properly back
         --  annotates RM_Size, if RM_Size is not set, then list Esize as
         --  Size. This avoids odd Object_Size output till we fix things???

         elsif Unknown_RM_Size (Ent) then
            Write_Str ("for ");
            List_Name (Ent);
            Write_Str ("'Size use ");
            Write_Val (Esize (Ent));
            Write_Line (";");

         --  Otherwise list size values separately if they are set

         else
            Write_Str ("for ");
            List_Name (Ent);
            Write_Str ("'Object_Size use ");
            Write_Val (Esize (Ent));
            Write_Line (";");

            --  Note on following check: The RM_Size of a discrete type can
            --  legitimately be set to zero, so a special check is needed.

            Write_Str ("for ");
            List_Name (Ent);
            Write_Str ("'Value_Size use ");
            Write_Val (RM_Size (Ent));
            Write_Line (";");
         end if;
      end if;

      Write_Str ("for ");
      List_Name (Ent);
      Write_Str ("'Alignment use ");
      Write_Val (Alignment (Ent));
      Write_Line (";");
   end List_Type_Info;

   ----------------------
   -- Rep_Not_Constant --
   ----------------------

   function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean is
   begin
      if Val = No_Uint or else Val < 0 then
         return True;
      else
         return False;
      end if;
   end Rep_Not_Constant;

   ---------------
   -- Rep_Value --
   ---------------

   function Rep_Value
     (Val  : Node_Ref_Or_Val;
      D    : Discrim_List)
      return Uint
   is
      function B (Val : Boolean) return Uint;
      --  Returns Uint_0 for False, Uint_1 for True

      function T (Val : Node_Ref_Or_Val) return Boolean;
      --  Returns True for 0, False for any non-zero (i.e. True)

      function V (Val : Node_Ref_Or_Val) return Uint;
      --  Internal recursive routine to evaluate tree

      -------
      -- B --
      -------

      function B (Val : Boolean) return Uint is
      begin
         if Val then
            return Uint_1;
         else
            return Uint_0;
         end if;
      end B;

      -------
      -- T --
      -------

      function T (Val : Node_Ref_Or_Val) return Boolean is
      begin
         if V (Val) = 0 then
            return False;
         else
            return True;
         end if;
      end T;

      -------
      -- V --
      -------

      function V (Val : Node_Ref_Or_Val) return Uint is
         L, R, Q : Uint;

      begin
         if Val >= 0 then
            return Val;

         else
            declare
               Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));

            begin
               case Node.Expr is
                  when Cond_Expr =>
                     if T (Node.Op1) then
                        return V (Node.Op2);
                     else
                        return V (Node.Op3);
                     end if;

                  when Plus_Expr =>
                     return V (Node.Op1) + V (Node.Op2);

                  when Minus_Expr =>
                     return V (Node.Op1) - V (Node.Op2);

                  when Mult_Expr =>
                     return V (Node.Op1) * V (Node.Op2);

                  when Trunc_Div_Expr =>
                     return V (Node.Op1) / V (Node.Op2);

                  when Ceil_Div_Expr =>
                     return
                       UR_Ceiling
                         (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));

                  when Floor_Div_Expr =>
                     return
                       UR_Floor
                         (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));

                  when Trunc_Mod_Expr =>
                     return V (Node.Op1) rem V (Node.Op2);

                  when Floor_Mod_Expr =>
                     return V (Node.Op1) mod V (Node.Op2);

                  when Ceil_Mod_Expr =>
                     L := V (Node.Op1);
                     R := V (Node.Op2);
                     Q := UR_Ceiling (L / UR_From_Uint (R));
                     return L - R * Q;

                  when Exact_Div_Expr =>
                     return V (Node.Op1) / V (Node.Op2);

                  when Negate_Expr =>
                     return -V (Node.Op1);

                  when Min_Expr =>
                     return UI_Min (V (Node.Op1), V (Node.Op2));

                  when Max_Expr =>
                     return UI_Max (V (Node.Op1), V (Node.Op2));

                  when Abs_Expr =>
                     return UI_Abs (V (Node.Op1));

                  when Truth_Andif_Expr =>
                     return B (T (Node.Op1) and then T (Node.Op2));

                  when Truth_Orif_Expr =>
                     return B (T (Node.Op1) or else T (Node.Op2));

                  when Truth_And_Expr =>
                     return B (T (Node.Op1) and T (Node.Op2));

                  when Truth_Or_Expr =>
                     return B (T (Node.Op1) or T (Node.Op2));

                  when Truth_Xor_Expr =>
                     return B (T (Node.Op1) xor T (Node.Op2));

                  when Truth_Not_Expr =>
                     return B (not T (Node.Op1));

                  when Lt_Expr =>
                     return B (V (Node.Op1) < V (Node.Op2));

                  when Le_Expr =>
                     return B (V (Node.Op1) <= V (Node.Op2));

                  when Gt_Expr =>
                     return B (V (Node.Op1) > V (Node.Op2));

                  when Ge_Expr =>
                     return B (V (Node.Op1) >= V (Node.Op2));

                  when Eq_Expr =>
                     return B (V (Node.Op1) = V (Node.Op2));

                  when Ne_Expr =>
                     return B (V (Node.Op1) /= V (Node.Op2));

                  when Discrim_Val =>
                     declare
                        Sub : constant Int := UI_To_Int (Node.Op1);

                     begin
                        pragma Assert (Sub in D'Range);
                        return D (Sub);
                     end;

               end case;
            end;
         end if;
      end V;

   --  Start of processing for Rep_Value

   begin
      if Val = No_Uint then
         return No_Uint;

      else
         return V (Val);
      end if;
   end Rep_Value;

   ------------
   -- Spaces --
   ------------

   procedure Spaces (N : Natural) is
   begin
      for J in 1 .. N loop
         Write_Char (' ');
      end loop;
   end Spaces;

   ---------------
   -- Tree_Read --
   ---------------

   procedure Tree_Read is
   begin
      Rep_Table.Tree_Read;
   end Tree_Read;

   ----------------
   -- Tree_Write --
   ----------------

   procedure Tree_Write is
   begin
      Rep_Table.Tree_Write;
   end Tree_Write;

   ---------------
   -- Write_Val --
   ---------------

   procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False) is
   begin
      if Rep_Not_Constant (Val) then
         if List_Representation_Info < 3 or else Val = No_Uint then
            Write_Str ("??");

         else
            if Back_End_Layout then
               Write_Char (' ');

               if Paren then
                  Write_Char ('(');
                  List_GCC_Expression (Val);
                  Write_Char (')');
               else
                  List_GCC_Expression (Val);
               end if;

               Write_Char (' ');

            else
               if Paren then
                  Write_Char ('(');
                  Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
                  Write_Char (')');
               else
                  Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
               end if;
            end if;
         end if;

      else
         UI_Write (Val);
      end if;
   end Write_Val;

end Repinfo;