trans-expr.c (is_zero_initializer_p): Determine whether a given constant expression is a zero initializer.

	* trans-expr.c (is_zero_initializer_p): Determine whether a given
	constant expression is a zero initializer.
	(gfc_trans_zero_assign): New function to attempt to optimize
	"a(:) = 0.0" as a call to __builtin_memset (a, 0, sizeof(a));
	(gfc_trans_assignment): Special case array assignments to a
	zero initializer constant, using gfc_trans_zero_assign.

	* gfortran.dg/array_memset_1.f90: New test case.

From-SVN: r120078

4 files changed, 165 insertions, 0 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d283671..0eb5dc5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2006-12-20  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-expr.c (is_zero_initializer_p): Determine whether a given
+	constant expression is a zero initializer.
+	(gfc_trans_zero_assign): New function to attempt to optimize
+	"a(:) = 0.0" as a call to __builtin_memset (a, 0, sizeof(a));
+	(gfc_trans_assignment): Special case array assignments to a
+	zero initializer constant, using gfc_trans_zero_assign.
+
 2006-12-20  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/29992
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 04736d5..bd79834 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3449,6 +3449,82 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
   return gfc_finish_block (&se.pre);
 }
 
+/* Determine whether the given EXPR_CONSTANT is a zero initializer.  */
+
+static bool
+is_zero_initializer_p (gfc_expr * expr)
+{
+  if (expr->expr_type != EXPR_CONSTANT)
+    return false;
+  /* We ignore Hollerith constants for the time being.  */
+  if (expr->from_H)
+    return false;
+
+  switch (expr->ts.type)
+    {
+    case BT_INTEGER:
+      return mpz_cmp_si (expr->value.integer, 0) == 0;
+
+    case BT_REAL:
+      return mpfr_zero_p (expr->value.real)
+	     && MPFR_SIGN (expr->value.real) >= 0;
+
+    case BT_LOGICAL:
+      return expr->value.logical == 0;
+
+    case BT_COMPLEX:
+      return mpfr_zero_p (expr->value.complex.r)
+	     && MPFR_SIGN (expr->value.complex.r) >= 0
+             && mpfr_zero_p (expr->value.complex.i)
+	     && MPFR_SIGN (expr->value.complex.i) >= 0;
+
+    default:
+      break;
+    }
+  return false;
+}
+
+/* Try to efficiently translate array(:) = 0.  Return NULL if this
+   can't be done.  */
+
+static tree
+gfc_trans_zero_assign (gfc_expr * expr)
+{
+  tree dest, len, type;
+  tree tmp, args;
+  gfc_symbol *sym;
+
+  sym = expr->symtree->n.sym;
+  dest = gfc_get_symbol_decl (sym);
+
+  type = TREE_TYPE (dest);
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  if (!GFC_ARRAY_TYPE_P (type))
+    return NULL_TREE;
+
+  /* Determine the length of the array.  */
+  len = GFC_TYPE_ARRAY_SIZE (type);
+  if (!len || TREE_CODE (len) != INTEGER_CST)
+    return NULL_TREE;
+
+  len = fold_build2 (MULT_EXPR, gfc_array_index_type, len,
+                     TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+
+  /* Convert arguments to the correct types.  */
+  if (!POINTER_TYPE_P (TREE_TYPE (dest)))
+    dest = gfc_build_addr_expr (pvoid_type_node, dest);
+  else
+    dest = fold_convert (pvoid_type_node, dest);
+  len = fold_convert (size_type_node, len);
+
+  /* Construct call to __builtin_memset.  */
+  args = build_tree_list (NULL_TREE, len);
+  args = tree_cons (NULL_TREE, integer_zero_node, args);
+  args = tree_cons (NULL_TREE, dest, args);
+  tmp = build_function_call_expr (built_in_decls[BUILT_IN_MEMSET], args);
+  return fold_convert (void_type_node, tmp);
+}
 
 /* Translate an assignment.  Most of the code is concerned with
    setting up the scalarizer.  */
@@ -3475,6 +3551,18 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
 	return tmp;
     }
 
+  /* Special case assigning an array to zero.  */
+  if (expr1->expr_type == EXPR_VARIABLE
+      && expr1->rank > 0
+      && expr1->ref
+      && gfc_full_array_ref_p (expr1->ref)
+      && is_zero_initializer_p (expr2))
+    {
+      tmp = gfc_trans_zero_assign (expr1);
+      if (tmp)
+        return tmp;
+    }
+
   /* Assignment of the form lhs = rhs.  */
   gfc_start_block (&block);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 34255c4..d666489 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2006-12-20  Roger Sayle  <roger@eyesopen.com>
+
+	* gfortran.dg/array_memset_1.f90: New test case.
+
 2006-12-20  Dorit Nuzman  <dorit@il.ibm.com>
 
 	* lib/target-supports.exp: Add spu to
diff --git a/gcc/testsuite/gfortran.dg/array_memset_1.f90 b/gcc/testsuite/gfortran.dg/array_memset_1.f90
new file mode 100644
index 0000000..cd6cb0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_memset_1.f90
@@ -0,0 +1,64 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine i1(a)
+  integer :: a(20)
+  a = 0;
+end subroutine
+
+subroutine i2(a)
+  integer :: a(20)
+  a(:) = 0;
+end subroutine
+
+subroutine i3(a)
+  integer :: a(20)
+  a(1:20) = 0;
+end subroutine
+
+subroutine r1(a)
+  real :: a(20)
+  a = 0.0;
+end subroutine
+
+subroutine r2(a)
+  real :: a(20)
+  a(:) = 0.0;
+end subroutine
+
+subroutine r3(a)
+  real :: a(20)
+  a(1:20) = 0.0;
+end subroutine
+
+subroutine z1(a)
+  complex :: a(20)
+  a = 0;
+end subroutine
+
+subroutine z2(a)
+  complex :: a(20)
+  a(:) = 0;
+end subroutine
+
+subroutine z3(a)
+  complex :: a(20)
+  a(1:20) = 0;
+end subroutine
+
+subroutine l1(a)
+  logical :: a(20)
+  a = .false.;
+end subroutine
+
+subroutine l2(a)
+  logical :: a(20)
+  a(:) = .false.;
+end subroutine
+
+subroutine l3(a)
+  logical :: a(20)
+  a(1:20) = .false.;
+end subroutine
+
+! { dg-final { scan-tree-dump-times "memset" 12 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }