trans.c (call_to_gnu): Make the temporary for non-addressable In parameters passed by reference.

	* trans.c (call_to_gnu): Make the temporary for non-addressable
	In parameters passed by reference.
	(addressable_p): Return true for STRING_CST and CALL_EXPR.

From-SVN: r131140

4 files changed, 102 insertions, 88 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4ce1151..3f99566 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2007-12-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* trans.c (call_to_gnu): Make the temporary for non-addressable
+	In parameters passed by reference.
+	(addressable_p): Return true for STRING_CST and CALL_EXPR.
+
 2007-12-19  Robert Dewar  <dewar@adacore.com>
 
 	* g-expect-vms.adb, g-expect.adb, s-poosiz.adb: 
diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index b750370..aa4b282 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -2089,80 +2089,77 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
       tree gnu_actual;
 
       /* If it's possible we may need to use this expression twice, make sure
-	 than any side-effects are handled via SAVE_EXPRs. Likewise if we need
+	 that any side-effects are handled via SAVE_EXPRs.  Likewise if we need
 	 to force side-effects before the call.
 
 	 ??? This is more conservative than we need since we don't need to do
-	 this for pass-by-ref with no conversion. If we are passing a
-	 non-addressable Out or In Out parameter by reference, pass the address
-	 of a copy and set up to copy back out after the call.  */
+	 this for pass-by-ref with no conversion.  */
       if (Ekind (gnat_formal) != E_In_Parameter)
+	gnu_name = gnat_stabilize_reference (gnu_name, true);
+
+      /* If we are passing a non-addressable parameter by reference, pass the
+	 address of a copy.  In the Out or In Out case, set up to copy back
+	 out after the call.  */
+      if (!addressable_p (gnu_name)
+	  && gnu_formal
+	  && (DECL_BY_REF_P (gnu_formal)
+	      || (TREE_CODE (gnu_formal) == PARM_DECL
+		  && (DECL_BY_COMPONENT_PTR_P (gnu_formal)
+		      || (DECL_BY_DESCRIPTOR_P (gnu_formal))))))
 	{
-	  gnu_name = gnat_stabilize_reference (gnu_name, true);
-
-	  if (!addressable_p (gnu_name)
-	      && gnu_formal
-	      && (DECL_BY_REF_P (gnu_formal)
-		  || (TREE_CODE (gnu_formal) == PARM_DECL
-		      && (DECL_BY_COMPONENT_PTR_P (gnu_formal)
-			  || (DECL_BY_DESCRIPTOR_P (gnu_formal))))))
-	    {
-	      tree gnu_copy = gnu_name;
-	      tree gnu_temp;
-
-	      /* If the type is by_reference, a copy is not allowed.  */
-	      if (Is_By_Reference_Type (Etype (gnat_formal)))
-		post_error
-		  ("misaligned & cannot be passed by reference", gnat_actual);
-
-	      /* For users of Starlet we issue a warning because the
-		 interface apparently assumes that by-ref parameters
-		 outlive the procedure invocation.  The code still
-		 will not work as intended, but we cannot do much
-		 better since other low-level parts of the back-end
-		 would allocate temporaries at will because of the
-		 misalignment if we did not do so here.  */
+	  tree gnu_copy = gnu_name, gnu_temp;
 
-	      else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
-		{
-		  post_error
-		    ("?possible violation of implicit assumption",
-		     gnat_actual);
-		  post_error_ne
-		    ("?made by pragma Import_Valued_Procedure on &",
-		     gnat_actual, Entity (Name (gnat_node)));
-		  post_error_ne
-		    ("?because of misalignment of &",
-		     gnat_actual, gnat_formal);
-		}
+	  /* If the type is by_reference, a copy is not allowed.  */
+	  if (Is_By_Reference_Type (Etype (gnat_formal)))
+	    post_error
+	      ("misaligned & cannot be passed by reference", gnat_actual);
+
+	  /* For users of Starlet we issue a warning because the
+	     interface apparently assumes that by-ref parameters
+	     outlive the procedure invocation.  The code still
+	     will not work as intended, but we cannot do much
+	     better since other low-level parts of the back-end
+	     would allocate temporaries at will because of the
+	     misalignment if we did not do so here.  */
+	  else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
+	    {
+	      post_error
+		("?possible violation of implicit assumption", gnat_actual);
+	      post_error_ne
+		("?made by pragma Import_Valued_Procedure on &", gnat_actual,
+		 Entity (Name (gnat_node)));
+	      post_error_ne ("?because of misalignment of &", gnat_actual,
+			     gnat_formal);
+	    }
 
-	      /* Remove any unpadding on the actual and make a copy.  But if
-		 the actual is a justified modular type, first convert
-		 to it.  */
-	      if (TREE_CODE (gnu_name) == COMPONENT_REF
-		  && ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0)))
-		       == RECORD_TYPE)
-		      && (TYPE_IS_PADDING_P
-			  (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))))
-		gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0);
-	      else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
-		       && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)))
-		gnu_name = convert (gnu_name_type, gnu_name);
-
-	      /* Make a SAVE_EXPR to both properly account for potential side
-		 effects and handle the creation of a temporary copy.  Special
-		 code in gnat_gimplify_expr ensures that the same temporary is
-		 used as the actual and copied back after the call.  */
-	      gnu_actual = save_expr (gnu_name);
-
-	      /* Set up to move the copy back to the original.  */
-	      gnu_temp = build_binary_op (MODIFY_EXPR, NULL_TREE,
-					  gnu_copy, gnu_actual);
+	  /* Remove any unpadding on the actual and make a copy.  But if
+	     the actual is a justified modular type, first convert to it.  */
+	  if (TREE_CODE (gnu_name) == COMPONENT_REF
+	      && ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0)))
+		   == RECORD_TYPE)
+		  && (TYPE_IS_PADDING_P
+		      (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))))
+	    gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0);
+
+	  else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
+		   && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)))
+	    gnu_name = convert (gnu_name_type, gnu_name);
+
+	  /* Make a SAVE_EXPR to both properly account for potential side
+	     effects and handle the creation of a temporary copy.  Special
+	     code in gnat_gimplify_expr ensures that the same temporary is
+	     used as the actual and copied back after the call if needed.  */
+	  gnu_name = build1 (SAVE_EXPR, TREE_TYPE (gnu_name), gnu_name);
+	  TREE_SIDE_EFFECTS (gnu_name) = 1;
+	  TREE_INVARIANT (gnu_name) = 1;
+
+	  /* 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_actual);
 	      append_to_statement_list (gnu_temp, &gnu_after_list);
-
-	      /* Account for next statement just below.  */
-	      gnu_name = gnu_actual;
 	    }
 	}
 
