dependency.c (gfc_full_array_ref_p): Check that ref->next is NULL, i.e.

	* dependency.c (gfc_full_array_ref_p): Check that ref->next is NULL,
	i.e. that the ARRAY_REF doesn't mention components.
	* trans-array.c (gfc_constant_array_constructor_p): Export external
	function renamed from constant_array_constructor_p.
	(gfc_build_constant_array_constructor): Export.
	(gfc_trans_array_constructor): Update call to the renamed function
	constant_array_constructor_p.
	* trans-array.h (gfc_constant_array_constructor_p): Prototype here.
	(gfc_build_constant_array_constructor): Likewise.
	* trans-expr.c (gfc_build_memcpy_call): New helper function split
	out from gfc_trans_array_copy.
	(gfc_trans_array_copy): Use gfc_build_memcpy_call.
	(gfc_trans_array_constructor_copy): New function to optimize
	assigning an entire array from a constant array constructor.
	(gfc_trans_assignment): Call gfc_trans_array_constructor_copy
	when appropriate.

	* gfortran.dg/array_memcpy_3.f90: New test case.
	* gfortran.dg/vect/vect-5.f90: Update vectorized loop count.

From-SVN: r121010

8 files changed, 137 insertions, 22 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0b738ba..f13d6f8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,24 @@
 2007-01-20  Roger Sayle  <roger@eyesopen.com>
 
+	* dependency.c (gfc_full_array_ref_p): Check that ref->next is NULL,
+	i.e. that the ARRAY_REF doesn't mention components.
+	* trans-array.c (gfc_constant_array_constructor_p): Export external
+	function renamed from constant_array_constructor_p.
+	(gfc_build_constant_array_constructor): Export.
+	(gfc_trans_array_constructor): Update call to the renamed function
+	constant_array_constructor_p.
+	* trans-array.h (gfc_constant_array_constructor_p): Prototype here.
+	(gfc_build_constant_array_constructor): Likewise.
+	* trans-expr.c (gfc_build_memcpy_call): New helper function split
+	out from gfc_trans_array_copy.
+	(gfc_trans_array_copy): Use gfc_build_memcpy_call.
+	(gfc_trans_array_constructor_copy): New function to optimize
+	assigning an entire array from a constant array constructor.
+	(gfc_trans_assignment): Call gfc_trans_array_constructor_copy
+	when appropriate.
+
+2007-01-20  Roger Sayle  <roger@eyesopen.com>
+
 	* trans-intrinsic.c (gfc_conv_intrinsic_sign): New branchless
 	implementation for the SIGN intrinsic with integral operands.
 	(gfc_conv_intrinsic_minmax): Fix whitespace.
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index e0e44c2..26314e2 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -1109,6 +1109,8 @@ gfc_full_array_ref_p (gfc_ref *ref)
     return true;
   if (ref->u.ar.type != AR_SECTION)
     return false;
