diff mbox

[fortran] Follow references in dependency checking

Message ID 1280700611.3631.17.camel@linux-fd1f.site
State New
Headers show

Commit Message

Thomas Koenig Aug. 1, 2010, 10:10 p.m. UTC 
Tobias Burnus wrote:

Thanks a lot for your comments!

> Thomas Koenig write:
> > here's a patch which improves dependency checking.  Both substring and
> > array references are followed with this, so we can also avoid using
> > temporaries for array expressions like
> >
> >     a(i(1):i(2)) = a(i(1):i(2)) + b(i(1):i(2))
> >     a(c%i:c%j) = a(c%i:c%j) + b(c%k:c%m)
> >
> > String references are also handled, so expressions like
> > c(1:2) == c(1:2) can now be removed.  See the test cases.
> >
> > Regression-tested on x86_64-unknown-linux-gnu.  OK for trunk?
> >   
> 
> @@ -402,10 +403,9 @@ optimize_equality (gfc_expr *e, bool equal)
>       TODO: Handle cases with identical refs.  */
> 
> 
> That's obsolete. Can you replace it by a note that the ts !=
> REAL/COMPLEX check is to allow forf NAN checks?

Done.

> 
> +  if (l_start == NULL)
> +    {
> +      if (r_start == NULL || gfc_expr_is_one (r_start, 0))
> +	goto end_check;
> +    }
> +  else if (r_start == NULL)
> +    {
> +      if (gfc_expr_is_one (l_start, 0))
> +	goto end_check;
> +    }
> +  else if (gfc_dep_compare_expr (l_start, r_start) != 0)
> +    return false;
> +
> + end_check:
> 
> 
> The inner "if"s do not make sense. If the inner condition is true, one
> jumps to "end_check"; if it is false, one falls through to "end_check".

This was also wrong.  Thanks for catching this!

Fortunately, it turns out that I don't need to bother with all the NULL
checks, that is taken care of before.  I've removed that function again.
This would also have introduced some regressions, for which I have added
an additional test case (which makes sure that comparisons are still
used for some things).


> +  while ((numref = (r1 != NULL) + (r2 != NULL)) > 0)
> +    {
> +
> +
> That's ugly. Can't you simply use the following?

Changed to something more becoming.  You were right that this was
ugly :-)

Currently regtesting.  OK if this passes?

	Thomas

2010-08-01  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/36854
	* dependency.h:  Add prototype for gfc_are_identical_variables.
	* frontend-passes.c:  Include depencency.h.
	(optimimize_equality):  Use gfc_are_identical_variables.
	* dependency.c (identical_array_ref): New function.
	(gfc_are_identical_variables):  New function.
	(gfc_deb_compare_expr):  Use gfc_are_identical_variables.
	* dependency.c (gfc_check_section_vs_section).  Rename gfc_
	prefix from statc function.
	(check_section_vs_section): Change arguments to gfc_array_ref,
	adjust function body accordingly.

2010-08-01  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/36854
	* gfortran.dg/character_comparison_2.f90:  New test.
	* gfortran.dg/character_comparison_3.f90:  New test.
	* gfortran.dg/dependency_28.f90:  New test.
diff mbox

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 162585)
+++ frontend-passes.c	(Arbeitskopie)
@@ -23,6 +23,7 @@  along with GCC; see the file COPYING3.  If not see
 #include "gfortran.h"
 #include "arith.h"
 #include "flags.h"
+#include "dependency.h"
 
 /* Forward declarations.  */
 
@@ -398,14 +399,13 @@  optimize_equality (gfc_expr *e, bool equal)
       return true;
     }
 
