* dependency.c (get_no_elements): Delete function.

	(get_deps): Delete function.
	(transform_sections): Delete function.
	(gfc_check_section_vs_section): Significant rewrite.

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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0fbcc75..e6db2ef 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2006-04-05  Roger Sayle  <roger@eyesopen.com>
+
+       * dependency.c (get_no_elements): Delete function.
+       (get_deps): Delete function.
+       (transform_sections): Delete function.
+       (gfc_check_section_vs_section): Significant rewrite.
+
 2006-04-04  H.J. Lu  <hongjiu.lu@intel.com>
 
        PR fortran/25619
@@ -11,15 +18,15 @@
 2006-04-03  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/26891
-       * trans.h : Prototype for gfc_conv_missing_dummy.
+       * trans.h: Prototype for gfc_conv_missing_dummy.
        * trans-expr (gfc_conv_missing_dummy): New function
        (gfc_conv_function_call): Call it and tidy up some of the code.
        * trans-intrinsic (gfc_conv_intrinsic_function_args): The same.
 
        PR fortran/26976
        * array.c (gfc_array_dimen_size): If available, return shape[dimen].
-       * resolve.c (resolve_function): If available, use the argument shape for the
-       function expression.
+       * resolve.c (resolve_function): If available, use the argument
+       shape for the function expression.
        * iresolve.c (gfc_resolve_transfer): Set shape[0] = size.
 
 2006-04-02  Erik Edelmann  <eedelman@gcc.gnu.org>
@@ -64,7 +71,7 @@
 2006-03-31  Asher Langton  <langton2@llnl.gov>
 
        PR fortran/25358
-       *expr.c (gfc_check_assign): Allow cray pointee to be assumes-size.
+       * expr.c (gfc_check_assign): Allow cray pointee to be assumes-size.
        
 2006-03-30  Paul Thomas <paulthomas2@wanadoo.fr>
             Bud Davis  <bdavis9659@sbcglobal.net>
@@ -90,7 +97,7 @@
 2006-03-28 Paul Thomas <pault@gcc.gnu.org>
 
        PR fortran/26779
