static void
interval_tree_intersection_1(interval_tree tree, uint64_t start, uint64_t end,
varray * dest)
{
interval_tree_node node;
node = splay_tree_lookup(tree->splay, start);
if (!node)
{
node = splay_tree_predecessor(tree->splay, start);
if (!node || INTERVAL_END(node) <= start)
node = splay_tree_successor(tree->splay, start);
}
if (!node)
node = splay_tree_successor(tree->splay, start);
for (; node && INTERVAL_START(node) < end;
node = splay_tree_successor(tree->splay, INTERVAL_START(node)))
{
interval *x;
VARRAY_EMPTY_PUSH(*dest);
x = &VARRAY_TOP(*dest, interval);
x->start = MAX(start, INTERVAL_START(node));
x->end = MIN(end, INTERVAL_END(node));
}
}
gfc_constructor *
gfc_constructor_lookup (gfc_constructor_base base, int offset)
{
gfc_constructor *c;
splay_tree_node node;
if (!base)
return NULL;
node = splay_tree_lookup (base, (splay_tree_key) offset);
if (node)
return (gfc_constructor *) node->value;
/* Check if the previous node has a repeat count big enough to
cover the offset looked for. */
node = splay_tree_predecessor (base, (splay_tree_key) offset);
if (!node)
return NULL;
c = (gfc_constructor *) node->value;
if (mpz_cmp_si (c->repeat, 1) > 0)
{
if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
c = NULL;
}
else
c = NULL;
return c;
}
/* Find the splay tree node for the definition of NAME at LINE in
SOURCE, or zero if there is none. */
static splay_tree_node
find_definition (const char *name,
struct macro_source_file *file,
int line)
{
struct macro_table *t = file->table;
splay_tree_node n;
/* Construct a macro_key object, just for the query. */
struct macro_key query;
query.name = name;
query.start_file = file;
query.start_line = line;
query.end_file = NULL;
n = splay_tree_lookup (t->definitions, (splay_tree_key) &query);
if (! n)
{
/* It's okay for us to do two queries like this: the real work
of the searching is done when we splay, and splaying the tree
a second time at the same key is a constant time operation.
If this still bugs you, you could always just extend the
splay tree library with a predecessor-or-equal operation, and
use that. */
splay_tree_node pred = splay_tree_predecessor (t->definitions,
(splay_tree_key) &query);
if (pred)
{
/* Make sure this predecessor actually has the right name.
We just want to search within a given name's definitions. */
struct macro_key *found = (struct macro_key *) pred->key;
if (strcmp (found->name, name) == 0)
n = pred;
}
}
if (n)
{
struct macro_key *found = (struct macro_key *) n->key;
/* Okay, so this definition has the right name, and its scope
begins before the given source location. But does its scope
end after the given source location? */
if (compare_locations (file, line, found->end_file, found->end_line) < 0)
return n;
else
return 0;
}
else
return 0;
}
bool interval_tree_covered(interval_tree tree, uint64_t start, uint64_t end)
{
interval_tree_node node;
node = splay_tree_lookup(tree->splay, start);
if (!node)
{
node = splay_tree_predecessor(tree->splay, start);
if (!node)
return false;
}
return (end <= INTERVAL_END(node));
}
static gfc_constructor *
find_con_by_offset (splay_tree spt, mpz_t offset)
{
mpz_t tmp;
gfc_constructor *ret = NULL;
gfc_constructor *con;
splay_tree_node sptn;
/* The complexity is due to needing quick access to the linked list of
constructors. Both a linked list and a splay tree are used, and both
are kept up to date if they are array elements (which is the only time
that a specific constructor has to be found). */
gcc_assert (spt != NULL);
mpz_init (tmp);
sptn = splay_tree_lookup (spt, (splay_tree_key) mpz_get_si (offset));
if (sptn)
ret = (gfc_constructor*) sptn->value;
else
{
/* Need to check and see if we match a range, so we will pull
the next lowest index and see if the range matches. */
sptn = splay_tree_predecessor (spt,
(splay_tree_key) mpz_get_si (offset));
if (sptn)
{
con = (gfc_constructor*) sptn->value;
if (mpz_cmp_ui (con->repeat, 1) > 0)
{
mpz_init (tmp);
mpz_add (tmp, con->n.offset, con->repeat);
if (mpz_cmp (offset, tmp) < 0)
ret = con;
mpz_clear (tmp);
}
else
ret = NULL; /* The range did not match. */
}
else
ret = NULL; /* No pred, so no match. */
}
return ret;
}
static void
interval_tree_complement_1(interval_tree tree, uint64_t start, uint64_t end,
varray * dest)
{
interval_tree_node node;
uint64_t last;
node = splay_tree_lookup(tree->splay, start);
if (node)
{
last = INTERVAL_END(node);
}
else
{
node = splay_tree_predecessor(tree->splay, start);
if (node && INTERVAL_END(node) > start)
last = INTERVAL_END(node);
else
last = start;
}
node = splay_tree_successor(tree->splay, start);
while (last < end)
{
interval *x;
VARRAY_EMPTY_PUSH(*dest);
x = &VARRAY_TOP(*dest, interval);
x->start = last;
if (node)
{
x->end = INTERVAL_START(node);
last = INTERVAL_END(node);
node = splay_tree_successor(tree->splay, INTERVAL_START(node));
}
else
{
x->end = end;
break;
}
}
}
interval_tree_node interval_tree_lookup(interval_tree tree, uint64_t value)
{
interval_tree_node node;
CHECK_MUTEX_LOCKED(tree->mutex);
/* Return the interval starting with VALUE if it exist. */
node = splay_tree_lookup(tree->splay, value);
if (node)
return node;
/* Return the interval containing VALUE if it exist. */
node = splay_tree_predecessor(tree->splay, value);
if (node && INTERVAL_END(node) > value)
return node;
/* Return the first interval after VALUE. */
return splay_tree_successor(tree->splay, value);
}
static splay_tree_node
addrmap_splay_tree_predecessor (struct addrmap_mutable *map, CORE_ADDR addr)
{
return splay_tree_predecessor (map->tree, (splay_tree_key) &addr);
}
void
gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
mpz_t index, mpz_t repeat)
{
gfc_ref *ref;
gfc_expr *init, *expr;
gfc_constructor *con, *last_con;
gfc_constructor *pred;
gfc_symbol *symbol;
gfc_typespec *last_ts;
mpz_t offset;
splay_tree spt;
splay_tree_node sptn;
symbol = lvalue->symtree->n.sym;
init = symbol->value;
last_ts = &symbol->ts;
last_con = NULL;
mpz_init_set_si (offset, 0);
/* Find/create the parent expressions for subobject references. */
for (ref = lvalue->ref; ref; ref = ref->next)
{
/* Use the existing initializer expression if it exists.
Otherwise create a new one. */
if (init == NULL)
expr = gfc_get_expr ();
else
expr = init;
/* Find or create this element. */
switch (ref->type)
{
case REF_ARRAY:
if (init == NULL)
{
/* The element typespec will be the same as the array
typespec. */
expr->ts = *last_ts;
/* Setup the expression to hold the constructor. */
expr->expr_type = EXPR_ARRAY;
expr->rank = ref->u.ar.as->rank;
}
else
gcc_assert (expr->expr_type == EXPR_ARRAY);
if (ref->u.ar.type == AR_ELEMENT)
{
get_array_index (&ref->u.ar, &offset);
/* This had better not be the bottom of the reference.
We can still get to a full array via a component. */
gcc_assert (ref->next != NULL);
}
else
{
mpz_set (offset, index);
/* We're at a full array or an array section. This means
that we've better have found a full array, and that we're
at the bottom of the reference. */
gcc_assert (ref->u.ar.type == AR_FULL);
gcc_assert (ref->next == NULL);
}
/* Find the same element in the existing constructor. */
/* Splay tree containing offset and gfc_constructor. */
spt = expr->con_by_offset;
if (spt == NULL)
{
spt = splay_tree_new (splay_tree_compare_ints, NULL, NULL);
expr->con_by_offset = spt;
con = NULL;
}
else
con = find_con_by_offset (spt, offset);
if (con == NULL)
{
splay_tree_key j;
/* Create a new constructor. */
con = gfc_get_constructor ();
mpz_set (con->n.offset, offset);
j = (splay_tree_key) mpz_get_si (offset);
if (ref->next == NULL)
mpz_set (con->repeat, repeat);
sptn = splay_tree_insert (spt, j, (splay_tree_value) con);
/* Fix up the linked list. */
sptn = splay_tree_predecessor (spt, j);
if (sptn == NULL)
{ /* Insert at the head. */
con->next = expr->value.constructor;
expr->value.constructor = con;
}
else
{ /* Insert in the chain. */
pred = (gfc_constructor*) sptn->value;
con->next = pred->next;
pred->next = con;
}
}
else
gcc_assert (ref->next != NULL);
break;
case REF_COMPONENT:
if (init == NULL)
{
/* Setup the expression to hold the constructor. */
expr->expr_type = EXPR_STRUCTURE;
expr->ts.type = BT_DERIVED;
expr->ts.derived = ref->u.c.sym;
}
else
gcc_assert (expr->expr_type == EXPR_STRUCTURE);
last_ts = &ref->u.c.component->ts;
/* Find the same element in the existing constructor. */
con = expr->value.constructor;
con = find_con_by_component (ref->u.c.component, con);
if (con == NULL)
{
/* Create a new constructor. */
con = gfc_get_constructor ();
con->n.component = ref->u.c.component;
con->next = expr->value.constructor;
expr->value.constructor = con;
}
/* Since we're only intending to initialize arrays here,
there better be an inner reference. */
gcc_assert (ref->next != NULL);
break;
case REF_SUBSTRING:
default:
gcc_unreachable ();
}
if (init == NULL)
{
/* Point the container at the new expression. */
if (last_con == NULL)
symbol->value = expr;
else
last_con->expr = expr;
}
init = con->expr;
last_con = con;
}
if (last_ts->type == BT_CHARACTER)
expr = create_character_intializer (init, last_ts, NULL, rvalue);
else
{
/* We should never be overwriting an existing initializer. */
gcc_assert (!init);
expr = gfc_copy_expr (rvalue);
if (!gfc_compare_types (&lvalue->ts, &expr->ts))
gfc_convert_type (expr, &lvalue->ts, 0);
}
if (last_con == NULL)
symbol->value = expr;
else
last_con->expr = expr;
}
gfc_try
gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
{
gfc_ref *ref;
gfc_expr *init;
gfc_expr *expr;
gfc_constructor *con;
gfc_constructor *last_con;
gfc_constructor *pred;
gfc_symbol *symbol;
gfc_typespec *last_ts;
mpz_t offset;
splay_tree spt;
splay_tree_node sptn;
symbol = lvalue->symtree->n.sym;
init = symbol->value;
last_ts = &symbol->ts;
last_con = NULL;
mpz_init_set_si (offset, 0);
/* Find/create the parent expressions for subobject references. */
for (ref = lvalue->ref; ref; ref = ref->next)
{
/* Break out of the loop if we find a substring. */
if (ref->type == REF_SUBSTRING)
{
/* A substring should always be the last subobject reference. */
gcc_assert (ref->next == NULL);
break;
}
/* Use the existing initializer expression if it exists. Otherwise
create a new one. */
if (init == NULL)
expr = gfc_get_expr ();
else
expr = init;
/* Find or create this element. */
switch (ref->type)
{
case REF_ARRAY:
if (init && expr->expr_type != EXPR_ARRAY)
{
gfc_error ("'%s' at %L already is initialized at %L",
lvalue->symtree->n.sym->name, &lvalue->where,
&init->where);
return FAILURE;
}
if (init == NULL)
{
/* The element typespec will be the same as the array
typespec. */
expr->ts = *last_ts;
/* Setup the expression to hold the constructor. */
expr->expr_type = EXPR_ARRAY;
expr->rank = ref->u.ar.as->rank;
}
if (ref->u.ar.type == AR_ELEMENT)
get_array_index (&ref->u.ar, &offset);
else
mpz_set (offset, index);
/* Check the bounds. */
if (mpz_cmp_si (offset, 0) < 0)
{
gfc_error ("Data element below array lower bound at %L",
&lvalue->where);
return FAILURE;
}
else
{
mpz_t size;
if (spec_size (ref->u.ar.as, &size) == SUCCESS)
{
if (mpz_cmp (offset, size) >= 0)
{
mpz_clear (size);
gfc_error ("Data element above array upper bound at %L",
&lvalue->where);
return FAILURE;
}
mpz_clear (size);
}
}
/* Splay tree containing offset and gfc_constructor. */
spt = expr->con_by_offset;
if (spt == NULL)
{
spt = splay_tree_new (splay_tree_compare_ints, NULL, NULL);
expr->con_by_offset = spt;
con = NULL;
}
else
con = find_con_by_offset (spt, offset);
if (con == NULL)
{
splay_tree_key j;
/* Create a new constructor. */
con = gfc_get_constructor ();
mpz_set (con->n.offset, offset);
j = (splay_tree_key) mpz_get_si (offset);
sptn = splay_tree_insert (spt, j, (splay_tree_value) con);
/* Fix up the linked list. */
sptn = splay_tree_predecessor (spt, j);
if (sptn == NULL)
{ /* Insert at the head. */
con->next = expr->value.constructor;
expr->value.constructor = con;
}
else
{ /* Insert in the chain. */
pred = (gfc_constructor*) sptn->value;
con->next = pred->next;
pred->next = con;
}
}
break;
case REF_COMPONENT:
if (init == NULL)
{
/* Setup the expression to hold the constructor. */
expr->expr_type = EXPR_STRUCTURE;
expr->ts.type = BT_DERIVED;
expr->ts.derived = ref->u.c.sym;
}
else
gcc_assert (expr->expr_type == EXPR_STRUCTURE);
last_ts = &ref->u.c.component->ts;
/* Find the same element in the existing constructor. */
con = expr->value.constructor;
con = find_con_by_component (ref->u.c.component, con);
if (con == NULL)
{
/* Create a new constructor. */
con = gfc_get_constructor ();
con->n.component = ref->u.c.component;
con->next = expr->value.constructor;
expr->value.constructor = con;
}
break;
default:
gcc_unreachable ();
}
if (init == NULL)
{
/* Point the container at the new expression. */
if (last_con == NULL)
symbol->value = expr;
else
last_con->expr = expr;
}
init = con->expr;
last_con = con;
}
if (ref || last_ts->type == BT_CHARACTER)
expr = create_character_intializer (init, last_ts, ref, rvalue);
else
{
/* Overwriting an existing initializer is non-standard but usually only
provokes a warning from other compilers. */
if (init != NULL)
{
/* Order in which the expressions arrive here depends on whether
they are from data statements or F95 style declarations.
Therefore, check which is the most recent. */
expr = (LOCATION_LINE (init->where.lb->location)
> LOCATION_LINE (rvalue->where.lb->location))
? init : rvalue;
gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization "
"of '%s' at %L", symbol->name, &expr->where);
}
expr = gfc_copy_expr (rvalue);
if (!gfc_compare_types (&lvalue->ts, &expr->ts))
gfc_convert_type (expr, &lvalue->ts, 0);
}
if (last_con == NULL)
symbol->value = expr;
else
last_con->expr = expr;
return SUCCESS;
}
interval_tree_node
interval_tree_insert(interval_tree tree, uint64_t start, uint64_t end)
{
splay_tree_node node, prev, next;
CHECK_MUTEX_LOCKED(tree->mutex);
if ((node = splay_tree_lookup(tree->splay, start)) != NULL)
{
/* The START of interval is already in the tree. */
if (INTERVAL_END(node) >= end)
{
/* There already is a larger interval starting in START so we have
nothing to do. */
return node;
}
INTERVAL_END(node) = end;
}
else
{
/* Lookup the predecessor and successor of key START. */
prev = splay_tree_predecessor(tree->splay, start);
next = splay_tree_successor(tree->splay, start);
if (prev && INTERVAL_END(prev) >= start)
{
/* We are extending PREV. */
node = prev;
if (INTERVAL_END(node) < end)
INTERVAL_END(node) = end;
}
else if (next && INTERVAL_START(next) <= end)
{
/* We are extending NEXT. */
node = next;
if (INTERVAL_START(node) > start)
INTERVAL_START(node) = start;
if (INTERVAL_END(node) < end)
INTERVAL_END(node) = end;
}
else
{
/* We are really inserting a new node. */
node = splay_tree_insert(tree->splay, start, end);
tree->size++;
}
}
/* Merge the successors if they are covered by [START, END). */
while ((next = splay_tree_successor(tree->splay,
INTERVAL_START(node))) != NULL)
{
if (INTERVAL_START(next) <= INTERVAL_END(node))
{
if (INTERVAL_END(node) < INTERVAL_END(next))
INTERVAL_END(node) = INTERVAL_END(next);
splay_tree_delete(tree->splay, INTERVAL_START(next));
tree->size--;
}
else
break;
}
return node;
}
interval_tree_node interval_tree_predecessor(interval_tree tree, uint64_t key)
{
CHECK_MUTEX_LOCKED(tree->mutex);
return splay_tree_predecessor(tree->splay, key);
}
void interval_tree_delete(interval_tree tree, uint64_t start, uint64_t end)
{
splay_tree_node node, prev, next;
CHECK_MUTEX_LOCKED(tree->mutex);
if ((node = splay_tree_lookup(tree->splay, start)) != NULL)
{
tree->deleted = true;
if (INTERVAL_END(node) > end)
{
/* We are shortening the interval NODE. */
INTERVAL_START(node) = end;
return;
}
else
{
splay_tree_delete(tree->splay, start);
tree->size--;
}
}
else
{
prev = splay_tree_predecessor(tree->splay, start);
if (prev && start < INTERVAL_END(prev))
{
tree->deleted = true;
if (INTERVAL_END(prev) > end)
{
/* We are cutting a subinterval from interval PREV. */
splay_tree_insert(tree->splay, end, INTERVAL_END(prev));
tree->size++;
INTERVAL_END(prev) = start;
return;
}
else
{
/* We are shortening the interval PREV. */
INTERVAL_END(prev) = start;
}
}
}
/* Delete rest intervals which intersect [START, END). */
while (1)
{
next = splay_tree_successor(tree->splay, start);
if (!next || INTERVAL_START(next) >= end)
break;
tree->deleted = true;
if (INTERVAL_END(next) <= end)
{
splay_tree_delete(tree->splay, INTERVAL_START(next));
tree->size--;
}
else
{
INTERVAL_START(next) = end;
return;
}
}
}
