* dependency.c (gfc_check_dependency): Remove unused vars and nvars

	arguments.  Replace with an "identical" argument.  A full array
	reference to the same symbol is a dependency if identical is true.
	* dependency.h (gfc_check_dependency): Update prototype.
	* trans-array.h (gfc_check_dependency): Delete duplicate prototype.
	* trans-stmt.c: #include dependency.h for gfc_check_dependency.
	(gfc_trans_forall_1): Update calls to gfc_check_dependency.
	(gfc_trans_where_2): Likewise.  Remove unneeded variables.
	(gfc_trans_where_3): New function for simple non-dependent WHEREs.
	(gfc_trans_where): Call gfc_trans_where_3 to translate simple
	F90-style WHERE statements without internal dependencies.
	* Make-lang.in (trans-stmt.o): Depend upon dependency.h.



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

6 files changed, 223 insertions, 31 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0bdbefdb6e2..d2a51f40e76 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+2006-02-04  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_check_dependency): Remove unused vars and nvars
+	arguments.  Replace with an "identical" argument.  A full array
+	reference to the same symbol is a dependency if identical is true.
+	* dependency.h (gfc_check_dependency): Update prototype.
+	* trans-array.h (gfc_check_dependency): Delete duplicate prototype.
+	* trans-stmt.c: #include dependency.h for gfc_check_dependency.
+	(gfc_trans_forall_1): Update calls to gfc_check_dependency.
+	(gfc_trans_where_2): Likewise.  Remove unneeded variables.
+	(gfc_trans_where_3): New function for simple non-dependent WHEREs.
+	(gfc_trans_where): Call gfc_trans_where_3 to translate simple
+	F90-style WHERE statements without internal dependencies.
+	* Make-lang.in (trans-stmt.o): Depend upon dependency.h.
+
 2006-02-05  H.J. Lu  <hongjiu.lu@intel.com>
 
 	PR fortran/26041
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 622892823ed..c7fa78f0303 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -279,7 +279,7 @@ fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \
   real.h toplev.h $(TARGET_H)
 fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS)
 fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
-fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS)
+fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
 fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h \
   fortran/ioparm.def
 fortran/trans-array.o: $(GFORTRAN_TRANS_DEPS)
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 4a795602414..62f3aa62e48 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -259,10 +259,10 @@ gfc_check_argument_var_dependency (gfc_expr * var, sym_intent intent,
     {
     case EXPR_VARIABLE:
       return (gfc_ref_needs_temporary_p (expr->ref)
-	      || gfc_check_dependency (var, expr, NULL, 0));
+	      || gfc_check_dependency (var, expr, 1));
 
     case EXPR_ARRAY:
-      return gfc_check_dependency (var, expr, NULL, 0);
+      return gfc_check_dependency (var, expr, 1);
 
     case EXPR_FUNCTION:
       if (intent != INTENT_IN && expr->inline_noncopying_intrinsic)
@@ -339,15 +339,14 @@ gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
 
 /* Return true if the statement body redefines the condition.  Returns
    true if expr2 depends on expr1.  expr1 should be a single term
-   suitable for the lhs of an assignment.  The symbols listed in VARS
-   must be considered to have all possible values. All other scalar
-   variables may be considered constant.  Used for forall and where
+   suitable for the lhs of an assignment.  The IDENTICAL flag indicates
+   whether array references to the same symbol with identical range
+   references count as a dependency or not.  Used for forall and where
    statements.  Also used with functions returning arrays without a
    temporary.  */
 
 int
-gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
-		      int nvars)
+gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
 {
   gfc_ref *ref;
   int n;
@@ -367,11 +366,11 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
   switch (expr2->expr_type)
     {
     case EXPR_OP:
-      n = gfc_check_dependency (expr1, expr2->value.op.op1, vars, nvars);
+      n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
       if (n)
 	return n;
       if (expr2->value.op.op2)
-	return gfc_check_dependency (expr1, expr2->value.op.op2, vars, nvars);
+	return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
       return 0;
 
     case EXPR_VARIABLE:
@@ -387,15 +386,25 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
       if (expr1->symtree->n.sym != expr2->symtree->n.sym)
 	return 0;
 
-      for (ref = expr2->ref; ref; ref = ref->next)
-	{
-	  /* Identical ranges return 0, overlapping ranges return 1.  */
-	  if (ref->type == REF_ARRAY)
-	    return 1;
-	}
+      if (identical)
+	return 1;
+
+      /* Identical ranges return 0, overlapping ranges return 1.  */
+
+      /* Return zero if we refer to the same full arrays.  */
+      if (expr1->ref->type == REF_ARRAY
+	  && expr2->ref->type == REF_ARRAY
+	  && expr1->ref->u.ar.type == AR_FULL
+	  && expr2->ref->u.ar.type == AR_FULL
+	  && !expr1->ref->next
+	  && !expr2->ref->next)
+	return 0;
+
       return 1;
 
     case EXPR_FUNCTION:
+      if (expr2->inline_noncopying_intrinsic)
+	identical = 1;
       /* Remember possible differences between elemental and
          transformational functions.  All functions inside a FORALL
          will be pure.  */
@@ -404,7 +413,7 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
 	{
 	  if (!actual->expr)
 	    continue;
-	  n = gfc_check_dependency (expr1, actual->expr, vars, nvars);
+	  n = gfc_check_dependency (expr1, actual->expr, identical);
 	  if (n)
 	    return n;
 	}
diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h
index 719f444a8ca..98629583fbf 100644
--- a/gcc/fortran/dependency.h
+++ b/gcc/fortran/dependency.h
@@ -25,7 +25,7 @@ bool gfc_ref_needs_temporary_p (gfc_ref *);
 gfc_expr *gfc_get_noncopying_intrinsic_argument (gfc_expr *);
 int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
 				 gfc_actual_arglist *);
-int gfc_check_dependency (gfc_expr *, gfc_expr *, gfc_expr **, int);
+int gfc_check_dependency (gfc_expr *, gfc_expr *, bool);
 int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int);
 int gfc_expr_is_one (gfc_expr *, int);
 
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 8c03ab1e313..ef3d0265187 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -115,9 +115,6 @@ tree gfc_conv_descriptor_stride (tree, tree);
 tree gfc_conv_descriptor_lbound (tree, tree);
 tree gfc_conv_descriptor_ubound (tree, tree);
 
-/* Dependency checking for WHERE and FORALL.  */
-int gfc_check_dependency (gfc_expr *, gfc_expr *, gfc_expr **, int);
-
 /* Add pre-loop scalarization code for intrinsic functions which require
    special handling.  */
 void gfc_add_intrinsic_ss_code (gfc_loopinfo *, gfc_ss *);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index eec00e62040..b44774eb19f 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -37,6 +37,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "trans-array.h"
 #include "trans-const.h"
 #include "arith.h"
