[Patch] Fix gimplification of slices of integer

[Eric Botcazou <ebotcazou at adacore dot com>]

Hi,

the attached testcase exhibits a gimplication problem in a corner case: 
dynamic slices of integer viewed as array.  There are 2 variants of the 
problem:

 1. in the first variant, an integer DECL is converted to another integer and
    then VCEd to an array, the address of a slice of which is taken.
    This is problematic because, in gimplify_addr_expr, the gimplification of
    the first conversion yields a temporary, which eventually ends up being
    marked addressable, leading to:

slice7.adb:8:1: error: non-register as LHS of unary operation
D.2284 = (slice7__convert_putGP404__source) obj.14;

    because an addressable DECL is not a gimple register.

    There is already a counter-measure for a simpler case in the function:

      /* We cannot rely on making the RHS addressable if it is
	 a temporary created by gimplification.  In this case create a
	 new temporary that is initialized by a copy (which will
	 become a store after we mark it addressable).
	 This mostly happens if the frontend passed us something that
	 it could not mark addressable yet, like a fortran
	 pass-by-reference parameter (int) floatvar.  */
      if (is_gimple_reg (TREE_OPERAND (expr, 0)))
	TREE_OPERAND (expr, 0)
	  = get_initialized_tmp_var (TREE_OPERAND (expr, 0), pre_p, post_p);

    but it doesn't trigger in this case because the gimple register is not
    the top-level node.

    The proposed fix is to enhance the counter-measure to catch the case.

 2.  in the second variant, a difference of 2 integers is VCEd to an array,
     the address of a SAVE_EXPR of a slice of which is taken(!).
     Same problem, but this time in gimplify_modify_expr_to_memcpy when the
     RHS is marked addressable:

slice7.adb:8:1: error: non-register as LHS of binary operation
D.2325 = D.2324 + -1;

     The proposed fix is to apply the same counter-measure to this function
     (a patchlet is also needed in Gigi for this second variant).

Tested on i586-suse-linux, OK for mainline?


2009-08-21  Eric Botcazou  <ebotcazou@adacore.com>

	* gimplify.c (prepare_gimple_addressable): New static function.
	(gimplify_modify_expr_to_memcpy): Invoke it on the RHS before marking
	it addressable.
	(gimplify_addr_expr): Invoke it similarly on the operand instead of
	manually fiddling with it.
ada/
	* gcc-interface/trans.c (call_to_gnu): Tidy.
	(gnat_to_gnu) <N_Slice>: Set TYPE_ARRAY_MAX_SIZE if the slice has
	non-constant size but the array itself has constant size.


2009-08-21  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/slice7.adb: New test.
	* gnat.dg/slice7_pkg.ads: New helper.


-- 
Eric Botcazou

-- { dg-do compile }
-- { dg-options "-gnatws" }

with System.Storage_Elements; use System.Storage_Elements;
with Unchecked_Conversion;
with Slice7_Pkg; use Slice7_Pkg;

procedure Slice7 is

  type Discrete_Type is range 1 .. 32;

  Max_Byte_Count : constant := 4;
  subtype Byte_Count_Type is Storage_Offset range 1..Max_Byte_Count;

  subtype Buffer_Type is Storage_Array (Byte_Count_Type);
  function Convert_Put is new Unchecked_Conversion (Integer, Buffer_Type);

  function Set_Buffer_Size return Byte_Count_Type is
  begin
    return 4;
  end;

  Buffer_Size  : constant Byte_Count_Type := Set_Buffer_Size;
  Buffer_End   : constant Byte_Count_Type := Max_Byte_Count;
  Buffer_Start : constant Byte_Count_Type := Buffer_End - Buffer_Size + 1;

  Obj : Discrete_Type;

begin
  Put (Convert_Put(Discrete_Type'Pos (Obj))
       (Buffer_Start..Buffer_End));

  Put (Convert_Put(Discrete_Type'Pos (Obj) -
                   Discrete_Type'Pos (Discrete_Type'First))
       (Buffer_Start..Buffer_End));
end;

with System.Storage_Elements; use System.Storage_Elements;

package Slice7_Pkg is

  procedure Put (The_Object : in Storage_Array);

end Slice7_Pkg;

Index: gimplify.c
===================================================================
--- gimplify.c	(revision 150875)
+++ gimplify.c	(working copy)
@@ -3095,6 +3095,25 @@ gimplify_cond_expr (tree *expr_p, gimple
   return ret;
 }
 
