#include "config.h"
#include "gfortran.h"
#include "dependency.h"
enum range {LHS, RHS, MID};
typedef enum
{
GFC_DEP_ERROR,
GFC_DEP_EQUAL,
GFC_DEP_FORWARD,
GFC_DEP_OVERLAP,
GFC_DEP_NODEP
}
gfc_dependency;
#define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
int
gfc_expr_is_one (gfc_expr * expr, int def)
{
gcc_assert (expr != NULL);
if (expr->expr_type != EXPR_CONSTANT)
return def;
if (expr->ts.type != BT_INTEGER)
return def;
return mpz_cmp_si (expr->value.integer, 1) == 0;
}
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.operator == INTRINSIC_UPLUS
|| e1->value.op.operator == INTRINSIC_PARENTHESES))
return gfc_dep_compare_expr (e1->value.op.op1, e2);
if (e2->expr_type == EXPR_OP
&& (e2->value.op.operator == INTRINSIC_UPLUS
|| e2->value.op.operator == INTRINSIC_PARENTHESES))
return gfc_dep_compare_expr (e1, e2->value.op.op1);
if (e1->expr_type == EXPR_OP
&& e1->value.op.operator == INTRINSIC_PLUS)
{
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);
if (e2->expr_type == EXPR_OP
&& e2->value.op.operator == 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;
}
}
if (e2->expr_type == EXPR_OP
&& e2->value.op.operator == 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);
}
if (e1->expr_type == EXPR_OP
&& e1->value.op.operator == 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);
if (e2->expr_type == EXPR_OP
&& e2->value.op.operator == 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;
}
}
if (e2->expr_type == EXPR_OP
&& e2->value.op.operator == 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:
if (e1->value.op.operator != e2->value.op.operator)
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;
return -2;
case EXPR_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;
switch (e1->value.function.isym->generic_id)
{
case GFC_ISYM_CONVERSION:
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;
}
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;
gcc_assert (ar1 && ar2);
gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
e1 = ar1->stride[n];
e2 = ar2->stride[n];
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;
}
e1 = ar1->start[n];
e2 = ar2->start[n];
if (e1 || e2)
{
if (ar1->as && !e1)
e1 = ar1->as->lower[n];
if (ar2->as && !e2)
e2 = ar2->as->lower[n];
if (!(e1 && e2))
return def;
i = gfc_dep_compare_expr (e1, e2);
if (i == -2)
return def;
else if (i != 0)
return 0;
}
e1 = ar1->end[n];
e2 = ar2->end[n];
if (e1 || e2)
{
if (ar1->as && !e1)
e1 = ar1->as->upper[n];
if (ar2->as && !e2)
e2 = ar2->as->upper[n];
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;
}
gfc_expr *
gfc_get_noncopying_intrinsic_argument (gfc_expr * expr)
{
if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
return NULL;
switch (expr->value.function.isym->generic_id)
{
case GFC_ISYM_TRANSPOSE:
return expr->value.function.actual->expr;
default:
return NULL;
}
}
bool
gfc_ref_needs_temporary_p (gfc_ref *ref)
{
int n;
bool subarray_p;
subarray_p = false;
for (; ref; ref = ref->next)
switch (ref->type)
{
case REF_ARRAY:
if (ref->u.ar.type == AR_SECTION)
for (n = 0; n < ref->u.ar.dimen; n++)
if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
return true;
subarray_p = true;
break;
case REF_SUBSTRING:
return subarray_p;
case REF_COMPONENT:
break;
}
return false;
}
static int
gfc_check_argument_var_dependency (gfc_expr * var, sym_intent intent,
gfc_expr * expr)
{
gcc_assert (var->expr_type == EXPR_VARIABLE);
gcc_assert (var->rank > 0);
switch (expr->expr_type)
{
case EXPR_VARIABLE:
return (gfc_ref_needs_temporary_p (expr->ref)
|| gfc_check_dependency (var, expr, 1));
case EXPR_ARRAY:
return gfc_check_dependency (var, expr, 1);
case EXPR_FUNCTION:
if (intent != INTENT_IN && expr->inline_noncopying_intrinsic)
{
expr = gfc_get_noncopying_intrinsic_argument (expr);
return gfc_check_argument_var_dependency (var, intent, expr);
}
return 0;
default:
return 0;
}
}
static int
gfc_check_argument_dependency (gfc_expr * other, sym_intent intent,
gfc_expr * expr)
{
switch (other->expr_type)
{
case EXPR_VARIABLE:
return gfc_check_argument_var_dependency (other, intent, expr);
case EXPR_FUNCTION:
if (other->inline_noncopying_intrinsic)
{
other = gfc_get_noncopying_intrinsic_argument (other);
return gfc_check_argument_dependency (other, INTENT_IN, expr);
}
return 0;
default:
return 0;
}
}
int
gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
gfc_symbol * fnsym, gfc_actual_arglist * actual)
{
gfc_formal_arglist *formal;
gfc_expr *expr;
formal = fnsym ? fnsym->formal : NULL;
for (; actual; actual = actual->next, formal = formal ? formal->next : NULL)
{
expr = actual->expr;
if (!expr)
continue;
if (expr == other)
continue;
if (formal
&& intent == INTENT_IN
&& formal->sym->attr.intent == INTENT_IN)
continue;
if (gfc_check_argument_dependency (other, intent, expr))
return 1;
}
return 0;
}
int
gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
{
gfc_equiv_list *l;
gfc_equiv_info *s, *fl1, *fl2;
gcc_assert (e1->expr_type == EXPR_VARIABLE
&& e2->expr_type == EXPR_VARIABLE);
if (!e1->symtree->n.sym->attr.in_equivalence
|| !e2->symtree->n.sym->attr.in_equivalence
|| !e1->rank
|| !e2->rank)
return 0;
for (l = gfc_current_ns->equiv_lists; l; l = l->next)
{
fl1 = NULL;
fl2 = NULL;
for (s = l->equiv; s; s = s->next)
{
if (s->sym == e1->symtree->n.sym)
{
fl1 = s;
if (fl2)
break;
}
if (s->sym == e2->symtree->n.sym)
{
fl2 = s;
if (fl1)
break;
}
}
if (s)
{
if (fl1->length <= 0 || fl2->length <= 0)
return 1;
if (fl1->offset + fl1->length > fl2->offset
&& fl2->offset + fl2->length > fl1->offset)
return 1;
}
}
return 0;
}
int
gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
{
gfc_ref *ref;
int n;
gfc_actual_arglist *actual;
gcc_assert (expr1->expr_type == EXPR_VARIABLE);
switch (expr2->expr_type)
{
case EXPR_OP:
n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
if (n)
return n;
if (expr2->value.op.op2)
return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
return 0;
case EXPR_VARIABLE:
if (expr1->symtree->n.sym != expr2->symtree->n.sym)
{
gfc_typespec *ts1 = &expr1->symtree->n.sym->ts;
gfc_typespec *ts2 = &expr2->symtree->n.sym->ts;
if (gfc_are_equivalenced_arrays (expr1, expr2))
return 1;
if (ts1->type != BT_UNKNOWN
&& ts2->type != BT_UNKNOWN
&& ts1->type != BT_DERIVED
&& ts2->type != BT_DERIVED)
{
if (ts1->type != ts2->type
|| ts1->kind != ts2->kind)
return 0;
}
if (expr1->symtree->n.sym->attr.pointer)
return 1;
for (ref = expr1->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
return 1;
if (expr2->symtree->n.sym->attr.pointer)
return 1;
for (ref = expr2->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
return 1;
return 0;
}
if (identical)
return 1;
if (expr1->ref->type == REF_ARRAY && expr2->ref->type == REF_ARRAY)
return gfc_dep_resolver (expr1->ref, expr2->ref);
return 1;
case EXPR_FUNCTION:
if (expr2->inline_noncopying_intrinsic)
identical = 1;
for (actual = expr2->value.function.actual;
actual; actual = actual->next)
{
if (!actual->expr)
continue;
n = gfc_check_dependency (expr1, actual->expr, identical);
if (n)
return n;
}
return 0;
case EXPR_CONSTANT:
case EXPR_NULL:
return 0;
case EXPR_ARRAY:
return 1;
default:
return 1;
}
}
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 (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 (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar.as))
l_start = l_ar.as->lower[n];
if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar.as))
l_end = l_ar.as->upper[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 (!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;
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;
if (l_dir == 0 || r_dir == 0)
return GFC_DEP_OVERLAP;
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 (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;
}
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;
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;
}
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;
}
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)
{
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;
}
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)
{
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;
}
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];
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;
if (s == 0)
return GFC_DEP_OVERLAP;
if (s == 1)
{
if (start && gfc_dep_compare_expr (elem, start) == -1)
return GFC_DEP_NODEP;
if (end && gfc_dep_compare_expr (elem, end) == 1)
return GFC_DEP_NODEP;
if (start && end)
{
s = gfc_dep_compare_expr (start, end);
if (s == 1)
return GFC_DEP_NODEP;
if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
return GFC_DEP_EQUAL;
}
}
else if (s == -1)
{
if (end && gfc_dep_compare_expr (elem, start) == 1)
return GFC_DEP_NODEP;
if (start && gfc_dep_compare_expr (elem, end) == -1)
return GFC_DEP_NODEP;
if (start && end)
{
s = gfc_dep_compare_expr (start, end);
if (s == -1)
return GFC_DEP_NODEP;
if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
return GFC_DEP_EQUAL;
}
}
else
{
if (!start || !end)
return GFC_DEP_OVERLAP;
s = gfc_dep_compare_expr (start, end);
if (s == -2)
return GFC_DEP_OVERLAP;
if (s == -1)
{
if (gfc_dep_compare_expr (elem, start) == -1)
return GFC_DEP_NODEP;
if (gfc_dep_compare_expr (elem, end) == 1)
return GFC_DEP_NODEP;
}
else if (s == 1)
{
if (gfc_dep_compare_expr (elem, start) == 1)
return GFC_DEP_NODEP;
if (gfc_dep_compare_expr (elem, end) == -1)
return GFC_DEP_NODEP;
}
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 bool
contains_forall_index_p (gfc_expr * expr)
{
gfc_actual_arglist *arg;
gfc_constructor *c;
gfc_ref *ref;
int i;
if (!expr)
return false;
switch (expr->expr_type)
{
case EXPR_VARIABLE:
if (expr->symtree->n.sym->forall_index)
return true;
break;
case EXPR_OP:
if (contains_forall_index_p (expr->value.op.op1)
|| contains_forall_index_p (expr->value.op.op2))
return true;
break;
case EXPR_FUNCTION:
for (arg = expr->value.function.actual; arg; arg = arg->next)
if (contains_forall_index_p (arg->expr))
return true;
break;
case EXPR_CONSTANT:
case EXPR_NULL:
case EXPR_SUBSTRING:
break;
case EXPR_STRUCTURE:
case EXPR_ARRAY:
for (c = expr->value.constructor; c; c = c->next)
if (contains_forall_index_p (c->expr))
return true;
break;
default:
gcc_unreachable ();
}
for (ref = expr->ref; ref; ref = ref->next)
switch (ref->type)
{
case REF_ARRAY:
for (i = 0; i < ref->u.ar.dimen; i++)
if (contains_forall_index_p (ref->u.ar.start[i])
|| contains_forall_index_p (ref->u.ar.end[i])
|| contains_forall_index_p (ref->u.ar.stride[i]))
return true;
break;
case REF_COMPONENT:
break;
case REF_SUBSTRING:
if (contains_forall_index_p (ref->u.ss.start)
|| contains_forall_index_p (ref->u.ss.end))
return true;
break;
default:
gcc_unreachable ();
}
return false;
}
static gfc_dependency
gfc_check_element_vs_element (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;
int i;
l_ar = lref->u.ar;
r_ar = rref->u.ar;
l_start = l_ar.start[n] ;
r_start = r_ar.start[n] ;
i = gfc_dep_compare_expr (r_start, l_start);
if (i == 0)
return GFC_DEP_EQUAL;
if (contains_forall_index_p (r_start)
|| contains_forall_index_p (l_start))
return GFC_DEP_OVERLAP;
if (i != -2)
return GFC_DEP_NODEP;
return GFC_DEP_EQUAL;
}
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++)
{
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;
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;
if (ref->u.ar.stride[i]
&& !gfc_expr_is_one (ref->u.ar.stride[i], 0))
return false;
}
return true;
}
int
gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref)
{
int n;
gfc_dependency fin_dep;
gfc_dependency this_dep;
fin_dep = GFC_DEP_ERROR;
while (lref && rref)
{
gcc_assert (lref->type == rref->type);
switch (lref->type)
{
case REF_COMPONENT:
if (lref->u.c.component != rref->u.c.component)
return 0;
break;
case REF_SUBSTRING:
return 0;
case REF_ARRAY:
if (lref->u.ar.dimen != rref->u.ar.dimen)
{
if (lref->u.ar.type == AR_FULL)
fin_dep = gfc_full_array_ref_p (rref) ? GFC_DEP_EQUAL
: GFC_DEP_OVERLAP;
else if (rref->u.ar.type == AR_FULL)
fin_dep = gfc_full_array_ref_p (lref) ? GFC_DEP_EQUAL
: GFC_DEP_OVERLAP;
else
return 1;
break;
}
for (n=0; n < lref->u.ar.dimen; n++)
{
if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
|| rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
return 1;
if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
&& rref->u.ar.dimen_type[n] == DIMEN_RANGE)
this_dep = gfc_check_section_vs_section (lref, rref, n);
else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
&& rref->u.ar.dimen_type[n] == DIMEN_RANGE)
this_dep = gfc_check_element_vs_section (lref, rref, n);
else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
&& lref->u.ar.dimen_type[n] == DIMEN_RANGE)
this_dep = gfc_check_element_vs_section (rref, lref, n);
else
{
gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
&& lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
this_dep = gfc_check_element_vs_element (rref, lref, n);
}
if (this_dep == GFC_DEP_NODEP)
return 0;
if (this_dep > fin_dep)
fin_dep = this_dep;
}
if (fin_dep < GFC_DEP_OVERLAP)
return 0;
break;
default:
gcc_unreachable ();
}
lref = lref->next;
rref = rref->next;
}
gcc_assert (fin_dep != GFC_DEP_ERROR);
if (lref || rref)
return 1;
return fin_dep == GFC_DEP_OVERLAP;
}