+  if (ref->next)
+    return false;
 
   for (i = 0; i < ref->u.ar.dimen; i++)
     {
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 7eb56af..00a9a14 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1467,8 +1467,8 @@ get_array_ctor_strlen (gfc_constructor * c, tree * len)
    elements, and if so returns the number of those elements, otherwise
    return zero.  Note, an empty or NULL array constructor returns zero.  */
 
-static unsigned HOST_WIDE_INT
-constant_array_constructor_p (gfc_constructor * c)
+unsigned HOST_WIDE_INT
+gfc_constant_array_constructor_p (gfc_constructor * c)
 {
   unsigned HOST_WIDE_INT nelem = 0;
 
@@ -1489,7 +1489,7 @@ constant_array_constructor_p (gfc_constructor * c)
    and the tree type of it's elements, TYPE, return a static constant
    variable that is compile-time initialized.  */
 
-static tree
+tree
 gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
 {
   tree tmptype, list, init, tmp;
@@ -1633,7 +1633,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
       && INTEGER_CST_P (loop->from[0])
       && INTEGER_CST_P (loop->to[0]))
     {
-      unsigned HOST_WIDE_INT nelem = constant_array_constructor_p (c);
+      unsigned HOST_WIDE_INT nelem = gfc_constant_array_constructor_p (c);
       if (nelem > 0)
 	{
 	  tree diff = fold_build2 (MINUS_EXPR, gfc_array_index_type,
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 38ad123..278ea1e 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -133,3 +133,7 @@ tree gfc_conv_descriptor_ubound (tree, tree);
 /* Add pre-loop scalarization code for intrinsic functions which require
    special handling.  */
 void gfc_add_intrinsic_ss_code (gfc_loopinfo *, gfc_ss *);
+
+/* Functions for constant array constructor processing.  */
+unsigned HOST_WIDE_INT gfc_constant_array_constructor_p (gfc_constructor *);
+tree gfc_build_constant_array_constructor (gfc_expr *, tree);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 3f186a1..2dc78b6 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3579,6 +3579,37 @@ gfc_trans_zero_assign (gfc_expr * expr)
   return fold_convert (void_type_node, tmp);
 }
 
+
+/* Helper for gfc_trans_array_copy and gfc_trans_array_constructor_copy
+   that constructs the call to __builtin_memcpy.  */
+
+static tree
+gfc_build_memcpy_call (tree dst, tree src, tree len)
+{
+  tree tmp, args;
+
+  /* Convert arguments to the correct types.  */
+  if (!POINTER_TYPE_P (TREE_TYPE (dst)))
+    dst = gfc_build_addr_expr (pvoid_type_node, dst);
+  else
+    dst = fold_convert (pvoid_type_node, dst);
+
+  if (!POINTER_TYPE_P (TREE_TYPE (src)))
+    src = gfc_build_addr_expr (pvoid_type_node, src);
+  else
+    src = fold_convert (pvoid_type_node, src);
+
+  len = fold_convert (size_type_node, len);
+
+  /* Construct call to __builtin_memcpy.  */
+  args = build_tree_list (NULL_TREE, len);
+  args = tree_cons (NULL_TREE, src, args);
+  args = tree_cons (NULL_TREE, dst, args);
+  tmp = build_function_call_expr (built_in_decls[BUILT_IN_MEMCPY], args);
+  return fold_convert (void_type_node, tmp);
+}
+
+
 /* Try to efficiently translate dst(:) = src(:).  Return NULL if this
    can't be done.  EXPR1 is the destination/lhs and EXPR2 is the
    source/rhs, both are gfc_full_array_ref_p which have been checked for
@@ -3589,7 +3620,6 @@ gfc_trans_array_copy (gfc_expr * expr1, gfc_expr * expr2)
 {
   tree dst, dlen, dtype;
   tree src, slen, stype;
-  tree tmp, args;
 
   dst = gfc_get_symbol_decl (expr1->symtree->n.sym);
   src = gfc_get_symbol_decl (expr2->symtree->n.sym);
@@ -3622,25 +3652,53 @@ gfc_trans_array_copy (gfc_expr * expr1, gfc_expr * expr2)
   if (!tree_int_cst_equal (slen, dlen))
     return NULL_TREE;
 
-  /* Convert arguments to the correct types.  */
-  if (!POINTER_TYPE_P (TREE_TYPE (dst)))
-    dst = gfc_build_addr_expr (pvoid_type_node, dst);
-  else
-    dst = fold_convert (pvoid_type_node, dst);
+  return gfc_build_memcpy_call (dst, src, dlen);
+}
 
-  if (!POINTER_TYPE_P (TREE_TYPE (src)))
-    src = gfc_build_addr_expr (pvoid_type_node, src);
-  else
-    src = fold_convert (pvoid_type_node, src);
 
-  dlen = fold_convert (size_type_node, dlen);
+/* Try to efficiently translate array(:) = (/ ... /).  Return NULL if
+   this can't be done.  EXPR1 is the destination/lhs for which
+   gfc_full_array_ref_p is true, and EXPR2 is the source/rhs.  */
 
-  /* Construct call to __builtin_memcpy.  */
-  args = build_tree_list (NULL_TREE, dlen);
-  args = tree_cons (NULL_TREE, src, args);
-  args = tree_cons (NULL_TREE, dst, args);
-  tmp = build_function_call_expr (built_in_decls[BUILT_IN_MEMCPY], args);
-  return fold_convert (void_type_node, tmp);
+static tree
+gfc_trans_array_constructor_copy (gfc_expr * expr1, gfc_expr * expr2)
+{
+  unsigned HOST_WIDE_INT nelem;
+  tree dst, dtype;
+  tree src, stype;
+  tree len;
+
+  nelem = gfc_constant_array_constructor_p (expr2->value.constructor);
+  if (nelem == 0)
+    return NULL_TREE;
+
+  dst = gfc_get_symbol_decl (expr1->symtree->n.sym);
+  dtype = TREE_TYPE (dst);
+  if (POINTER_TYPE_P (dtype))
+    dtype = TREE_TYPE (dtype);
+  if (!GFC_ARRAY_TYPE_P (dtype))
+    return NULL_TREE;
+
+  /* Determine the lengths of the array.  */
+  len = GFC_TYPE_ARRAY_SIZE (dtype);
+  if (!len || TREE_CODE (len) != INTEGER_CST)
+    return NULL_TREE;
+
+  /* Confirm that the constructor is the same size.  */
+  if (compare_tree_int (len, nelem) != 0)
+    return NULL_TREE;
+
+  len = fold_build2 (MULT_EXPR, gfc_array_index_type, len,
+		     TYPE_SIZE_UNIT (gfc_get_element_type (dtype)));
+
+  stype = gfc_typenode_for_spec (&expr2->ts);
+  src = gfc_build_constant_array_constructor (expr2, stype);
+
+  stype = TREE_TYPE (src);
+  if (POINTER_TYPE_P (stype))
+    stype = TREE_TYPE (stype);
+
+  return gfc_build_memcpy_call (dst, src, len);
 }
 
 
@@ -3870,6 +3928,18 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
         return tmp;
     }
 
+  /* Special case initializing an array from a constant array constructor.  */
+  if (expr1->expr_type == EXPR_VARIABLE
+      && copyable_array_p (expr1)
+      && gfc_full_array_ref_p (expr1->ref)
+      && expr2->expr_type == EXPR_ARRAY
+      && gfc_compare_types (&expr1->ts, &expr2->ts))
+    {
+      tmp = gfc_trans_array_constructor_copy (expr1, expr2);
+      if (tmp)
+	return tmp;
+    }
+
   /* Fallback to the scalarizer to generate explicit loops.  */
   return gfc_trans_assignment_1 (expr1, expr2, init_flag);
 }
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d1b2ddb..07d2e5f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,4 +1,9 @@
 2007-01-20  Roger Sayle  <roger@eyesopen.com>
+
+	* gfortran.dg/array_memcpy_3.f90: New test case.
+	* gfortran.dg/vect/vect-5.f90: Update vectorized loop count.
+
+2007-01-20  Roger Sayle  <roger@eyesopen.com>
 	    Brooks Moses  <brooks.moses@codesourcery.com>
 	    Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_3.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_3.f90
new file mode 100644
index 0000000..0591587
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_memcpy_3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+
+subroutine foo(x)
+  integer :: x(4)
+  x(:) = (/ 3, 1, 4, 1 /)
+end subroutine
+
+subroutine bar(x)
+  integer :: x(4)
+  x = (/ 3, 1, 4, 1 /)
+end subroutine
+
+! { dg-final { scan-tree-dump-times "memcpy" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/vect-5.f90 b/gcc/testsuite/gfortran.dg/vect/vect-5.f90
index 90b0f32..d657656 100644
--- a/gcc/testsuite/gfortran.dg/vect/vect-5.f90
+++ b/gcc/testsuite/gfortran.dg/vect/vect-5.f90
@@ -35,7 +35,7 @@
         stop
         end
 
-! { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect"  } }
+! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect"  } }
 ! { dg-final { scan-tree-dump-times "Alignment of access forced using peeling" 1 "vect" { xfail { vect_no_align } } } }
 ! { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 1 "vect" { xfail { vect_no_align } } } }
 ! { dg-final { scan-tree-dump-times "Alignment of access forced using versioning." 3 "vect" { target { ilp32 && vect_no_align } } } }