* 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.

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 49d372c..a37d1c0 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
--- 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));