+/* Prepare the node pointed to by EXPR_P, an is_gimple_addressable expression,
+   to be marked addressable.
+
+   We cannot rely on such an expression being directly markable if a temporary
+   has been created by the gimplification.  In this case, we create another
+   temporary and initialize it with a copy, which will become a store after we
+   mark it addressable.  This can happen if the front-end passed us something
+   that it could not mark addressable yet, like a Fortran pass-by-reference
+   parameter (int) floatvar.  */
+
+static void
+prepare_gimple_addressable (tree *expr_p, gimple_seq *seq_p)
+{
+  while (handled_component_p (*expr_p))
+    expr_p = &TREE_OPERAND (*expr_p, 0);
+  if (is_gimple_reg (*expr_p))
+    *expr_p = get_initialized_tmp_var (*expr_p, seq_p, NULL);
+}
+
 /* A subroutine of gimplify_modify_expr.  Replace a MODIFY_EXPR with
    a call to __builtin_memcpy.  */
 
@@ -3109,6 +3128,10 @@ gimplify_modify_expr_to_memcpy (tree *ex
   to = TREE_OPERAND (*expr_p, 0);
   from = TREE_OPERAND (*expr_p, 1);
 
+  /* Mark the RHS addressable.  Beware that it may not be possible to do so
+     directly if a temporary has been created by the gimplification.  */
+  prepare_gimple_addressable (&from, seq_p);
+
   mark_addressable (from);
   from_ptr = build_fold_addr_expr_loc (loc, from);
   gimplify_arg (&from_ptr, seq_p, loc);
@@ -4685,22 +4708,15 @@ gimplify_addr_expr (tree *expr_p, gimple
 	 gcc.dg/c99-array-lval-1.c.  The gimplifier will correctly make
 	 the implied temporary explicit.  */
 
-      /* Mark the RHS addressable.  */
+      /* Make the operand addressable.  */
       ret = gimplify_expr (&TREE_OPERAND (expr, 0), pre_p, post_p,
 			   is_gimple_addressable, fb_either);
       if (ret == GS_ERROR)
 	break;
 
-      /* We cannot rely on making the RHS addressable if it is
-	 a temporary created by gimplification.  In this case create a
-	 new temporary that is initialized by a copy (which will
-	 become a store after we mark it addressable).
-	 This mostly happens if the frontend passed us something that
-	 it could not mark addressable yet, like a fortran
-	 pass-by-reference parameter (int) floatvar.  */
-      if (is_gimple_reg (TREE_OPERAND (expr, 0)))
-	TREE_OPERAND (expr, 0)
-	  = get_initialized_tmp_var (TREE_OPERAND (expr, 0), pre_p, post_p);
+      /* Then mark it.  Beware that it may not be possible to do so directly
+	 if a temporary has been created by the gimplification.  */
+      prepare_gimple_addressable (&TREE_OPERAND (expr, 0), pre_p);
 
       op0 = TREE_OPERAND (expr, 0);
 
Index: ada/gcc-interface/trans.c
===================================================================
--- ada/gcc-interface/trans.c	(revision 150963)
+++ ada/gcc-interface/trans.c	(working copy)
@@ -2506,7 +2506,7 @@ call_to_gnu (Node_Id gnat_node, tree *gn
 	  && (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name)))
 	  && !addressable_p (gnu_name, gnu_name_type))
 	{
-	  tree gnu_copy = gnu_name, gnu_temp;
+	  tree gnu_copy = gnu_name;
 
 	  /* If the type is by_reference, a copy is not allowed.  */
 	  if (Is_By_Reference_Type (Etype (gnat_formal)))
@@ -2569,10 +2569,10 @@ call_to_gnu (Node_Id gnat_node, tree *gn
 	  /* Set up to move the copy back to the original.  */
 	  if (Ekind (gnat_formal) != E_In_Parameter)
 	    {
-	      gnu_temp = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_copy,
-					  gnu_name);
-	      set_expr_location_from_node (gnu_temp, gnat_node);
-	      append_to_statement_list (gnu_temp, &gnu_after_list);
+	      tree stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_copy,
+					   gnu_name);
+	      set_expr_location_from_node (stmt, gnat_node);
+	      append_to_statement_list (stmt, &gnu_after_list);
 	    }
 	}
 
@@ -3889,8 +3889,8 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Slice:
       {
-	tree gnu_type;
 	Node_Id gnat_range_node = Discrete_Range (gnat_node);
+	tree gnu_type;
 
 	gnu_result = gnat_to_gnu (Prefix (gnat_node));
 	gnu_result_type = get_unpadded_type (Etype (gnat_node));
@@ -3963,6 +3963,12 @@ gnat_to_gnu (Node_Id gnat_node)
 	  /* Simply return the naked low bound.  */
 	  gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
 
+	/* If this is a slice with non-constant size of an array with constant
+	   size, set the maximum size for the allocation of temporaries.  */
+	if (!TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_result_type))
+	    && TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_type)))
+	  TYPE_ARRAY_MAX_SIZE (gnu_result_type) = TYPE_SIZE_UNIT (gnu_type);
+
 	gnu_result = build_binary_op (ARRAY_RANGE_REF, gnu_result_type,
 				      gnu_result, gnu_expr);
       }