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;
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;
}
static gfc_dependency
gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n)
{
gfc_array_ref l_ar;
gfc_array_ref r_ar;
gfc_expr *l_start;
gfc_expr *r_start;
gfc_expr *r_end;
l_ar = lref->u.ar;
r_ar = rref->u.ar;
l_start = l_ar.start[n] ;
r_start = r_ar.start[n] ;
r_end = r_ar.end[n] ;
if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar.as))
r_start = r_ar.as->lower[n];
if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as))
r_end = r_ar.as->upper[n];
if (NULL == r_start || NULL == r_end || l_start == NULL)
return GFC_DEP_OVERLAP;
return gfc_is_inside_range (l_start, r_end, r_start);
}
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;
}
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;
}