-       *resolve.c (resolve_fl_procedure): Do not check the access of
+       * resolve.c (resolve_fl_procedure): Do not check the access of
        derived types for internal procedures.
 
 2006-03-27  Jakub Jelinek  <jakub@redhat.com>

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index f664ec0..4634c1f 100644 (file)
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -1,5 +1,5 @@
 /* Dependency analysis
-   Copyright (C) 2000, 2001, 2002, 2005 Free Software Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2005, 2006 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
 This file is part of GCC.
@@ -702,118 +702,26 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
 }
 
 
-/* Calculates size of the array reference using lower bound, upper bound
-   and stride.  */
-
-static void
-get_no_of_elements(mpz_t ele, gfc_expr * u1, gfc_expr * l1, gfc_expr * s1)
-{
-  /* nNoOfEle = (u1-l1)/s1  */
-
-  mpz_sub (ele, u1->value.integer, l1->value.integer);
-
-  if (s1 != NULL)
-    mpz_tdiv_q (ele, ele, s1->value.integer);
-}
-
-
-/* Returns if the ranges ((0..Y), (X1..X2))  overlap.  */
-
-static gfc_dependency
-get_deps (mpz_t x1, mpz_t x2, mpz_t y)
-{
-  int start;
-  int end;
-
-  start = mpz_cmp_ui (x1, 0);
-  end = mpz_cmp (x2, y);
-  
-  /* Both ranges the same.  */
-  if (start == 0 && end == 0)
-    return GFC_DEP_EQUAL;
-
-  /* Distinct ranges.  */
-  if ((start < 0 && mpz_cmp_ui (x2, 0) < 0)
-      || (mpz_cmp (x1, y) > 0 && end > 0))
-    return GFC_DEP_NODEP;
-
-  /* Overlapping, but with corresponding elements of the second range
-     greater than the first.  */
-  if (start > 0 && end > 0)
-    return GFC_DEP_FORWARD;
-
-  /* Overlapping in some other way.  */
-  return GFC_DEP_OVERLAP;
-}
-
-
-/* Perform the same linear transformation on sections l and r such that 
-   (l_start:l_end:l_stride) -> (0:no_of_elements)
-   (r_start:r_end:r_stride) -> (X1:X2)
-   Where r_end is implicit as both sections must have the same number of
-   elements.
-   Returns 0 on success, 1 of the transformation failed.  */
-/* TODO: Should this be (0:no_of_elements-1) */
-
-static int
-transform_sections (mpz_t X1, mpz_t X2, mpz_t no_of_elements,
-                   gfc_expr * l_start, gfc_expr * l_end, gfc_expr * l_stride,
-                   gfc_expr * r_start, gfc_expr * r_stride)
-{
-  if (NULL == l_start || NULL == l_end || NULL == r_start)
-    return 1;
-
-  /* TODO : Currently we check the dependency only when start, end and stride
-    are constant.  We could also check for equal (variable) values, and
-    common subexpressions, eg. x vs. x+1.  */
-
-  if (l_end->expr_type != EXPR_CONSTANT
-      || l_start->expr_type != EXPR_CONSTANT
-      || r_start->expr_type != EXPR_CONSTANT
-      || ((NULL != l_stride) && (l_stride->expr_type != EXPR_CONSTANT))
-      || ((NULL != r_stride) && (r_stride->expr_type != EXPR_CONSTANT)))
-    {
-       return 1;
-    }
-
-
-  get_no_of_elements (no_of_elements, l_end, l_start, l_stride);
-
-  mpz_sub (X1, r_start->value.integer, l_start->value.integer);
-  if (l_stride != NULL)
-    mpz_cdiv_q (X1, X1, l_stride->value.integer);
-  
-  if (r_stride == NULL)
-    mpz_set (X2, no_of_elements);
-  else
-    mpz_mul (X2, no_of_elements, r_stride->value.integer);
-
-  if (l_stride != NULL)
-    mpz_cdiv_q (X2, X2, l_stride->value.integer);
-  mpz_add (X2, X2, X1);
-
-  return 0;
-}
-  
-
 /* Determines overlapping for two array sections.  */
 
 static gfc_dependency
 gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
 {
+  gfc_array_ref l_ar;
   gfc_expr *l_start;
   gfc_expr *l_end;
   gfc_expr *l_stride;
+  gfc_expr *l_lower;
+  gfc_expr *l_upper;
+  int l_dir;
 
+  gfc_array_ref r_ar;
   gfc_expr *r_start;
+  gfc_expr *r_end;
   gfc_expr *r_stride;
-
-  gfc_array_ref l_ar;
-  gfc_array_ref r_ar;
-
-  mpz_t no_of_elements;
-  mpz_t X1, X2;
-  gfc_dependency dep;
+  gfc_expr *r_lower;
+  gfc_expr *r_upper;
+  int r_dir;
 
   l_ar = lref->u.ar;
   r_ar = rref->u.ar;
@@ -825,36 +733,136 @@ gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int 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];
 
-  /* if l_start is NULL take it from array specifier  */
-  if (NULL == l_start && IS_ARRAY_EXPLICIT(l_ar.as))
+  /* 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 l_end is NULL take it from array specifier  */
-  if (NULL == l_end && IS_ARRAY_EXPLICIT(l_ar.as))
+  /* 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 r_start is NULL take it from array specifier  */
-  if (NULL == r_start && IS_ARRAY_EXPLICIT(r_ar.as))
+  /* 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 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];
+
+  /* Determine whether the l_stride is positive or negative.  */
+  if (!l_stride)
+    l_dir = 1;
+  else if (l_stride->expr_type == EXPR_CONSTANT
+           && l_stride->ts.type == BT_INTEGER)
+    l_dir = mpz_sgn (l_stride->value.integer);
+  else if (l_start && l_end)
+    l_dir = gfc_dep_compare_expr (l_end, l_start);
+  else
+    l_dir = -2;
+
+  /* Determine whether the r_stride is positive or negative.  */
+  if (!r_stride)
+    r_dir = 1;
+  else if (r_stride->expr_type == EXPR_CONSTANT
+           && r_stride->ts.type == BT_INTEGER)
+    r_dir = mpz_sgn (r_stride->value.integer);
+  else if (r_start && r_end)
+    r_dir = gfc_dep_compare_expr (r_end, r_start);
+  else
+    r_dir = -2;
+
+  /* The strides should never be zero.  */
+  if (l_dir == 0 || r_dir == 0)
+    return GFC_DEP_OVERLAP;
 
