bool
gfc_full_array_ref_p (gfc_ref *ref)
{
int i;
if (ref->type != REF_ARRAY)
return false;
if (ref->u.ar.type == AR_FULL)
return true;
if (ref->u.ar.type != AR_SECTION)
return false;
if (ref->next)
return false;
for (i = 0; i < ref->u.ar.dimen; i++)
{
/* Check the lower bound. */
if (ref->u.ar.start[i]
&& (!ref->u.ar.as
|| !ref->u.ar.as->lower[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
ref->u.ar.as->lower[i])))
return false;
/* Check the upper bound. */
if (ref->u.ar.end[i]
&& (!ref->u.ar.as
|| !ref->u.ar.as->upper[i]
|| gfc_dep_compare_expr (ref->u.ar.end[i],
ref->u.ar.as->upper[i])))
return false;
/* Check the stride. */
if (ref->u.ar.stride[i]
&& !gfc_expr_is_one (ref->u.ar.stride[i], 0))
return false;
}
return true;
}
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;
/* If they are the same range, return without more ado. */
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];
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;
}
/* Handle cases like x:y:2 vs. x+1:z:4 as GFC_DEP_NODEP.
There is no dependency if the remainder of
(l_start - r_start) / gcd(l_stride, r_stride) is
nonzero.
TODO:
- Handle cases where x is an expression.
- Cases like a(1:4:2) = a(2:3) are still not handled.
*/
#define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
&& (a)->ts.type == BT_INTEGER)
if (IS_CONSTANT_INTEGER(l_start) && IS_CONSTANT_INTEGER(r_start)
&& IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride))
{
mpz_t gcd, tmp;
int result;
mpz_init (gcd);
mpz_init (tmp);
mpz_gcd (gcd, l_stride->value.integer, r_stride->value.integer);
mpz_sub (tmp, l_start->value.integer, r_start->value.integer);
mpz_fdiv_r (tmp, tmp, gcd);
result = mpz_cmp_si (tmp, 0L);
mpz_clear (gcd);
mpz_clear (tmp);
if (result != 0)
return GFC_DEP_NODEP;
}
#undef IS_CONSTANT_INTEGER
/* 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;
}
/* Check for backward dependencies:
Are the strides the same?. */
if ((!l_stride && !r_stride)
||
(l_stride && r_stride
&& gfc_dep_compare_expr (l_stride, r_stride) == 0))
{
/* 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)
return GFC_DEP_BACKWARD;
/* 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)
return GFC_DEP_BACKWARD;
}
return GFC_DEP_OVERLAP;
}
int
gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
{
gfc_actual_arglist *args1;
gfc_actual_arglist *args2;
int i;
if (e1->expr_type == EXPR_OP
&& (e1->value.op.op == INTRINSIC_UPLUS
|| e1->value.op.op == INTRINSIC_PARENTHESES))
return gfc_dep_compare_expr (e1->value.op.op1, e2);
if (e2->expr_type == EXPR_OP
&& (e2->value.op.op == INTRINSIC_UPLUS
|| e2->value.op.op == INTRINSIC_PARENTHESES))
return gfc_dep_compare_expr (e1, e2->value.op.op1);
if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
{
/* Compare X+C vs. X. */
if (e1->value.op.op2->expr_type == EXPR_CONSTANT
&& e1->value.op.op2->ts.type == BT_INTEGER
&& gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
return mpz_sgn (e1->value.op.op2->value.integer);
/* Compare P+Q vs. R+S. */
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
{
int l, r;
l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
if (l == 0 && r == 0)
return 0;
if (l == 0 && r != -2)
return r;
if (l != -2 && r == 0)
return l;
if (l == 1 && r == 1)
return 1;
if (l == -1 && r == -1)
return -1;
l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2);
r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
if (l == 0 && r == 0)
return 0;
if (l == 0 && r != -2)
return r;
if (l != -2 && r == 0)
return l;
if (l == 1 && r == 1)
return 1;
if (l == -1 && r == -1)
return -1;
}
}
/* Compare X vs. X+C. */
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
{
if (e2->value.op.op2->expr_type == EXPR_CONSTANT
&& e2->value.op.op2->ts.type == BT_INTEGER
&& gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
return -mpz_sgn (e2->value.op.op2->value.integer);
}
/* Compare X-C vs. X. */
if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
{
if (e1->value.op.op2->expr_type == EXPR_CONSTANT
&& e1->value.op.op2->ts.type == BT_INTEGER
&& gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
return -mpz_sgn (e1->value.op.op2->value.integer);
/* Compare P-Q vs. R-S. */
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
{
int l, r;
l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
if (l == 0 && r == 0)
return 0;
if (l != -2 && r == 0)
return l;
if (l == 0 && r != -2)
return -r;
if (l == 1 && r == -1)
return 1;
if (l == -1 && r == 1)
return -1;
}
}
/* Compare X vs. X-C. */
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
{
if (e2->value.op.op2->expr_type == EXPR_CONSTANT
&& e2->value.op.op2->ts.type == BT_INTEGER
&& gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
return mpz_sgn (e2->value.op.op2->value.integer);
}
if (e1->expr_type != e2->expr_type)
return -2;
switch (e1->expr_type)
{
case EXPR_CONSTANT:
if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
return -2;
i = mpz_cmp (e1->value.integer, e2->value.integer);
if (i == 0)
return 0;
else if (i < 0)
return -1;
return 1;
case EXPR_VARIABLE:
if (e1->ref || e2->ref)
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. */
if (e1->value.op.op != e2->value.op.op)
return -2;
if (e1->value.op.op2 == 0)
{
i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
return i == 0 ? 0 : -2;
}
if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
&& gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
return 0;
/* TODO Handle commutative binary operators here? */
return -2;
case EXPR_FUNCTION:
/* We can only compare calls to the same intrinsic function. */
if (e1->value.function.isym == 0 || e2->value.function.isym == 0
|| e1->value.function.isym != e2->value.function.isym)
return -2;
args1 = e1->value.function.actual;
args2 = e2->value.function.actual;
/* We should list the "constant" intrinsic functions. Those
without side-effects that provide equal results given equal
argument lists. */
switch (e1->value.function.isym->id)
{
case GFC_ISYM_CONVERSION:
/* Handle integer extensions specially, as __convert_i4_i8
is not only "constant" but also "unary" and "increasing". */
if (args1 && !args1->next
&& args2 && !args2->next
&& e1->ts.type == BT_INTEGER
&& args1->expr->ts.type == BT_INTEGER
&& e1->ts.kind > args1->expr->ts.kind
&& e2->ts.type == e1->ts.type
&& e2->ts.kind == e1->ts.kind
&& args2->expr->ts.type == args1->expr->ts.type
&& args2->expr->ts.kind == args2->expr->ts.kind)
return gfc_dep_compare_expr (args1->expr, args2->expr);
break;
case GFC_ISYM_REAL:
case GFC_ISYM_LOGICAL:
case GFC_ISYM_DBLE:
break;
default:
return -2;
}
/* Compare the argument lists for equality. */
while (args1 && args2)
{
if (gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
return -2;
args1 = args1->next;
args2 = args2->next;
}
return (args1 || args2) ? -2 : 0;
default:
return -2;
}
}
int
gfc_is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n, int def)
{
gfc_expr *e1;
gfc_expr *e2;
int i;
/* TODO: More sophisticated range comparison. */
gcc_assert (ar1 && ar2);
gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
e1 = ar1->stride[n];
e2 = ar2->stride[n];
/* Check for mismatching strides. A NULL stride means a stride of 1. */
if (e1 && !e2)
{
i = gfc_expr_is_one (e1, -1);
if (i == -1)
return def;
else if (i == 0)
return 0;
}
else if (e2 && !e1)
{
i = gfc_expr_is_one (e2, -1);
if (i == -1)
return def;
else if (i == 0)
return 0;
}
else if (e1 && e2)
{
i = gfc_dep_compare_expr (e1, e2);
if (i == -2)
return def;
else if (i != 0)
return 0;
}
/* The strides match. */
/* Check the range start. */
e1 = ar1->start[n];
e2 = ar2->start[n];
if (e1 || e2)
{
/* Use the bound of the array if no bound is specified. */
if (ar1->as && !e1)
e1 = ar1->as->lower[n];
if (ar2->as && !e2)
e2 = ar2->as->lower[n];
/* Check we have values for both. */
if (!(e1 && e2))
return def;
i = gfc_dep_compare_expr (e1, e2);
if (i == -2)
return def;
else if (i != 0)
return 0;
}
/* Check the range end. */
e1 = ar1->end[n];
e2 = ar2->end[n];
if (e1 || e2)
{
/* Use the bound of the array if no bound is specified. */
if (ar1->as && !e1)
e1 = ar1->as->upper[n];
if (ar2->as && !e2)
e2 = ar2->as->upper[n];
/* Check we have values for both. */
if (!(e1 && e2))
return def;
i = gfc_dep_compare_expr (e1, e2);
if (i == -2)
return def;
else if (i != 0)
return 0;
}
return 1;
}
bool
gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
{
int i;
int n;
bool lbound_OK = true;
bool ubound_OK = true;
if (contiguous)
*contiguous = false;
if (ref->type != REF_ARRAY)
return false;
if (ref->u.ar.type == AR_FULL)
{
if (contiguous)
*contiguous = true;
return true;
}
if (ref->u.ar.type != AR_SECTION)
return false;
if (ref->next)
return false;
for (i = 0; i < ref->u.ar.dimen; i++)
{
/* If we have a single element in the reference, for the reference
to be full, we need to ascertain that the array has a single
element in this dimension and that we actually reference the
correct element. */
if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
{
/* This is unconditionally a contiguous reference if all the
remaining dimensions are elements. */
if (contiguous)
{
*contiguous = true;
for (n = i + 1; n < ref->u.ar.dimen; n++)
if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
*contiguous = false;
}
if (!ref->u.ar.as
|| !ref->u.ar.as->lower[i]
|| !ref->u.ar.as->upper[i]
|| gfc_dep_compare_expr (ref->u.ar.as->lower[i],
ref->u.ar.as->upper[i])
|| !ref->u.ar.start[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
ref->u.ar.as->lower[i]))
return false;
else
continue;
}
/* Check the lower bound. */
if (ref->u.ar.start[i]
&& (!ref->u.ar.as
|| !ref->u.ar.as->lower[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
ref->u.ar.as->lower[i])))
lbound_OK = false;
/* Check the upper bound. */
if (ref->u.ar.end[i]
&& (!ref->u.ar.as
|| !ref->u.ar.as->upper[i]
|| gfc_dep_compare_expr (ref->u.ar.end[i],
ref->u.ar.as->upper[i])))
ubound_OK = false;
/* Check the stride. */
if (ref->u.ar.stride[i]
&& !gfc_expr_is_one (ref->u.ar.stride[i], 0))
return false;
/* This is unconditionally a contiguous reference as long as all
the subsequent dimensions are elements. */
if (contiguous)
{
*contiguous = true;
for (n = i + 1; n < ref->u.ar.dimen; n++)
if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
*contiguous = false;
}
if (!lbound_OK || !ubound_OK)
return false;
}
return true;
}
static gfc_dependency
gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
{
gfc_array_ref *ref;
gfc_expr *elem;
gfc_expr *start;
gfc_expr *end;
gfc_expr *stride;
int s;
elem = lref->u.ar.start[n];
if (!elem)
return GFC_DEP_OVERLAP;
ref = &rref->u.ar;
start = ref->start[n] ;
end = ref->end[n] ;
stride = ref->stride[n];
if (!start && IS_ARRAY_EXPLICIT (ref->as))
start = ref->as->lower[n];
if (!end && IS_ARRAY_EXPLICIT (ref->as))
end = ref->as->upper[n];
/* Determine whether the stride is positive or negative. */
if (!stride)
s = 1;
else if (stride->expr_type == EXPR_CONSTANT
&& stride->ts.type == BT_INTEGER)
s = mpz_sgn (stride->value.integer);
else
s = -2;
/* Stride should never be zero. */
if (s == 0)
return GFC_DEP_OVERLAP;
/* Positive strides. */
if (s == 1)
{
/* Check for elem < lower. */
if (start && gfc_dep_compare_expr (elem, start) == -1)
return GFC_DEP_NODEP;
/* Check for elem > upper. */
if (end && gfc_dep_compare_expr (elem, end) == 1)
return GFC_DEP_NODEP;
if (start && end)
{
s = gfc_dep_compare_expr (start, end);
/* Check for an empty range. */
if (s == 1)
return GFC_DEP_NODEP;
if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
return GFC_DEP_EQUAL;
}
}
/* Negative strides. */
else if (s == -1)
{
/* Check for elem > upper. */
if (end && gfc_dep_compare_expr (elem, start) == 1)
return GFC_DEP_NODEP;
/* Check for elem < lower. */
if (start && gfc_dep_compare_expr (elem, end) == -1)
return GFC_DEP_NODEP;
if (start && end)
{
s = gfc_dep_compare_expr (start, end);
/* Check for an empty range. */
if (s == -1)
return GFC_DEP_NODEP;
if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
return GFC_DEP_EQUAL;
}
}
/* Unknown strides. */
else
{
if (!start || !end)
return GFC_DEP_OVERLAP;
s = gfc_dep_compare_expr (start, end);
if (s == -2)
return GFC_DEP_OVERLAP;
/* Assume positive stride. */
if (s == -1)
{
/* Check for elem < lower. */
if (gfc_dep_compare_expr (elem, start) == -1)
return GFC_DEP_NODEP;
/* Check for elem > upper. */
if (gfc_dep_compare_expr (elem, end) == 1)
return GFC_DEP_NODEP;
}
/* Assume negative stride. */
else if (s == 1)
{
/* Check for elem > upper. */
if (gfc_dep_compare_expr (elem, start) == 1)
return GFC_DEP_NODEP;
/* Check for elem < lower. */
if (gfc_dep_compare_expr (elem, end) == -1)
return GFC_DEP_NODEP;
}
/* Equal bounds. */
else if (s == 0)
{
s = gfc_dep_compare_expr (elem, start);
if (s == 0)
return GFC_DEP_EQUAL;
if (s == 1 || s == -1)
return GFC_DEP_NODEP;
}
}
return GFC_DEP_OVERLAP;
}
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;
/* If they are the same range, return without more ado. */
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];
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;
}
