trans.c (gnat_gimplify_expr): Gimplify the SAVE_EXPR built for misaligned arguments.

	* gcc-interface/trans.c (gnat_gimplify_expr) <ADDR_EXPR>: Gimplify the
	SAVE_EXPR built for misaligned arguments.  Remove redundant stuff.
	(addressable_p): Return true for more rvalues.

Co-Authored-By: Olivier Hainque <hainque@adacore.com>

From-SVN: r151319

7 files changed, 95 insertions, 41 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 49d372c..a37d1c0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2009-09-02  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/trans.c (gnat_gimplify_expr) <ADDR_EXPR>: Gimplify the
+	SAVE_EXPR built for misaligned arguments.  Remove redundant stuff.
+	(addressable_p): Return true for more rvalues.
+
 2009-09-01  Jakub Jelinek  <jakub@redhat.com>
 
 	* gcc-interface/utils2.c (maybe_wrap_malloc, maybe_wrap_free): Cast
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 7333f8c..29ab72a 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -5794,17 +5794,17 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
     case ADDR_EXPR:
       op = TREE_OPERAND (expr, 0);
 
-      /* If we're taking the address of a constant CONSTRUCTOR, force it to
+      /* If we are taking the address of a constant CONSTRUCTOR, force it to
 	 be put into static memory.  We know it's going to be readonly given
-	 the semantics we have and it's required to be static memory in
-	 the case when the reference is in an elaboration procedure.   */
+	 the semantics we have and it's required to be in static memory when
+	 the reference is in an elaboration procedure.  */
       if (TREE_CODE (op) == CONSTRUCTOR && TREE_CONSTANT (op))
 	{
 	  tree new_var = create_tmp_var (TREE_TYPE (op), "C");
+	  TREE_ADDRESSABLE (new_var) = 1;
 
 	  TREE_READONLY (new_var) = 1;
 	  TREE_STATIC (new_var) = 1;
-	  TREE_ADDRESSABLE (new_var) = 1;
 	  DECL_INITIAL (new_var) = op;
 
 	  TREE_OPERAND (expr, 0) = new_var;
@@ -5812,44 +5812,28 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
 	  return GS_ALL_DONE;
 	}
 
-      /* If we are taking the address of a SAVE_EXPR, we are typically
-	 processing a misaligned argument to be passed by reference in a
-	 procedure call.  We just mark the operand as addressable + not
-	 readonly here and let the common gimplifier code perform the
-	 temporary creation, initialization, and "instantiation" in place of
-	 the SAVE_EXPR in further operands, in particular in the copy back
-	 code inserted after the call.  */
-      else if (TREE_CODE (op) == SAVE_EXPR)
-	{
-	  TREE_ADDRESSABLE (op) = 1;
-	  TREE_READONLY (op) = 0;
-	}
-
-      /* We let the gimplifier process &COND_EXPR and expect it to yield the
-	 address of the selected operand when it is addressable.  Besides, we
-	 also expect addressable_p to only let COND_EXPRs where both arms are
-	 addressable reach here.  */
-      else if (TREE_CODE (op) == COND_EXPR)
-	;
-
-      /* Otherwise, if we are taking the address of something that is neither
-	 reference, declaration, or constant, make a variable for the operand
-	 here and then take its address.  If we don't do it this way, we may
-	 confuse the gimplifier because it needs to know the variable is
-	 addressable at this point.  This duplicates code in
-	 internal_get_tmp_var, which is unfortunate.  */
-      else if (TREE_CODE_CLASS (TREE_CODE (op)) != tcc_reference
-	       && TREE_CODE_CLASS (TREE_CODE (op)) != tcc_declaration
-	       && TREE_CODE_CLASS (TREE_CODE (op)) != tcc_constant)
+      /* If we are taking the address of a SAVE_EXPR, we are typically dealing
+	 with a misaligned argument to be passed by reference in a subprogram
+	 call.  We cannot let the common gimplifier code perform the creation
+	 of the temporary and its initialization because, in order to ensure
+	 that the final copy operation is a store and since the temporary made
+	 for a SAVE_EXPR is not addressable, it may create another temporary,
+	 addressable this time, which would break the back copy mechanism for
+	 an IN OUT parameter.  */
+      if (TREE_CODE (op) == SAVE_EXPR && !SAVE_EXPR_RESOLVED_P (op))
 	{
-	  tree new_var = create_tmp_var (TREE_TYPE (op), "A");
-	  gimple stmt;
-
+	  tree mod, val = TREE_OPERAND (op, 0);
+	  tree new_var = create_tmp_var (TREE_TYPE (op), "S");
 	  TREE_ADDRESSABLE (new_var) = 1;
 
-	  stmt = gimplify_assign (new_var, op, pre_p);
-	  if (EXPR_HAS_LOCATION (op))
-	    gimple_set_location (stmt, EXPR_LOCATION (op));
+	  mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, val);
+	  if (EXPR_HAS_LOCATION (val))
+	    SET_EXPR_LOCATION (mod, EXPR_LOCATION (val));
+	  gimplify_and_add (mod, pre_p);
+	  ggc_free (mod);
+
+	  TREE_OPERAND (op, 0) = new_var;
+	  SAVE_EXPR_RESOLVED_P (op) = 1;
 
 	  TREE_OPERAND (expr, 0) = new_var;
 	  recompute_tree_invariant_for_addr_expr (expr);
@@ -5866,7 +5850,7 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
       if ((TREE_CODE (op) == TYPE_DECL || TREE_CODE (op) == VAR_DECL)
 	  && !TYPE_SIZES_GIMPLIFIED (TREE_TYPE (op)))
 	switch (TREE_CODE (TREE_TYPE (op)))
-	{
+	  {
 	  case INTEGER_TYPE:
 	  case ENUMERAL_TYPE:
 	  case BOOLEAN_TYPE:
@@ -5895,7 +5879,7 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
 
 	  default:
 	    break;
-	}
+	  }
 
       /* ... fall through ... */
 
@@ -6942,12 +6926,18 @@ addressable_p (tree gnu_expr, tree gnu_type)
 
     case UNCONSTRAINED_ARRAY_REF:
     case INDIRECT_REF:
+      return true;
+
     case CONSTRUCTOR:
     case STRING_CST:
     case INTEGER_CST:
     case NULL_EXPR:
     case SAVE_EXPR:
     case CALL_EXPR:
+    case PLUS_EXPR:
+    case MINUS_EXPR:
+      /* All rvalues are deemed addressable since taking their address will
+	 force a temporary to be created by the middle-end.  */
       return true;
 
     case COND_EXPR:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e86840c..1d16790 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2009-09-02  Eric Botcazou  <ebotcazou@adacore.com>
+            Olivier Hainque  <hainque@adacore.com>
+
+	* gnat.dg/misaligned_param.adb: New test.
+	* gnat.dg/misaligned_param_pkg.ad[sb]: New helper.
+	* gnat.dg/slice7.adb: Add 1 more related case.
+
 2009-09-01  Alexandre Oliva  <aoliva@redhat.com>
 
 	* gcc.dg/guality/guality.c: Expect to fail for now.
diff --git a/gcc/testsuite/gnat.dg/misaligned_param.adb b/gcc/testsuite/gnat.dg/misaligned_param.adb
new file mode 100644
index 0000000..dd591d0
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/misaligned_param.adb
@@ -0,0 +1,30 @@
+-- { dg-do run }
+-- { dg-options "-gnatws" }
+
+with Misaligned_Param_Pkg;
+
+procedure Misaligned_Param is
+
+   procedure Channel_Eth (Status : out Integer; Kind : out Integer);
+
+   pragma Import (External, Channel_Eth);
+   pragma Import_Valued_Procedure
+     (Channel_Eth, "channel_eth", (Integer, Integer), (VALUE, REFERENCE));
+
+   type Channel is record
+      B : Boolean;
+      Kind : Integer;
+   end record;
+   pragma Pack (Channel);
+
+   MyChan : Channel;
+   Status : Integer;
+
+begin
+   MyChan.Kind := 0;
+   Channel_Eth (Status => Status, Kind => MyChan.Kind);
+
+   if Mychan.Kind = 0 then
+      raise Program_Error;
+   end if;
+end;
diff --git a/gcc/testsuite/gnat.dg/misaligned_param_pkg.adb b/gcc/testsuite/gnat.dg/misaligned_param_pkg.adb
new file mode 100644
index 0000000..888ed18
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/misaligned_param_pkg.adb
@@ -0,0 +1,14 @@
+package body Misaligned_Param_Pkg is
+
+  type IP is access all Integer;
+
+  function Channel_Eth (Kind : IP) return Integer;
+  pragma Export (Ada, Channel_Eth, "channel_eth");
+
+  function Channel_Eth (Kind : IP) return Integer is
+  begin
+    Kind.all := 111;
+    return 0;
+  end;
+
+end Misaligned_Param_Pkg;
diff --git a/gcc/testsuite/gnat.dg/misaligned_param_pkg.ads b/gcc/testsuite/gnat.dg/misaligned_param_pkg.ads
new file mode 100644
index 0000000..7934c3f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/misaligned_param_pkg.ads
@@ -0,0 +1,5 @@
+package Misaligned_Param_Pkg is
+
+  pragma Elaborate_Body (Misaligned_Param_Pkg);
+
+end Misaligned_Param_Pkg;
diff --git a/gcc/testsuite/gnat.dg/slice7.adb b/gcc/testsuite/gnat.dg/slice7.adb
index 3f0d3f5..bb68c1f 100644
--- a/gcc/testsuite/gnat.dg/slice7.adb
+++ b/gcc/testsuite/gnat.dg/slice7.adb
@@ -27,6 +27,8 @@ procedure Slice7 is
   Obj : Discrete_Type;
 
 begin
+  Put (Convert_Put(Discrete_Type'Pos (Obj)));
+
   Put (Convert_Put(Discrete_Type'Pos (Obj))
        (Buffer_Start..Buffer_End));