+#include "dependency.h"
 
 typedef struct iter_info
 {
@@ -2503,7 +2504,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
 	{
 	case EXEC_ASSIGN:
           /* A scalar or array assignment.  */
-	  need_temp = gfc_check_dependency (c->expr, c->expr2, varexpr, nvar);
+	  need_temp = gfc_check_dependency (c->expr, c->expr2, 0);
           /* Temporaries due to array assignment data dependencies introduce
              no end of problems.  */
 	  if (need_temp)
@@ -2546,7 +2547,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
 
         /* Pointer assignment inside FORALL.  */
 	case EXEC_POINTER_ASSIGN:
-          need_temp = gfc_check_dependency (c->expr, c->expr2, varexpr, nvar);
+          need_temp = gfc_check_dependency (c->expr, c->expr2, 0);
           if (need_temp)
             gfc_trans_pointer_assign_need_temp (c->expr, c->expr2,
                                                 nested_forall_info, &block);
@@ -3062,14 +3063,7 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask,
               expr2 = cnext->expr2;
               if (nested_forall_info != NULL)
                 {
-                  int nvar;
-                  gfc_expr **varexpr;
-
-                  nvar = nested_forall_info->nvar;
-                  varexpr = (gfc_expr **)
-                            gfc_getmem (nvar * sizeof (gfc_expr *));
-                  need_temp = gfc_check_dependency (expr1, expr2, varexpr,
-                                                    nvar);
+                  need_temp = gfc_check_dependency (expr1, expr2, 0);
                   if (need_temp)
                     gfc_trans_assign_need_temp (expr1, expr2, mask,
                                                 nested_forall_info, block);
@@ -3124,6 +3118,137 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask,
   }
 }
 
+/* Translate a simple WHERE construct or statement without dependencies.
+   CBLOCK is the "then" clause of the WHERE statement, where CBLOCK->EXPR
+   is the mask condition, and EBLOCK if non-NULL is the "else" clause.
+   Currently both CBLOCK and EBLOCK are restricted to single assignments.  */
+
+static tree
+gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
+{
+  stmtblock_t block, body;
+  gfc_expr *cond, *tdst, *tsrc, *edst, *esrc;
+  tree tmp, cexpr, tstmt, estmt;
+  gfc_ss *css, *tdss, *tsss;
+  gfc_se cse, tdse, tsse, edse, esse;
+  gfc_loopinfo loop;
+  gfc_ss *edss = 0;
+  gfc_ss *esss = 0;
+
+  cond = cblock->expr;
+  tdst = cblock->next->expr;
+  tsrc = cblock->next->expr2;
+  edst = eblock ? eblock->next->expr : NULL;
+  esrc = eblock ? eblock->next->expr2 : NULL;
+
+  gfc_start_block (&block);
+  gfc_init_loopinfo (&loop);
+
+  /* Handle the condition.  */
+  gfc_init_se (&cse, NULL);
+  css = gfc_walk_expr (cond);
+  gfc_add_ss_to_loop (&loop, css);
+
+  /* Handle the then-clause.  */
+  gfc_init_se (&tdse, NULL);
+  gfc_init_se (&tsse, NULL);
+  tdss = gfc_walk_expr (tdst);
+  tsss = gfc_walk_expr (tsrc);
+  if (tsss == gfc_ss_terminator)
+    {
+      tsss = gfc_get_ss ();
+      tsss->next = gfc_ss_terminator;
+      tsss->type = GFC_SS_SCALAR;
+      tsss->expr = tsrc;
+    }
+  gfc_add_ss_to_loop (&loop, tdss);
+  gfc_add_ss_to_loop (&loop, tsss);
+
+  if (eblock)
+    {
+      /* Handle the else clause.  */
+      gfc_init_se (&edse, NULL);
+      gfc_init_se (&esse, NULL);
+      edss = gfc_walk_expr (edst);
+      esss = gfc_walk_expr (esrc);
+      if (esss == gfc_ss_terminator)
+	{
+	  esss = gfc_get_ss ();
+	  esss->next = gfc_ss_terminator;
+	  esss->type = GFC_SS_SCALAR;
+	  esss->expr = esrc;
+	}
+      gfc_add_ss_to_loop (&loop, edss);
+      gfc_add_ss_to_loop (&loop, esss);
+    }
+
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop);
+
+  gfc_mark_ss_chain_used (css, 1);
+  gfc_mark_ss_chain_used (tdss, 1);
+  gfc_mark_ss_chain_used (tsss, 1);
+  if (eblock)
+    {
+      gfc_mark_ss_chain_used (edss, 1);
+      gfc_mark_ss_chain_used (esss, 1);
+    }
+
+  gfc_start_scalarized_body (&loop, &body);
+
+  gfc_copy_loopinfo_to_se (&cse, &loop);
+  gfc_copy_loopinfo_to_se (&tdse, &loop);
+  gfc_copy_loopinfo_to_se (&tsse, &loop);
+  cse.ss = css;
+  tdse.ss = tdss;
+  tsse.ss = tsss;
+  if (eblock)
+    {
+      gfc_copy_loopinfo_to_se (&edse, &loop);
+      gfc_copy_loopinfo_to_se (&esse, &loop);
+      edse.ss = edss;
+      esse.ss = esss;
+    }
+
+  gfc_conv_expr (&cse, cond);
+  gfc_add_block_to_block (&body, &cse.pre);
+  cexpr = cse.expr;
+
+  gfc_conv_expr (&tsse, tsrc);
+  if (tdss != gfc_ss_terminator && loop.temp_ss != NULL)
+    {
+      gfc_conv_tmp_array_ref (&tdse);
+      gfc_advance_se_ss_chain (&tdse);
+    }
+  else
+    gfc_conv_expr (&tdse, tdst);
+
+  if (eblock)
+    {
+      gfc_conv_expr (&esse, esrc);
+      if (edss != gfc_ss_terminator && loop.temp_ss != NULL)
+        {
+          gfc_conv_tmp_array_ref (&edse);
+          gfc_advance_se_ss_chain (&edse);
+        }
+      else
+        gfc_conv_expr (&edse, edst);
+    }
+
+  tstmt = gfc_trans_scalar_assign (&tdse, &tsse, tdst->ts.type);
+  estmt = eblock ? gfc_trans_scalar_assign (&edse, &esse, edst->ts.type)
+		 : build_empty_stmt ();
+  tmp = build3_v (COND_EXPR, cexpr, tstmt, estmt);
+  gfc_add_expr_to_block (&body, tmp);
+  gfc_add_block_to_block (&body, &cse.post);
+
+  gfc_trans_scalarizing_loops (&loop, &body);
+  gfc_add_block_to_block (&block, &loop.pre);
+  gfc_add_block_to_block (&block, &loop.post);
+  gfc_cleanup_loop (&loop);
+
+  return gfc_finish_block (&block);
+}
 
 /* As the WHERE or WHERE construct statement can be nested, we call
    gfc_trans_where_2 to do the translation, and pass the initial
@@ -3134,9 +3259,55 @@ gfc_trans_where (gfc_code * code)
 {
   stmtblock_t block;
   temporary_list *temp, *p;
+  gfc_code *cblock;
+  gfc_code *eblock;
   tree args;
   tree tmp;
 
+  cblock = code->block;
+  if (cblock->next
+      && cblock->next->op == EXEC_ASSIGN
+      && !cblock->next->next)
+    {
+      eblock = cblock->block;
+      if (!eblock)
+	{
+          /* A simple "WHERE (cond) x = y" statement or block is
+	     dependence free if cond is not dependent upon writing x,
+	     and the source y is unaffected by the destination x.  */
+	  if (!gfc_check_dependency (cblock->next->expr,
+				     cblock->expr, 0)
+	      && !gfc_check_dependency (cblock->next->expr,
+					cblock->next->expr2, 0))
+	    return gfc_trans_where_3 (cblock, NULL);
+	}
+      else if (!eblock->expr
+	       && !eblock->block
+	       && eblock->next
+	       && eblock->next->op == EXEC_ASSIGN
+	       && !eblock->next->next)
+	{
+          /* A simple "WHERE (cond) x1 = y1 ELSEWHERE x2 = y2 ENDWHERE"
+	     block is dependence free if cond is not dependent on writes
+	     to x1 and x2, y1 is not dependent on writes to x2, and y2
+	     is not dependent on writes to x1, and both y's are not
+	     dependent upon their own x's.  */
+	  if (!gfc_check_dependency(cblock->next->expr,
+				    cblock->expr, 0)
+	      && !gfc_check_dependency(eblock->next->expr,
+				       cblock->expr, 0)
+	      && !gfc_check_dependency(cblock->next->expr,
+				       eblock->next->expr2, 0)
+	      && !gfc_check_dependency(eblock->next->expr,
+				       cblock->next->expr2, 0)
+	      && !gfc_check_dependency(cblock->next->expr,
+				       cblock->next->expr2, 0)
+	      && !gfc_check_dependency(eblock->next->expr,
+				       eblock->next->expr2, 0))
+	    return gfc_trans_where_3 (cblock, eblock);
+	}
+    }
+
   gfc_start_block (&block);
   temp = NULL;