-/* Copyright (C) 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
SCM k, SCM v,
scm_t_weak_table_kind kind)
{
- if (SCM_UNPACK (k) && SCM_NIMP (k)
+ if (SCM_UNPACK (k) && SCM_HEAP_OBJECT_P (k)
&& (kind == SCM_WEAK_TABLE_KIND_KEY
|| kind == SCM_WEAK_TABLE_KIND_BOTH))
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entry->key,
(GC_PTR) SCM2PTR (k));
- if (SCM_UNPACK (v) && SCM_NIMP (v)
+ if (SCM_UNPACK (v) && SCM_HEAP_OBJECT_P (v)
&& (kind == SCM_WEAK_TABLE_KIND_VALUE
|| kind == SCM_WEAK_TABLE_KIND_BOTH))
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entry->value,
GC_unregister_disappearing_link ((GC_PTR) &entry->value);
}
+static void
+move_disappearing_links (scm_t_weak_entry *from, scm_t_weak_entry *to,
+ SCM key, SCM value, scm_t_weak_table_kind kind)
+{
+ if ((kind == SCM_WEAK_TABLE_KIND_KEY || kind == SCM_WEAK_TABLE_KIND_BOTH)
+ && SCM_HEAP_OBJECT_P (key))
+ {
+#ifdef HAVE_GC_MOVE_DISAPPEARING_LINK
+ GC_move_disappearing_link ((GC_PTR) &from->key, (GC_PTR) &to->key);
+#else
+ GC_unregister_disappearing_link (&from->key);
+ SCM_I_REGISTER_DISAPPEARING_LINK (&to->key, SCM2PTR (key));
+#endif
+ }
+
+ if ((kind == SCM_WEAK_TABLE_KIND_VALUE || kind == SCM_WEAK_TABLE_KIND_BOTH)
+ && SCM_HEAP_OBJECT_P (value))
+ {
+#ifdef HAVE_GC_MOVE_DISAPPEARING_LINK
+ GC_move_disappearing_link ((GC_PTR) &from->value, (GC_PTR) &to->value);
+#else
+ GC_unregister_disappearing_link (&from->value);
+ SCM_I_REGISTER_DISAPPEARING_LINK (&to->value, SCM2PTR (value));
+#endif
+ }
+}
+
static void
move_weak_entry (scm_t_weak_entry *from, scm_t_weak_entry *to,
scm_t_weak_table_kind kind)
to->key = copy.key;
to->value = copy.value;
- unregister_disappearing_links (from, kind);
- register_disappearing_links (to,
- SCM_PACK (copy.key), SCM_PACK (copy.value),
- kind);
+ move_disappearing_links (from, to,
+ SCM_PACK (copy.key), SCM_PACK (copy.value),
+ kind);
}
else
{
#define HASHTABLE_SIZE_N (sizeof(hashtable_size)/sizeof(unsigned long))
-static void
-resize_table (scm_t_weak_table *table)
+static int
+compute_size_index (scm_t_weak_table *table)
{
- scm_t_weak_entry *old_entries, *new_entries;
- int i;
- unsigned long old_size, new_size, old_k;
+ int i = table->size_index;
- old_entries = table->entries;
- old_size = table->size;
-
if (table->n_items < table->lower)
{
/* rehashing is not triggered when i <= min_size */
- i = table->size_index;
do
--i;
while (i > table->min_size_index
- && table->n_items < hashtable_size[i] / 4);
+ && table->n_items < hashtable_size[i] / 5);
}
- else
+ else if (table->n_items > table->upper)
{
- i = table->size_index + 1;
+ ++i;
if (i >= HASHTABLE_SIZE_N)
/* The biggest size currently is 230096423, which for a 32-bit
machine will occupy 2.3GB of memory at a load of 80%. There
abort ();
}
- new_size = hashtable_size[i];
- new_entries = allocate_entries (new_size, table->kind);
+ return i;
+}
- table->size_index = i;
+static int
+is_acceptable_size_index (scm_t_weak_table *table, int size_index)
+{
+ int computed = compute_size_index (table);
+
+ if (size_index == computed)
+ /* We were going to grow or shrink, and allocating the new vector
+ didn't change the target size. */
+ return 1;
+
+ if (size_index == computed + 1)
+ {
+ /* We were going to enlarge the table, but allocating the new
+ vector finalized some objects, making an enlargement
+ unnecessary. It might still be a good idea to use the larger
+ table, though. (This branch also gets hit if, while allocating
+ the vector, some other thread was actively removing items from
+ the table. That is less likely, though.) */
+ unsigned long new_lower = hashtable_size[size_index] / 5;
+
+ return table->size > new_lower;
+ }
+
+ if (size_index == computed - 1)
+ {
+ /* We were going to shrink the table, but when we dropped the lock
+ to allocate the new vector, some other thread added elements to
+ the table. */
+ return 0;
+ }
+
+ /* The computed size differs from our newly allocated size by more
+ than one size index -- recalculate. */
+ return 0;
+}
+
+static void
+resize_table (scm_t_weak_table *table)
+{
+ scm_t_weak_entry *old_entries, *new_entries;
+ int new_size_index;
+ unsigned long old_size, new_size, old_k;
+
+ do
+ {
+ new_size_index = compute_size_index (table);
+ if (new_size_index == table->size_index)
+ return;
+ new_size = hashtable_size[new_size_index];
+ scm_i_pthread_mutex_unlock (&table->lock);
+ /* Allocating memory might cause finalizers to run, which could
+ run anything, so drop our lock to avoid deadlocks. */
+ new_entries = allocate_entries (new_size, table->kind);
+ scm_i_pthread_mutex_lock (&table->lock);
+ }
+ while (!is_acceptable_size_index (table, new_size_index));
+
+ old_entries = table->entries;
+ old_size = table->size;
+
+ table->size_index = new_size_index;
table->size = new_size;
- if (i <= table->min_size_index)
+ if (new_size_index <= table->min_size_index)
table->lower = 0;
else
table->lower = new_size / 5;
void
scm_i_weak_table_print (SCM exp, SCM port, scm_print_state *pstate)
{
- scm_puts ("#<", port);
- scm_puts ("weak-table ", port);
+ scm_puts_unlocked ("#<", port);
+ scm_puts_unlocked ("weak-table ", port);
scm_uintprint (SCM_WEAK_TABLE (exp)->n_items, 10, port);
- scm_putc ('/', port);
+ scm_putc_unlocked ('/', port);
scm_uintprint (SCM_WEAK_TABLE (exp)->size, 10, port);
- scm_puts (">", port);
+ scm_puts_unlocked (">", port);
}
static void
weak_gc_finalizer (void *ptr, void *data)
{
if (weak_gc_callback (ptr))
- GC_REGISTER_FINALIZER_NO_ORDER (ptr, weak_gc_finalizer, data, NULL, NULL);
+ scm_i_set_finalizer (ptr, weak_gc_finalizer, data);
}
#endif
#ifdef HAVE_GC_TABLE_START_CALLBACK
scm_c_hook_add (&scm_after_gc_c_hook, weak_gc_hook, weak, 0);
#else
- GC_REGISTER_FINALIZER_NO_ORDER (weak, weak_gc_finalizer, NULL, NULL, NULL);
+ scm_i_set_finalizer (weak, weak_gc_finalizer, NULL);
#endif
}
dflt);
}
-SCM
+void
scm_weak_table_putq_x (SCM table, SCM key, SCM value)
{
scm_c_weak_table_put_x (table, scm_ihashq (key, -1),
assq_predicate, SCM_UNPACK_POINTER (key),
key, value);
- return SCM_UNSPECIFIED;
}
-SCM
+void
scm_weak_table_remq_x (SCM table, SCM key)
{
scm_c_weak_table_remove_x (table, scm_ihashq (key, -1),
assq_predicate, SCM_UNPACK_POINTER (key));
- return SCM_UNSPECIFIED;
}
-SCM
+void
scm_weak_table_clear_x (SCM table)
#define FUNC_NAME "weak-table-clear!"
{
t->n_items = 0;
scm_i_pthread_mutex_unlock (&t->lock);
-
- return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
return seed;
}
-SCM
+void
scm_weak_table_for_each (SCM proc, SCM table)
#define FUNC_NAME "weak-table-for-each"
{
SCM_VALIDATE_PROC (1, proc);
scm_c_weak_table_fold (for_each_trampoline, SCM_UNPACK_POINTER (proc), SCM_BOOL_F, table);
-
- return SCM_UNSPECIFIED;
}
#undef FUNC_NAME