[Fortran] Rewrite section vs. section dependency analysis

[Roger Sayle <roger at eyesopen dot com>]

This is the final installment in this round of dependency.c
improvements.  Previously, we'd improved gfc_dep_compare_expr,
element vs. element, and element vs. section, whilst this final
piece overhauls the current section vs. section implementation.

Previously, the code in gfc_check_section_vs_section could only
handle simple overlap-style dependency tests on sections where
the start, end and strides are all compile-time integer constants.
The code below improves upon this by allowing symbolic range
bounds testing.  To demonstrate the improvement, of the six
assignments in the new test case below, gfortran would previously
assume dependencies in the final four.

The restructuring of the code below also simplifies the task of
implementing more complex dependency analysis when the ranges
overlap (GCD test, Banerjee test, delta test, omega test, etc..).
I've no immediate plans but I suspect the way forward will be
to convert the GMP mpz_t into INTEGER_CSTs (if they fit) then
construct a POLYNOMIAL_CHREC tree node for each fortran array
section and pass them to the middle-end's SCEV infrastructure
(possibly after the omega library is integrated into the tree).
This would allow us to handle things like a(1:5:2) = a(2:6:2).

The problem in general is NP-complete, but the implementation
below is sufficient to catch more low hanging fruit, such as
several of the false array assignment dependencies detected in
the polyhedron benchmarks.


I'm personally happy with our ability to now resolve assignments
such as the following from Polyhedron's capacita.f90, where, for
example, the NAG fortran compiler requires a temporary.

   t(Ng1:2*Ng1-1,:) = t(Ng1:1:-1,:)  ! Remaining half, using symmetry


The patch below has been tested on x86_64-unknown-linux-gnu with
a full "make bootstrap", including fortran, and regression tested
with a top-level "make -k check" with no new failures.


Ok for mainline?



2006-04-04  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.

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


Index: dependency.c
===================================================================
*** dependency.c	(revision 112607)
--- dependency.c	(working copy)
*************** gfc_check_dependency (gfc_expr * expr1,
*** 702,819 ****
  }


- /* 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_expr *l_start;
    gfc_expr *l_end;
    gfc_expr *l_stride;

    gfc_expr *r_start;
    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;

    l_ar = lref->u.ar;
    r_ar = rref->u.ar;
--- 702,727 ----
  }


  /* 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_expr *r_lower;
!   gfc_expr *r_upper;
!   int r_dir;

    l_ar = lref->u.ar;
    r_ar = rref->u.ar;
*************** gfc_check_section_vs_section (gfc_ref *
*** 825,860 ****
    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_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 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))
      r_start = r_ar.as->lower[n];

!   mpz_init (X1);
!   mpz_init (X2);
!   mpz_init (no_of_elements);
!
!   if (transform_sections (X1, X2, no_of_elements,
! 			  l_start, l_end, l_stride,
! 			  r_start, r_stride))
!     dep = GFC_DEP_OVERLAP;
    else
!     dep =  get_deps (X1, X2, no_of_elements);

!   mpz_clear (no_of_elements);
!   mpz_clear (X1);
!   mpz_clear (X2);
!   return dep;
  }


--- 733,868 ----
    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))
      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 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;

!   /* 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;
!     }
!
!   /* 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
!     {
!       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;
!     }

!   /* 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;
  }



! { 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" } }


Roger
--