-  /* Check for direct comparison between identical variables.
-     TODO: Handle cases with identical refs.  */
+  /* Check for direct comparison between identical variables.  Don't compare
+     REAL or COMPLEX because of NaN checks.  */
   if (op1->expr_type == EXPR_VARIABLE
       && op2->expr_type == EXPR_VARIABLE
-      && op1->symtree == op2->symtree
-      && op1->ref == NULL && op2->ref == NULL
       && op1->ts.type != BT_REAL && op2->ts.type != BT_REAL
-      && op1->ts.type != BT_COMPLEX && op2->ts.type !=BT_COMPLEX)
+      && op1->ts.type != BT_COMPLEX && op2->ts.type !=BT_COMPLEX
+      && gfc_are_identical_variables (op1, op2))
     {
       /* Replace the expression by a constant expression.  The typespec
 	 and where remains the way it is.  */
Index: dependency.c
===================================================================
--- dependency.c	(Revision 162585)
+++ dependency.c	(Arbeitskopie)
@@ -49,7 +49,11 @@  gfc_dependency;
 /* Macros */
 #define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
 
+/* Forward declarations */
 
+static gfc_dependency check_section_vs_section (gfc_array_ref *,
+						gfc_array_ref *, int);
+
 /* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
    def if the value could not be determined.  */
 
@@ -67,7 +71,111 @@  gfc_expr_is_one (gfc_expr *expr, int def)
   return mpz_cmp_si (expr->value.integer, 1) == 0;
 }
 
+/* Check if two array references are known to be identical.  Calls
+   gfc_dep_compare_expr if necessary for comparing array indices.  */
 
+static bool
+identical_array_ref (gfc_array_ref *a1, gfc_array_ref *a2)
+{
+  int i;
+
+  if (a1->type == AR_FULL && a2->type == AR_FULL)
+    return true;
+
+  if (a1->type == AR_SECTION && a2->type == AR_SECTION)
+    {
+      gcc_assert (a1->dimen == a2->dimen);
+
+      for ( i = 0; i < a1->dimen; i++)
+	{
+	  /* TODO: Currently, we punt on an integer array as an index.  */
+	  if (a1->dimen_type[i] != DIMEN_RANGE
+	      || a2->dimen_type[i] != DIMEN_RANGE)
+	    return false;
+
+	  if (check_section_vs_section (a1, a2, i) != GFC_DEP_EQUAL)
+	    return false;
+	}
+      return true;
+    }
+
+  if (a1->type == AR_ELEMENT && a2->type == AR_ELEMENT)
+    {
+      gcc_assert (a1->dimen == a2->dimen);
+      for (i = 0; i < a1->dimen; i++)
+	{
+	  if (gfc_dep_compare_expr (a1->start[i], a2->start[i]) != 0)
+	    return false;
+	}
+      return true;
+    }
+  return false;
+}
+
+
+
+/* Return true for identical variables, checking for references if
+   necessary.  Calls identical_array_ref for checking array sections.  */
+
+bool
+gfc_are_identical_variables (gfc_expr *e1, gfc_expr *e2)
+{
+  gfc_ref *r1, *r2;
+
+  if (e1->symtree->n.sym != e2->symtree->n.sym)
+    return false;
+
+  r1 = e1->ref;
+  r2 = e2->ref;
+
+  /* numref is
+     0 if ar and br both are null pointers
+     1 if exactly one of them is a null pointer
+     2 if both of them are non-null.  */
+
+  while (r1 != NULL || r2 != NULL)
+    {
+
+      /* Assume the variables are not equal if one has a reference and the
+	 other doesn't.
+	 TODO: Handle full references like comparing a(:) to a.
+      */
+
+      if (r1 == NULL || r2 == NULL)
+	return false;
+
+      if (r1->type != r2->type)
+	return false;
+
+      switch (r1->type)
+	{
+
+	case REF_ARRAY:
+	  if (!identical_array_ref (&r1->u.ar,  &r2->u.ar))
+	    return false;
+
+	  break;
+
+	case REF_COMPONENT:
+	  if (r1->u.c.component != r2->u.c.component)
+	    return false;
+	  break;
+
+	case REF_SUBSTRING:
+	  if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start) != 0
+	      || gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end) != 0)
+	    return false;
+	  break;
+
+	default:
+	  gfc_internal_error ("gfc_are_identical_variables: Bad type");
+	}
+      r1 = r1->next;
+      r2 = r2->next;
+    }
+  return true;
+}
+
 /* Compare two values.  Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
    and -2 if the relationship could not be determined.  */
 
