Skip to content

R
riscv-gcc-1
Commit 06a103af by Roger Sayle
Options

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
parent 0f681872
Showing with 165 additions and 126 deletions
gcc/fortran/ChangeLog
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>
......
gcc/fortran/dependency.c
/* 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;
}
......
gcc/testsuite/ChangeLog
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
gcc/testsuite/gfortran.dg/dependency_18.f90 0 → 100644
! { 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" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment