#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)
{
int i;
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;
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))
return 1;
if (ar1->as && !e1)
e1 = ar1->as->lower[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 1;
return 0;
}
int
gfc_check_fncall_dependency (gfc_expr * dest, gfc_expr * fncall)
{
gfc_actual_arglist *actual;
gfc_ref *ref;
gfc_expr *expr;
int n;
gcc_assert (dest->expr_type == EXPR_VARIABLE
&& fncall->expr_type == EXPR_FUNCTION);
gcc_assert (fncall->rank > 0);
for (actual = fncall->value.function.actual; actual; actual = actual->next)
{
expr = actual->expr;
if (!expr)
continue;
switch (expr->expr_type)
{
case EXPR_VARIABLE:
if (expr->rank > 1)
{
for (ref = expr->ref; ref; ref = ref->next)
{
if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
break;
}
gcc_assert (ref);
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)
break;
}
if (n != ref->u.ar.dimen)
continue;
}
}
if (gfc_check_dependency (dest, actual->expr, NULL, 0))
return 1;
break;
case EXPR_ARRAY:
if (gfc_check_dependency (dest, expr, NULL, 0))
return 1;
break;
default:
break;
}
}
return 0;
}
int
gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
int nvars)
{
gfc_ref *ref;
int n;
gfc_actual_arglist *actual;
gcc_assert (expr1->expr_type == EXPR_VARIABLE);
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;
}
switch (expr2->expr_type)
{
case EXPR_OP:
n = gfc_check_dependency (expr1, expr2->value.op.op1, vars, nvars);
if (n)
return n;
if (expr2->value.op.op2)
return gfc_check_dependency (expr1, expr2->value.op.op2, vars, nvars);
return 0;
case EXPR_VARIABLE:
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;
}
if (expr1->symtree->n.sym != expr2->symtree->n.sym)
return 0;
for (ref = expr2->ref; ref; ref = ref->next)
{
if (ref->type == REF_ARRAY)
return 1;
}
return 1;
case EXPR_FUNCTION:
for (actual = expr2->value.function.actual;
actual; actual = actual->next)
{
if (!actual->expr)
continue;
n = gfc_check_dependency (expr1, actual->expr, vars, nvars);
if (n)
return n;
}
return 0;
case EXPR_CONSTANT:
return 0;
case EXPR_ARRAY:
return 1;
default:
return 1;
}
}
static void
get_no_of_elements(mpz_t ele, gfc_expr * u1, gfc_expr * l1, gfc_expr * s1)
{
mpz_sub (ele, u1->value.integer, l1->value.integer);
if (s1 != NULL)
mpz_tdiv_q (ele, ele, s1->value.integer);
}
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);
if (start == 0 && end == 0)
return GFC_DEP_EQUAL;
if ((start < 0 && mpz_cmp_ui (x2, 0) < 0)
|| (mpz_cmp (x1, y) > 0 && end > 0))
return GFC_DEP_NODEP;
if (start > 0 && end > 0)
return GFC_DEP_FORWARD;
return GFC_DEP_OVERLAP;
}
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;
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, r_stride->value.integer);
mpz_add (X2, X2, X1);
return 0;
}
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 (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];
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_is_inside_range (gfc_expr * chk, gfc_expr * left, gfc_expr * right)
{
int l;
int r;
int s;
s = gfc_dep_compare_expr (left, right);
if (s == -2)
return GFC_DEP_OVERLAP;
l = gfc_dep_compare_expr (chk, left);
r = gfc_dep_compare_expr (chk, right);
if (l == -2 || r == -2 || s == -2)
return GFC_DEP_OVERLAP;
if (s == 1)
{
if (l <= 0 || r >= 0)
return GFC_DEP_OVERLAP;
}
else
{
if (l >= 0 || r <= 0)
return GFC_DEP_OVERLAP;
}
return GFC_DEP_NODEP;
}
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_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;
gfc_dependency nIsDep;
if (lref->type == REF_ARRAY && rref->type == REF_ARRAY)
{
l_ar = lref->u.ar;
r_ar = rref->u.ar;
l_start = l_ar.start[n] ;
r_start = r_ar.start[n] ;
if (gfc_dep_compare_expr (r_start, l_start) == 0)
nIsDep = GFC_DEP_EQUAL;
else
nIsDep = GFC_DEP_NODEP;
}
else
nIsDep = GFC_DEP_NODEP;
return nIsDep;
}
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:
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 (fin_dep < GFC_DEP_OVERLAP)
return 0;
else
return 1;
}