2005-11-14 Thomas Quinot <quinot@adacore.com>

	    Olivier Hainque  <hainque@adacore.com>
	    Eric Botcazou  <ebotcazou@adacore.com>

	* decl.c:
	Factor common code to build a storage type for an unconstrained object
	from a fat or thin pointer type and a constrained object type.
	(annotate_value): Handle BIT_AND_EXPR.
	(annotate_rep): Don't restrict the back annotation of inherited
	components to the type_annotate_only case.
	(gnat_to_gnu_entity) <E_Array_Type>: Do not invoke create_type_decl if
	we are not defining the type.
	<E_Record_Type>: Likewise.
	(gnat_to_gnu_entity) <object, renaming>: Adjust comments and structure
	to get advantage of the new maybe_stabilize_reference interface, to
	ensure that what we reference is indeed stabilized instead of relying
	on assumptions on what the stabilizer does.
	(gnat_to_gnu_entity) <E_Incomplete_Type>: If the entity is an incomplete
	type imported through a limited_with clause, use its non-limited view.
	(Has_Stdcall_Convention): New macro, to centralize the Windows vs others
	differentiation.
	(gnat_to_gnu_entity): Use Has_Stdcall_Convention instead of a spread mix
	of #if sections + explicit comparisons of convention identifiers.
	(gnat_to_gnu_entity) <E_Variable>: Decrement force_global if necessary
	before early-returning for certain types when code generation is
	disabled.
	(gnat_to_gnu_entity) <object>: Adjust comment attached to the
	nullification of gnu_expr we do for objects with address clause and
	that we are not defining.
	(elaborate_expression_1): Do not create constants when creating
	variables needed by the debug info: the dwarf2 writer considers that
	CONST_DECLs is used only to represent enumeration constants, and emits
	nothing for them.
	(gnat_to_gnu_entity) <object>: When turning a non-definition of an
	object with an address clause into an indirect reference, drop the
	initializing expression.
	Include "expr.h".
	(STACK_CHECK_BUILTIN): Delete.
	(STACK_CHECK_PROBE_INTERVAL): Likewise.
	(STACK_CHECK_MAX_FRAME_SIZE): Likewise.
	(STACK_CHECK_MAX_VAR_SIZE): Likewise.
	(gnat_to_gnu_entity): If gnat_entity is a renaming, do not mark the tree
	corresponding to the renamed object as ignored for debugging purposes.

	* trans.c (tree_transform, case N_Attribute_Reference, case Attr_Size &
	related): For a prefix that is a dereference of a fat or thin pointer,
	if there is an actual subtype provided by the front-end, use that
	subtype to build an actual type with bounds template.
	(tree_transform, case N_Free_Statement): If an Actual_Designated_Subtype
	is provided by the front-end, use that subtype to compute the size of
	the deallocated object.
	(gnat_to_gnu): When adding a statement into an elaboration procedure,
	check for a potential violation of a No_Elaboration_Code restriction.
	(maybe_stabilize_reference): New function, like gnat_stabilize_reference
	with extra arguments to control whether to recurse through non-values
	and to let the caller know if the stabilization has succeeded.
	(gnat_stabilize_reference): Now a simple wrapper around
	maybe_stabilize, for common uses without restriction on lvalues and
	without need to check for the success indication.
	(gnat_to_gnu, call_to_gnu): Adjust calls to gnat_stabilize_reference, to
	pass false instead of 0 as the FORCE argument which is a bool.
	(Identifier_to_gnu): Remove checks ensuring that an renamed object
	attached to a renaming pointer has been properly stabilized, as no such
	object is attached otherwise.
	(call_to_gnu): Invoke create_var_decl to create the temporary when the
	function uses the "target pointer" return mechanism.
	Reinstate conversion of the actual to the type of the formal
	parameter before any other specific treatment based on the passing
	mechanism. This turns out to be necessary in order for PLACEHOLDER
	substitution to work properly when the latter type is unconstrained.

	* gigi.h (build_unc_object_type_from_ptr): New subprogram, factoring a
	common pattern.
	(maybe_stabilize_reference): New function, like gnat_stabilize_reference
	with extra arguments to control whether to recurse through non-values
	and to let the caller know if the stabilization has succeeded.

	* utils2.c (gnat_build_constructor): Only sort the fields for possible
	static output of record constructor if all the components are constant.
	(gnat_build_constructor): For a record type, sort the list of field
	initializers in increasing bit position order.
	Factor common code to build a storage type for an unconstrained object
	from a fat or thin pointer type and a constrained object type.
	(build_unary_op) <ADDR_EXPR>: Always recurse down conversions between
	types variants, and process special cases of VIEW_CONVERT expressions
	as their NOP_EXPR counterpart to ensure we get to the
	CORRESPONDING_VARs associated with CONST_DECls.
	(build_binary_op) <MODIFY_EXPR>: Do not strip VIEW_CONVERT_EXPRs
	on the right-hand side.

	* utils.c (build_unc_object_type_from_ptr): New subprogram, factoring
	a common pattern.
	(convert) <VIEW_CONVERT_EXPR>: Return the inner operand directly if we
	are converting back to its original type.
	(convert) <JM input>: Fallthrough regular conversion code instead of
	extracting the object if converting to a type variant.
	(create_var_decl): When a variable has an initializer requiring code
	generation and we are at the top level, check for a potential violation
	of a No_Elaboration_Code restriction.
	(create_var_decl): call expand_decl for CONST_DECLs, to set MODE, ALIGN
	SIZE and SIZE_UNIT which we need for later back-annotations.
	* utils.c: (convert) <STRING_CST>: Remove obsolete code.
	<VIEW_CONVERT_EXPR>: Do not lift the conversion if the target type
	is an unchecked union.
	(pushdecl): Set DECL_NO_STATIC_CHAIN on imported nested functions.
	(convert) <VIEW_CONVERT_EXPR>: When the types have the same
	main variant, just replace the VIEW_CONVERT_EXPR.
	<UNION_TYPE>: Revert 2005-03-02 change.

	* repinfo.h, repinfo.ads: Add tcode for BIT_AND_EXPR.

	* repinfo.adb (Print_Expr, Rep_Value): Handle Bit_And_Expressions.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@106961 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 87 insertions, 56 deletions

diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index a3e9e8ac350..ba1646bfad9 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1999-2005 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- --
@@ -48,6 +48,8 @@ with Table;  use Table;
 with Uname;  use Uname;
 with Urealp; use Urealp;
 
+with Ada.Unchecked_Conversion;
+
 package body Repinfo is
 
    SSU : constant := 8;
@@ -61,17 +63,16 @@ 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 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.
+   --    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;
@@ -104,28 +105,27 @@ package body Repinfo is
    --  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
@@ -135,8 +135,8 @@ package body Repinfo is
    --  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
@@ -155,12 +155,11 @@ package body Repinfo is
    --  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
@@ -168,8 +167,8 @@ package body Repinfo is
    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 --
@@ -177,8 +176,8 @@ package body Repinfo is
 
    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;
@@ -350,10 +349,10 @@ package body Repinfo is
          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)
@@ -402,10 +401,9 @@ package body Repinfo is
 
                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
@@ -438,10 +436,10 @@ package body Repinfo is
             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)))
@@ -583,6 +581,9 @@ package body Repinfo is
                      Write_Str ("not ");
                      Print_Expr (Node.Op1);
 
+                  when Bit_And_Expr =>
+                     Binop (" & ");
+
                   when Lt_Expr =>
                      Binop (" < ");
 
@@ -801,9 +802,9 @@ package body Repinfo is
                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 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)
@@ -885,11 +886,11 @@ package body Repinfo is
                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)
@@ -916,8 +917,8 @@ package body Repinfo is
 
                   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 (" * ");
@@ -1019,8 +1020,8 @@ package body Repinfo is
             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 ");
@@ -1086,6 +1087,14 @@ package body Repinfo is
       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 unreliabilties in computations anyway.
+
       -------
       -- B --
       -------
@@ -1113,6 +1122,23 @@ package body Repinfo is
       end T;
 
       -------
+      -- 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;
+
+      -------
       -- V --
       -------
 
@@ -1203,6 +1229,11 @@ package body Repinfo is
                   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));