@@ -2222,7 +2219,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 	 copied in. Otherwise, look at the PARM_DECL to see if it is passed by
 	 reference. */
       if (gnu_formal
-	  && TREE_CODE (gnu_formal) == PARM_DECL && DECL_BY_REF_P (gnu_formal))
+	  && TREE_CODE (gnu_formal) == PARM_DECL
+	  && DECL_BY_REF_P (gnu_formal))
 	{
 	  if (Ekind (gnat_formal) != E_In_Parameter)
 	    {
@@ -2250,32 +2248,13 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 				      gnu_actual);
 	    }
 
-	  /* Otherwise, if we have a non-addressable COMPONENT_REF of a
-	     variable-size type see if it's doing a unpadding operation.  If
-	     so, remove that operation since we have no way of allocating the
-	     required temporary.  */
-	  if (TREE_CODE (gnu_actual) == COMPONENT_REF
-	      && !TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
-	      && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_actual, 0)))
-		  == RECORD_TYPE)
-	      && TYPE_IS_PADDING_P (TREE_TYPE
-				    (TREE_OPERAND (gnu_actual, 0)))
-	      && !addressable_p (gnu_actual))
-	    gnu_actual = TREE_OPERAND (gnu_actual, 0);
-
-	  /* For In parameters, gnu_actual might still not be addressable at
-	     this point and we need the creation of a temporary copy since
-	     this is to be passed by ref.  Resorting to save_expr to force a
-	     SAVE_EXPR temporary creation here is not guaranteed to work
-	     because the actual might be invariant or readonly without side
-	     effects, so we let the gimplifier process this case.  */
-
 	  /* The symmetry of the paths to the type of an entity is broken here
 	     since arguments don't know that they will be passed by ref. */
 	  gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
 	  gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual);
 	}
-      else if (gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL
+      else if (gnu_formal
+	       && TREE_CODE (gnu_formal) == PARM_DECL
 	       && DECL_BY_COMPONENT_PTR_P (gnu_formal))
 	{
 	  gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
@@ -2299,7 +2278,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 				build_unary_op (ADDR_EXPR, NULL_TREE,
 						gnu_actual));
 	}
-      else if (gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL
+      else if (gnu_formal
+	       && TREE_CODE (gnu_formal) == PARM_DECL
 	       && DECL_BY_DESCRIPTOR_P (gnu_formal))
 	{
 	  /* If arg is 'Null_Parameter, pass zero descriptor.  */
@@ -6077,8 +6057,10 @@ addressable_p (tree gnu_expr)
     case UNCONSTRAINED_ARRAY_REF:
     case INDIRECT_REF:
     case CONSTRUCTOR:
+    case STRING_CST:
     case NULL_EXPR:
     case SAVE_EXPR:
+    case CALL_EXPR:
       return true;
 
     case COMPONENT_REF:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a6816d4..008192e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2007-12-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/pack2.adb: New test.
+
 2007-12-22  Daniel Franke  <franke.daniel@gmail.com>
 
 	PR fortran/34559
diff --git a/gcc/testsuite/gnat.dg/pack2.adb b/gcc/testsuite/gnat.dg/pack2.adb
new file mode 100644
index 0000000..7837c8a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/pack2.adb
@@ -0,0 +1,22 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+procedure Pack2 is
+
+   type Bits_T is record
+      B0, B1, B2: Boolean;
+   end record;
+
+   type State_T is record
+      Valid : Boolean;
+      Value : Bits_T;
+   end record;
+   pragma Pack (State_T);
+      
+   procedure Process (Bits : Bits_T) is begin null; end;
+   
+   State : State_T;
+
+begin
+   Process (State.Value);
+end;