-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2009, 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- --
+-- ware Foundation; either version 3, 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. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- 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. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-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 Snames; use Snames;
-with Stand; use Stand;
-with Table; use Table;
-with Uname; use Uname;
-with Urealp; use Urealp;
+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 Snames; use Snames;
+with Stand; use Stand;
+with Table; use Table;
+with Uname; use Uname;
+with Urealp; use Urealp;
+
+with Ada.Unchecked_Conversion;
package body Repinfo is
-- 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.
+ -- This table is used only if Frontend_Layout_On_Target is False, so 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.
+ -- 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.
+ -- Node values are stored as Uint values using the negative of the node
+ -- index in this table. Constants appear as non-negative Uint values.
type Exp_Node is record
Expr : TCode;
Op3 : Node_Ref_Or_Val;
end record;
+ -- The following representation clause ensures that the above record
+ -- has no holes. We do this so that when instances of this record are
+ -- written by Tree_Gen, we do not write uninitialized values to the file.
+
+ for Exp_Node use record
+ Expr at 0 range 0 .. 31;
+ Op1 at 4 range 0 .. 31;
+ Op2 at 8 range 0 .. 31;
+ Op3 at 12 range 0 .. 31;
+ end record;
+
+ for Exp_Node'Size use 16 * 8;
+ -- This ensures that we did not leave out any fields
+
package Rep_Table is new Table.Table (
Table_Component_Type => Exp_Node,
Table_Index_Type => Nat,
-- Identifier casing for current unit
Need_Blank_Line : Boolean;
- -- Set True if a blank line is needed before outputting any
- -- information for the current entity. Set True when a new
- -- entity is processed, and false when the blank line is output.
+ -- Set True if a blank line is needed before outputting any information for
+ -- the current entity. Set True when a new entity is processed, and false
+ -- when the blank line is output.
-----------------------
-- Local Subprograms --
-----------------------
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)
+ -- 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 Blank_Line;
-- Called before outputting anything for an entity. Ensures that
-- a blank line precedes the output for a particular entity.
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.
+ -- 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
-- List representation info for array type Ent
procedure List_Mechanisms (Ent : Entity_Id);
- -- List mechanism information for parameters of Ent, which is a
- -- subprogram, subprogram type, or an entry or entry family.
+ -- List mechanism information for parameters of Ent, which is subprogram,
+ -- subprogram type, or an entry or entry family.
procedure List_Object_Info (Ent : Entity_Id);
-- List representation info for object Ent
-- Output given number of spaces
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.
+ -- 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_Mechanism (M : Mechanism_Type);
-- Writes symbolic string for mechanism represented by M
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.
+ -- 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.
+ -- 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;
-
+ function Create_Discrim_Ref (Discr : Entity_Id) return Node_Ref is
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);
+ return Create_Node
+ (Expr => Discrim_Val,
+ Op1 => Discriminant_Number (Discr));
end Create_Discrim_Ref;
---------------------------
-- Create_Dynamic_SO_Ref --
---------------------------
- function Create_Dynamic_SO_Ref
- (E : Entity_Id)
- return Dynamic_SO_Ref
- is
- T : Nat;
-
+ function Create_Dynamic_SO_Ref (E : Entity_Id) return Dynamic_SO_Ref is
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);
+ Dynamic_SO_Entity_Table.Append (E);
+ return UI_From_Int (-Dynamic_SO_Entity_Table.Last);
end Create_Dynamic_SO_Ref;
-----------------
(Expr : TCode;
Op1 : Node_Ref_Or_Val;
Op2 : Node_Ref_Or_Val := No_Uint;
- Op3 : Node_Ref_Or_Val := No_Uint)
- return Node_Ref
+ 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);
+ Rep_Table.Append (
+ (Expr => Expr,
+ Op1 => Op1,
+ Op2 => Op2,
+ Op3 => Op3));
+ return UI_From_Int (-Rep_Table.Last);
end Create_Node;
---------------------------
-- Get_Dynamic_SO_Entity --
---------------------------
- function Get_Dynamic_SO_Entity
- (U : Dynamic_SO_Ref)
- return Entity_Id
- is
+ 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;
procedure List_Array_Info (Ent : Entity_Id) is
begin
List_Type_Info (Ent);
-
Write_Str ("for ");
List_Name (Ent);
Write_Str ("'Component_Size use ");
function Find_Declaration (E : Entity_Id) return Node_Id is
Decl : Node_Id;
+
begin
Decl := Parent (E);
-
while Present (Decl)
and then Nkind (Decl) /= N_Package_Body
and then Nkind (Decl) /= N_Subprogram_Declaration
-- Start of processing for List_Entities
begin
- if Present (Ent) then
+ -- List entity if we have one, and it is not a renaming declaration.
+ -- For renamings, we don't get proper information, and really it makes
+ -- sense to restrict the output to the renamed entity.
+ if Present (Ent)
+ and then Nkind (Declaration_Node (Ent)) not in N_Renaming_Declaration
+ then
-- If entity is a subprogram and we are listing mechanisms,
-- then we need to list mechanisms for this entity.
while Present (E) loop
Need_Blank_Line := True;
- -- We list entities that come from source (excluding private
- -- or incomplete types or deferred constants, where we will
- -- list the info for the full view). If debug flag A is set,
- -- then all entities are listed
+ -- We list entities that come from source (excluding private or
+ -- incomplete types or deferred constants, where we will list the
+ -- info for the full view). If debug flag A is set, then all
+ -- entities are listed
if (Comes_From_Source (E)
and then not Is_Incomplete_Or_Private_Type (E)
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).
+ -- 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
E := Next_Entity (E);
end loop;
- -- For a package body, the entities of the visible subprograms
- -- are declared in the corresponding spec. Iterate over its
- -- entities in order to handle properly the subprogram bodies.
- -- Skip bodies in subunits, which are listed independently.
+ -- For a package body, the entities of the visible subprograms are
+ -- declared in the corresponding spec. Iterate over its entities in
+ -- order to handle properly the subprogram bodies. Skip bodies in
+ -- subunits, which are listed independently.
if Ekind (Ent) = E_Package_Body
and then Present (Corresponding_Spec (Find_Declaration (Ent)))
Write_Str ("not ");
Print_Expr (Node.Op1);
+ when Bit_And_Expr =>
+ Binop (" & ");
+
when Lt_Expr =>
Binop (" < ");
when Convention_Protected => Write_Line ("Protected");
when Convention_Assembler => Write_Line ("Assembler");
when Convention_C => Write_Line ("C");
+ when Convention_CIL => Write_Line ("CIL");
when Convention_COBOL => Write_Line ("COBOL");
when Convention_CPP => Write_Line ("C++");
when Convention_Fortran => Write_Line ("Fortran");
-- length, for the purpose of lining things up nicely.
Max_Name_Length := 0;
- Max_Suni_Length := 0;
+ Max_Suni_Length := 0;
- Comp := First_Entity (Ent);
+ Comp := First_Component_Or_Discriminant (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);
+ Get_Decoded_Name_String (Chars (Comp));
+ Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
- Cfbit := Component_Bit_Offset (Comp);
+ Cfbit := Component_Bit_Offset (Comp);
- if Rep_Not_Constant (Cfbit) then
- UI_Image_Length := 2;
-
- else
- -- Complete annotation in case not done
+ if Rep_Not_Constant (Cfbit) then
+ UI_Image_Length := 2;
- Set_Normalized_Position (Comp, Cfbit / SSU);
- Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
+ else
+ -- Complete annotation in case not done
- Sunit := Cfbit / SSU;
- UI_Image (Sunit);
- end if;
+ Set_Normalized_Position (Comp, Cfbit / SSU);
+ Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
- -- 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
+ Sunit := Cfbit / SSU;
+ UI_Image (Sunit);
+ end if;
- if Unknown_Normalized_First_Bit (Comp)
- and then not Is_Packed (Ent)
- then
- Set_Normalized_First_Bit (Comp, Uint_0);
- 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.
- Max_Suni_Length :=
- Natural'Max (Max_Suni_Length, UI_Image_Length);
+ if Unknown_Normalized_First_Bit (Comp)
+ and then not Is_Packed (Ent)
+ then
+ Set_Normalized_First_Bit (Comp, Uint_0);
end if;
- Comp := Next_Entity (Comp);
+ Max_Suni_Length :=
+ Natural'Max (Max_Suni_Length, UI_Image_Length);
+
+ Next_Component_Or_Discriminant (Comp);
end loop;
-- Second loop does actual output based on those values
- Comp := First_Entity (Ent);
+ Comp := First_Component_Or_Discriminant (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;
+ 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));
- 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;
- for J in 1 .. Max_Name_Length - Name_Len loop
- Write_Char (' ');
- end loop;
+ Write_Str (" at ");
- 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));
- 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);
- 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;
+ 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;
- elsif Known_Normalized_Position (Comp)
- and then List_Representation_Info = 3
- then
- Spaces (Max_Suni_Length - 2);
- Write_Val (Npos);
+ -- Otherwise we can continue
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;
+ Write_Str ("??");
end if;
+ end if;
- Write_Str (" range ");
- UI_Write (Fbit);
- Write_Str (" .. ");
+ 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).
+ -- 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 (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;
+ if Lbit < 10 then
+ Write_Char (' ');
+ end if;
- UI_Write (Lbit);
+ 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???
+ -- 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 ("??");
+ 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)
+ -- List_Representation >= 3 and Known_Esize (Comp)
- Write_Val (Esiz, Paren => True);
+ else
+ Write_Val (Esiz, Paren => True);
- -- If in front end layout mode, then dynamic size is
- -- stored in storage units, so renormalize for output
+ -- 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;
+ if not Back_End_Layout then
+ Write_Str (" * ");
+ Write_Int (SSU);
+ end if;
- -- Add appropriate first bit offset
+ -- Add appropriate first bit offset
- if Fbit = 0 then
- Write_Str (" - 1");
+ if Fbit = 0 then
+ Write_Str (" - 1");
- elsif Fbit = 1 then
- null;
+ elsif Fbit = 1 then
+ null;
- else
- Write_Str (" + ");
- Write_Int (UI_To_Int (Fbit) - 1);
- end if;
+ else
+ Write_Str (" + ");
+ Write_Int (UI_To_Int (Fbit) - 1);
end if;
+ end if;
- Write_Line (";");
- end;
- end if;
+ Write_Line (";");
+ end;
<<Continue>>
- Comp := Next_Entity (Comp);
+ Next_Component_Or_Discriminant (Comp);
end loop;
Write_Line ("end record;");
Col : Nat;
begin
- if Debug_Flag_AA then
- List_Representation_Info := 3;
- List_Representation_Info_Mechanisms := True;
- end if;
-
if List_Representation_Info /= 0
or else List_Representation_Info_Mechanisms
then
-- List representation information to file
else
- Creat_Repinfo_File_Access.all (File_Name (Source_Index (U)));
+ Create_Repinfo_File_Access.all
+ (Get_Name_String (File_Name (Source_Index (U))));
Set_Special_Output (Write_Info_Line'Access);
List_Entities (Cunit_Entity (U));
Set_Special_Output (null);
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???
+ -- 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 ");
---------------
function Rep_Value
- (Val : Node_Ref_Or_Val;
- D : Discrim_List)
- return Uint
+ (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 V (Val : Node_Ref_Or_Val) return Uint;
-- Internal recursive routine to evaluate tree
+ function W (Val : Uint) return Word;
+ -- Convert Val to Word, assuming Val is always in the Int range. This is
+ -- a helper function for the evaluation of bitwise expressions like
+ -- Bit_And_Expr, for which there is no direct support in uintp. Uint
+ -- values out of the Int range are expected to be seen in such
+ -- expressions only with overflowing byte sizes around, introducing
+ -- inherent unreliabilities in computations anyway.
+
-------
-- B --
-------
return B (T (Node.Op1) or else T (Node.Op2));
when Truth_And_Expr =>
- return B (T (Node.Op1) and T (Node.Op2));
+ return B (T (Node.Op1) and then T (Node.Op2));
when Truth_Or_Expr =>
- return B (T (Node.Op1) or T (Node.Op2));
+ return B (T (Node.Op1) or else 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 Bit_And_Expr =>
+ L := V (Node.Op1);
+ R := V (Node.Op2);
+ return UI_From_Int (Int (W (L) and W (R)));
+
when Lt_Expr =>
return B (V (Node.Op1) < V (Node.Op2));
end if;
end V;
+ -------
+ -- W --
+ -------
+
+ -- We use an unchecked conversion to map Int values to their Word
+ -- bitwise equivalent, which we could not achieve with a normal type
+ -- conversion for negative Ints. We want bitwise equivalents because W
+ -- is used as a helper for bit operators like Bit_And_Expr, and can be
+ -- called for negative Ints in the context of aligning expressions like
+ -- X+Align & -Align.
+
+ function W (Val : Uint) return Word is
+ function To_Word is new Ada.Unchecked_Conversion (Int, Word);
+ begin
+ return To_Word (UI_To_Int (Val));
+ end W;
+
-- Start of processing for Rep_Value
begin
OSDN Git Service
