From 06a103af0e61d634e1fa730a1865eb4e98748e72 Mon Sep 17 00:00:00 2001 From: Roger Sayle Date: Thu, 6 Apr 2006 02:08:27 +0000 Subject: [PATCH] dependency.c (get_no_elements): Delete function. * 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. From-SVN: r112731 --- gcc/fortran/ChangeLog | 17 +- gcc/fortran/dependency.c | 254 ++++++++++---------- gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gfortran.dg/dependency_18.f90 | 20 ++ 4 files changed, 167 insertions(+), 128 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/dependency_18.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0fbcc75be690..e6db2efe197a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2006-04-05 Roger Sayle + + * 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 PR fortran/25619 @@ -11,15 +18,15 @@ 2006-04-03 Paul Thomas 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 @@ -64,7 +71,7 @@ 2006-03-31 Asher Langton 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 Bud Davis @@ -90,7 +97,7 @@ 2006-03-28 Paul Thomas 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 diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index f664ec0d0f89..4634c1fd37ce 100644 --- 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 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_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; + 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; @@ -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]; - 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; + /* 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 - dep = get_deps (X1, X2, no_of_elements); + l_dir = -2; - mpz_clear (no_of_elements); - mpz_clear (X1); - mpz_clear (X2); - return dep; + /* 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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d21f41cc0113..a9fa5b057d32 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2006-04-05 Roger Sayle + + * gfortran.dg/dependency_18.f90: New test case. + 2006-04-05 Richard Guenther 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 index 000000000000..cb0799d1fab9 --- /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" } }