@@ -191,11 +299,10 @@  gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       return 1;
 
     case EXPR_VARIABLE:
-      if (e1->ref || e2->ref)
+      if (gfc_are_identical_variables (e1, e2))
+	return 0;
+      else
 	return -2;
-      if (e1->symtree->n.sym == e2->symtree->n.sym)
-	return 0;
-      return -2;
 
     case EXPR_OP:
       /* Intrinsic operators are the same if their operands are the same.  */
@@ -882,9 +989,8 @@  gfc_check_dependency (gfc_expr *expr1, gfc_expr *e
 /* Determines overlapping for two array sections.  */
 
 static gfc_dependency
-gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n)
+check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
 {
-  gfc_array_ref l_ar;
   gfc_expr *l_start;
   gfc_expr *l_end;
   gfc_expr *l_stride;
@@ -892,7 +998,6 @@  static gfc_dependency
   gfc_expr *l_upper;
   int l_dir;
 
-  gfc_array_ref r_ar;
   gfc_expr *r_start;
   gfc_expr *r_end;
   gfc_expr *r_stride;
@@ -900,34 +1005,31 @@  static gfc_dependency
   gfc_expr *r_upper;
   int r_dir;
 
-  l_ar = lref->u.ar;
-  r_ar = rref->u.ar;
-  
   /* If they are the same range, return without more ado.  */
-  if (gfc_is_same_range (&l_ar, &r_ar, n, 0))
+  if (gfc_is_same_range (l_ar, r_ar, n, 0))
     return GFC_DEP_EQUAL;
 
-  l_start = l_ar.start[n];
-  l_end = l_ar.end[n];
-  l_stride = l_ar.stride[n];
+  l_start = l_ar->start[n];
+  l_end = l_ar->end[n];
+  l_stride = l_ar->stride[n];
 
-  r_start = r_ar.start[n];
-  r_end = r_ar.end[n];
-  r_stride = r_ar.stride[n];
+  r_start = r_ar->start[n];
+  r_end = r_ar->end[n];
+  r_stride = r_ar->stride[n];
 
   /* If l_start is NULL take it from array specifier.  */
-  if (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar.as))
-    l_start = l_ar.as->lower[n];
+  if (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar->as))
+    l_start = l_ar->as->lower[n];
   /* If l_end is NULL take it from array specifier.  */
-  if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar.as))
-    l_end = l_ar.as->upper[n];
+  if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar->as))
+    l_end = l_ar->as->upper[n];
 
   /* If r_start is NULL take it from array specifier.  */
-  if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar.as))
-    r_start = r_ar.as->lower[n];
+  if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar->as))
+    r_start = r_ar->as->lower[n];
   /* If r_end is NULL take it from array specifier.  */
-  if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as))
-    r_end = r_ar.as->upper[n];
+  if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar->as))
+    r_end = r_ar->as->upper[n];
 
   /* Determine whether the l_stride is positive or negative.  */
   if (!l_stride)
@@ -1574,7 +1676,7 @@  gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gf
 
 	      if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
 		  && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
-		this_dep = gfc_check_section_vs_section (lref, rref, n);
+		this_dep = check_section_vs_section (&lref->u.ar, &rref->u.ar, n);
 	      else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
 		       && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
 		this_dep = gfc_check_element_vs_section (lref, rref, n);
Index: dependency.h
===================================================================
--- dependency.h	(Revision 162585)
+++ dependency.h	(Arbeitskopie)
@@ -43,3 +43,5 @@  int gfc_expr_is_one (gfc_expr *, int);
 int gfc_dep_resolver(gfc_ref *, gfc_ref *, gfc_reverse *);
 int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
 
+bool gfc_are_identical_variables (gfc_expr *, gfc_expr *);
+