static void
get_array_index (gfc_array_ref *ar, mpz_t *offset)
{
gfc_expr *e;
int i;
mpz_t delta;
mpz_t tmp;
mpz_init (tmp);
mpz_set_si (*offset, 0);
mpz_init_set_si (delta, 1);
for (i = 0; i < ar->dimen; i++)
{
e = gfc_copy_expr (ar->start[i]);
gfc_simplify_expr (e, 1);
if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
|| (gfc_is_constant_expr (ar->as->upper[i]) == 0)
|| (gfc_is_constant_expr (e) == 0))
gfc_error ("non-constant array in DATA statement %L", &ar->where);
mpz_set (tmp, e->value.integer);
gfc_free_expr (e);
mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
mpz_mul (tmp, tmp, delta);
mpz_add (*offset, tmp, *offset);
mpz_sub (tmp, ar->as->upper[i]->value.integer,
ar->as->lower[i]->value.integer);
mpz_add_ui (tmp, tmp, 1);
mpz_mul (delta, tmp, delta);
}
mpz_clear (delta);
mpz_clear (tmp);
}
resolve_array_bound (gfc_expr * e, int check_constant)
{
if (e == NULL)
return SUCCESS;
if (gfc_resolve_expr (e) == FAILURE
|| gfc_specification_expr (e) == FAILURE)
return FAILURE;
if (check_constant && gfc_is_constant_expr (e) == 0)
{
gfc_error ("Variable '%s' at %L in this context must be constant",
e->symtree->n.sym->name, &e->where);
return FAILURE;
}
return SUCCESS;
}
static void
get_array_index (gfc_array_ref * ar, mpz_t * offset)
{
gfc_expr *e;
int i;
try re;
mpz_t delta;
mpz_t tmp;
mpz_init (tmp);
mpz_set_si (*offset, 0);
mpz_init_set_si (delta, 1);
for (i = 0; i < ar->dimen; i++)
{
e = gfc_copy_expr (ar->start[i]);
re = gfc_simplify_expr (e, 1);
if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
|| (gfc_is_constant_expr (ar->as->upper[i]) == 0)
|| (gfc_is_constant_expr (e) == 0))
gfc_error ("non-constant array in DATA statement %L.", &ar->where);
mpz_set (tmp, e->value.integer);
mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
mpz_mul (tmp, tmp, delta);
mpz_add (*offset, tmp, *offset);
mpz_sub (tmp, ar->as->upper[i]->value.integer,
ar->as->lower[i]->value.integer);
mpz_add_ui (tmp, tmp, 1);
mpz_mul (delta, tmp, delta);
}
mpz_clear (delta);
mpz_clear (tmp);
}
/* Find if there is a constructor which offset is equal to OFFSET. */
static gfc_constructor *
find_con_by_offset (mpz_t offset, gfc_constructor *con)
{
mpz_t tmp;
gfc_constructor *ret = NULL;
mpz_init (tmp);
for (; con; con = con->next)
{
int cmp = mpz_cmp (offset, con->n.offset);
/* We retain a sorted list, so if we're too large, we're done. */
if (cmp < 0)
break;
/* Yaye for exact matches. */
if (cmp == 0)
{
ret = con;
break;
}
/* If the constructor element is a range, match any element. */
if (mpz_cmp_ui (con->repeat, 1) > 0)
{
mpz_add (tmp, con->n.offset, con->repeat);
if (mpz_cmp (offset, tmp) < 0)
{
ret = con;
break;
}
}
}
mpz_clear (tmp);
return ret;
}
