/* Run from a finalizer via do_vacuum_weak_set, this function runs over
the whole table, removing lost weak references, reshuffling the set
as it goes. It might resize the set if it reaps enough entries. */
static void
vacuum_weak_set (scm_t_weak_set *set)
{
scm_t_weak_entry *entries = set->entries;
unsigned long size = set->size;
unsigned long k;
for (k = 0; k < size; k++)
{
unsigned long hash = entries[k].hash;
if (hash)
{
scm_t_weak_entry copy;
copy_weak_entry (&entries[k], ©);
if (!copy.key)
/* Lost weak reference; reshuffle. */
{
give_to_poor (set, k);
set->n_items--;
}
}
}
if (set->n_items < set->lower)
resize_set (set);
}
/* Run after GC via do_vacuum_weak_table, this function runs over the
whole table, removing lost weak references, reshuffling the table as it
goes. It might resize the table if it reaps enough entries. */
static void
vacuum_weak_table (scm_t_weak_table *table)
{
scm_t_weak_entry *entries = table->entries;
unsigned long size = table->size;
unsigned long k;
for (k = 0; k < size; k++)
{
unsigned long hash = entries[k].hash;
if (hash)
{
scm_t_weak_entry copy;
copy_weak_entry (&entries[k], ©);
if (!copy.key || !copy.value)
/* Lost weak reference; reshuffle. */
{
give_to_poor (table, k);
table->n_items--;
}
}
}
if (table->n_items < table->lower)
resize_table (table);
}
static SCM
weak_set_add_x (scm_t_weak_set *set, unsigned long hash,
scm_t_set_predicate_fn pred, void *closure,
SCM obj)
{
unsigned long k, distance, size;
scm_t_weak_entry *entries;
size = set->size;
entries = set->entries;
hash = (hash << 1) | 0x1;
k = hash_to_index (hash, size);
for (distance = 0; ; distance++, k = (k + 1) % size)
{
unsigned long other_hash;
retry:
other_hash = entries[k].hash;
if (!other_hash)
/* Found an empty entry. */
break;
if (other_hash == hash)
{
scm_t_weak_entry copy;
copy_weak_entry (&entries[k], ©);
if (!copy.key)
/* Lost weak reference; reshuffle. */
{
give_to_poor (set, k);
set->n_items--;
goto retry;
}
if (pred (SCM_PACK (copy.key), closure))
/* Found an entry with this key. */
return SCM_PACK (copy.key);
}
if (set->n_items > set->upper)
/* Full set, time to resize. */
{
resize_set (set);
return weak_set_add_x (set, hash >> 1, pred, closure, obj);
}
/* Displace the entry if our distance is less, otherwise keep
looking. */
if (entry_distance (other_hash, k, size) < distance)
{
rob_from_rich (set, k);
break;
}
}
static void
weak_table_put_x (scm_t_weak_table *table, unsigned long hash,
scm_t_table_predicate_fn pred, void *closure,
SCM key, SCM value)
{
unsigned long k, distance, size;
scm_t_weak_entry *entries;
size = table->size;
entries = table->entries;
hash = (hash << 1) | 0x1;
k = hash_to_index (hash, size);
for (distance = 0; ; distance++, k = (k + 1) % size)
{
unsigned long other_hash;
retry:
other_hash = entries[k].hash;
if (!other_hash)
/* Found an empty entry. */
break;
if (other_hash == hash)
{
scm_t_weak_entry copy;
copy_weak_entry (&entries[k], ©);
if (!copy.key || !copy.value)
/* Lost weak reference; reshuffle. */
{
give_to_poor (table, k);
table->n_items--;
goto retry;
}
if (pred (SCM_PACK (copy.key), SCM_PACK (copy.value), closure))
/* Found an entry with this key. */
break;
}
if (table->n_items > table->upper)
/* Full table, time to resize. */
{
resize_table (table);
return weak_table_put_x (table, hash >> 1, pred, closure, key, value);
}
/* Displace the entry if our distance is less, otherwise keep
looking. */
if (entry_distance (other_hash, k, size) < distance)
{
rob_from_rich (table, k);
break;
}
}
static SCM
weak_set_lookup (scm_t_weak_set *set, unsigned long hash,
scm_t_set_predicate_fn pred, void *closure,
SCM dflt)
{
unsigned long k, distance, size;
scm_t_weak_entry *entries;
size = set->size;
entries = set->entries;
hash = (hash << 1) | 0x1;
k = hash_to_index (hash, size);
for (distance = 0; distance < size; distance++, k = (k + 1) % size)
{
unsigned long other_hash;
retry:
other_hash = entries[k].hash;
if (!other_hash)
/* Not found. */
return dflt;
if (hash == other_hash)
{
scm_t_weak_entry copy;
copy_weak_entry (&entries[k], ©);
if (!copy.key)
/* Lost weak reference; reshuffle. */
{
give_to_poor (set, k);
set->n_items--;
goto retry;
}
if (pred (SCM_PACK (copy.key), closure))
/* Found. */
return SCM_PACK (copy.key);
}
/* If the entry's distance is less, our key is not in the set. */
if (entry_distance (other_hash, k, size) < distance)
return dflt;
}
/* If we got here, then we were unfortunate enough to loop through the
whole set. Shouldn't happen, but hey. */
return dflt;
}
static void
give_to_poor (scm_t_weak_table *table, unsigned long k)
{
/* Slot K was just freed up; possibly shuffle others down. */
unsigned long size = table->size;
while (1)
{
unsigned long next = (k + 1) % size;
unsigned long hash;
scm_t_weak_entry copy;
hash = table->entries[next].hash;
if (!hash || hash_to_index (hash, size) == next)
break;
copy_weak_entry (&table->entries[next], ©);
if (!copy.key || !copy.value)
/* Lost weak reference. */
{
give_to_poor (table, next);
table->n_items--;
continue;
}
move_weak_entry (&table->entries[next], &table->entries[k],
table->kind);
k = next;
}
/* We have shuffled down any entries that should be shuffled down; now
free the end. */
table->entries[k].hash = 0;
table->entries[k].key = 0;
table->entries[k].value = 0;
}