-  mpz_init (X1);
-  mpz_init (X2);
-  mpz_init (no_of_elements);
+  /* Determine LHS upper and lower bounds.  */
+  if (l_dir == 1)
+    {
+      l_lower = l_start;
+      l_upper = l_end;
+    }
+  else if (l_dir == -1)
+    {
+      l_lower = l_end;
+      l_upper = l_start;
+    }
+  else
+    {
+      l_lower = NULL;
+      l_upper = NULL;
+    }
 
-  if (transform_sections (X1, X2, no_of_elements,
-                         l_start, l_end, l_stride,
-                         r_start, r_stride))
-    dep = GFC_DEP_OVERLAP;
+  /* Determine RHS upper and lower bounds.  */
+  if (r_dir == 1)
+    {
+      r_lower = r_start;
+      r_upper = r_end;
+    }
+  else if (r_dir == -1)
+    {
+      r_lower = r_end;
+      r_upper = r_start;
+    }
   else
-    dep =  get_deps (X1, X2, no_of_elements);
+    {
+      r_lower = NULL;
+      r_upper = NULL;
+    }
+
+  /* Check whether the ranges are disjoint.  */
+  if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1)
+    return GFC_DEP_NODEP;
+  if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1)
+    return GFC_DEP_NODEP;
+
+  /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL.  */
+  if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
+    {
+      if (l_dir == 1 && r_dir == -1)
+        return GFC_DEP_EQUAL;
+      if (l_dir == -1 && r_dir == 1)
+        return GFC_DEP_EQUAL;
+    }
 
-  mpz_clear (no_of_elements);
-  mpz_clear (X1);
-  mpz_clear (X2);
-  return dep;
+  /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL.  */
+  if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0)
+    {
+      if (l_dir == 1 && r_dir == -1)
+        return GFC_DEP_EQUAL;
+      if (l_dir == -1 && r_dir == 1)
+        return GFC_DEP_EQUAL;
+    }
+
+  /* Check for forward dependencies x:y vs. x+1:z.  */
+  if (l_dir == 1 && r_dir == 1
+      && l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == -1
+      && l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == -1)
+    {
+      /* Check that the strides are the same.  */
+      if (!l_stride && !r_stride)
+       return GFC_DEP_FORWARD;
+      if (l_stride && r_stride
+         && gfc_dep_compare_expr (l_stride, r_stride) == 0)
+       return GFC_DEP_FORWARD;
+    }
+
+  /* Check for forward dependencies x:y:-1 vs. x-1:z:-1.  */
+  if (l_dir == -1 && r_dir == -1
+      && l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 1
+      && l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 1)
+    {
+      /* Check that the strides are the same.  */
+      if (!l_stride && !r_stride)
+       return GFC_DEP_FORWARD;
+      if (l_stride && r_stride
+         && gfc_dep_compare_expr (l_stride, r_stride) == 0)
+       return GFC_DEP_FORWARD;
+    }
+
+  return GFC_DEP_OVERLAP;
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d21f41c..a9fa5b0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2006-04-05  Roger Sayle  <roger@eyesopen.com>
+
+       * gfortran.dg/dependency_18.f90: New test case.
+
 2006-04-05  Richard Guenther  <rguenther@suse.de>
 
        PR tree-optimization/26919

diff --git a/gcc/testsuite/gfortran.dg/dependency_18.f90 b/gcc/testsuite/gfortran.dg/dependency_18.f90
new file mode 100644 (file)
index 0000000..cb0799d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_18.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i,j,k)
+  integer, dimension (10) :: a
+  integer :: i, j, k
+
+  a(1:5:2) = a(8:6:-1)
+
+  a(1:8) = a(2:9)
+
+  a(4:7) = a(4:1:-1)
+
+  a(i:i+2) = a(i+4:i+6)
+
+  a(j:1:-1) = a(j:5)
+
+  a(k:k+2) = a(k+1:k+3)
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }