Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Alternative implementation for weak hash tables

Browse source 
It can be enabled with -DUSE_EPHEMERON_POOL.

This variant uses the ephemeron pool and hence sovles the key-in-value
problem.

This version stores key/values pairs a vector-of-pairs instead of a
pair-of-vectors.  The same vector-of-pairs type is used for weak and
non-weak.  This avoids the code duplication used by the pair-of-vector
version; though it adds a bit of overhead to the non-weak code path.

* src/lisp.h: (struct vector_pair [!USE_EPHEMERON_POOL]): New type.
(struct pair_vector [USE_EPHEMERON_POOL]):New type.
(hash_table_kv): New typedef used to both version.
(hash_table_kv_create, hash_table_kv_free, hash_table_kv_key)
(hash_table_kv_value, hash_table_kv_set_key, hash_table_kv_set_value)
(hash_table_kv_null): New helpers
(struct Lisp_Hash_Table): Use a single field kv of type hash_table_kv
instead of two fields.
(HASH_KEY, HASH_VALUE, WEAK_HASH_KEY, WEAK_HASH_VALUE, DOHASH)
(DOHASH_WEAK, set_hash_key_slot, set_hash_value_slot)
(set_weak_hash_key_slot, set_weak_hash_value_slot): Adapt to
hash_table_kv.
(DOHASH [USE_EPHEMERON_POOL]): New version.
* src/igc.h (enum igc_obj_type): Add IGC_OBJ_PAIR_VECTOR,
IGC_OBJ_WEAK_KEY_PAIR_VECTOR, IGC_OBJ_WEAK_VALUE_PAIR_VECTOR,
IGC_OBJ_WEAK_OR_PAIR_VECTOR.
(igc_alloc_pair_vector): New prototype.
* src/igc.c (obj_type_names, set_header, dflt_scan_obj, thread_ap):
Handle new tpes.
(struct igc_thread, create_ephemeron_ap, create_thread_aps)
(igc_thread_remove): Add allocation point for ephemeron pool.
(struct igc, make_pool_aeph, make_igc): Add ephemeron pool.
(as_igc_header, fix_pair_vector, decode_ptr, encode_ptr)
(increment_ndeleted, splat_pair, fix_weak_key_pair, fix_weak_value_pair)
(fix_weak_or_pair, fix_weak_and_pair, scan_pair_vector)
(fix_weak_key_pair_vector, fix_weak_value_pair_vector)
(fix_weak_or_pair_vector, fix_weak_and_pair_vector): New helpers.
(fix_hash_table, fix_weak_hash_table_strong_part)
(fix_weak_hash_table_weak_part): Adapt to hash_table_kv.
(igc_alloc_pair_vector): New function.
* src/fns.c (maybe_resize_hash_table): Call maybe_resize_hash_table.
(Fgethash): Add assertion for HASH_UNUSED_ENTRY_KEY.
(Fhash_table_count): Take deleted entries into account.
(hash_table_kv_init, hash_table_kv_create)
(hash_table_kv_resize, hash_table_kv_free): New helpers.
(hash_table_kv_ndeleted, hash_table_ndeleted)
(hash_table_count, reclaim_deleted_entries)
(maybe_reclaim_deleted_entries): New helpers.
(make_hash_table, copy_hash_table, hash_table_thaw, hash_table_rehash)
(allocate_weak_hash_table_parts, make_weak_hash_table)
(maybe_resize_weak_hash_table): Adapt to hash_table_kv.
* src/alloc.c (cleanup_vector): Adapt to hash_table_kv.
* src/pdumper.c (hash_table_contents, hash_table_freeze)
(dump_hash_table): Adapt to hash_table_kv.
(dump_hash_table_kv_slot, dump_hash_table_kv, dump_hash_table_kv_part):
New helpers.
* src/print.c (print_object): Use Fhash_table_count instead
of the h->count field.
* test/src/fns-tests.el (ft--check-entries): Check hash-table-count.
(ft-weak-fixnums2, ft--test-weak-fixnums2): New test.
(ft--test-ephemeron-table): Better check for hash-table-count.
This commit is contained in:
Helmut Eller 2026-02-02 22:29:19 +01:00
parent e8b9677acd
commit 51f686e688
10 changed files with 992 additions and 164 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/alloc.c
View file

@ -3327,12 +3327,10 @@ cleanup_vector (struct Lisp_Vector *vector)
{
eassert (h->index_bits > 0);
xfree (h->index);
xfree (h->key);
xfree (h->value);
hash_table_kv_free (h->kv, h->table_size);
xfree (h->next);
xfree (h->hash);
ptrdiff_t bytes = (h->table_size * (2 * sizeof *h->key
+ sizeof *h->hash
ptrdiff_t bytes = (h->table_size * (sizeof *h->hash
+ sizeof *h->next)
+ hash_table_index_size (h) * sizeof *h->index);
hash_table_allocated_bytes -= bytes;
@ -6846,8 +6844,8 @@ process_mark_stack (ptrdiff_t base_sp)
/* The values pushed here may include
HASH_UNUSED_ENTRY_KEY, which this function must
cope with. */
mark_stack_push_values (h->key, h->table_size);
mark_stack_push_values (h->value, h->table_size);
mark_stack_push_values (h->kv.keys, h->table_size);
mark_stack_push_values (h->kv.values, h->table_size);
}
else
{

2
src/data.c
View file

@ -254,7 +254,7 @@ a fixed set of types. */)
case PVEC_BOOL_VECTOR: return Qbool_vector;
case PVEC_FRAME: return Qframe;
case PVEC_HASH_TABLE: return Qhash_table;
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
case PVEC_WEAK_HASH_TABLE: return Qhash_table;
#endif
case PVEC_OBARRAY: return Qobarray;

288
src/fns.c
View file

@ -4823,7 +4823,7 @@ compute_hash_index_bits (hash_idx_t size)
This avoids allocating it from the heap. */
static const hash_idx_t empty_hash_index_vector[] = {-1};
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
static struct Lisp_Weak_Hash_Table *allocate_weak_hash_table
(hash_table_weakness_t weak, ssize_t size, ssize_t index_bits);
@ -4832,6 +4832,63 @@ static Lisp_Object make_weak_hash_table (const struct hash_table_test *test,
hash_table_weakness_t weak);
#endif
static void
hash_table_kv_init (hash_table_kv kv, size_t start, size_t end)
{
for (size_t i = start; i < end; i++)
{
hash_table_kv_set_key (kv, i, HASH_UNUSED_ENTRY_KEY);
hash_table_kv_set_value (kv, i, Qnil);
}
}
hash_table_kv
hash_table_kv_create (size_t size, hash_table_weakness_t w)
{
#ifndef USE_EPHEMERON_POOL
hash_table_kv kv2 = {
.keys = hash_table_alloc_kv (NULL, size),
.values = hash_table_alloc_kv (NULL, size),
};
#else
hash_table_kv kv2 = igc_alloc_pair_vector (size, w);
#endif
hash_table_kv_init (kv2, 0, size);
return kv2;
}
static hash_table_kv
hash_table_kv_resize (hash_table_kv kv, hash_table_weakness_t w,
size_t old_size, size_t new_size)
{
#ifndef USE_EPHEMERON_POOL
hash_table_kv kv2 = {
.keys = hash_table_alloc_kv (NULL, new_size),
.values = hash_table_alloc_kv (NULL, new_size),
};
#else
hash_table_kv kv2 = igc_alloc_pair_vector (new_size, w);
eassert (kv == NULL || NILP (kv->ndeleted));
#endif
for (size_t i = 0; i < old_size; i++)
{
hash_table_kv_set_key (kv2, i, hash_table_kv_key (kv, i));
hash_table_kv_set_value (kv2, i, hash_table_kv_value (kv, i));
}
hash_table_kv_init (kv2, old_size, new_size);
return kv2;
}
void
hash_table_kv_free (hash_table_kv kv, size_t old_size)
{
#ifndef USE_EPHEMERON_POOL
hash_table_free_kv (NULL, kv.keys, old_size);
hash_table_free_kv (NULL, kv.values, old_size);
#else
#endif
}
/* Create and initialize a new hash table.
TEST specifies the test the hash table will use to compare keys.
@ -4850,7 +4907,7 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size,
eassert (SYMBOLP (test->name));
eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
if (weak != Weak_None)
{
return make_weak_hash_table (test, size, weak);
@ -4865,8 +4922,7 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size,
if (size == 0)
{
h->key = NULL;
h->value = NULL;
h->kv = hash_table_kv_null ();
h->hash = NULL;
h->next = NULL;
h->index_bits = 0;
@ -4875,17 +4931,7 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size,
}
else
{
Lisp_KV_Vector key = hash_table_alloc_kv (h, size);
Lisp_KV_Vector value = hash_table_alloc_kv (h, size);
for (ptrdiff_t i = 0; i < size; i++)
{
kv_vector_data (key)[i] = HASH_UNUSED_ENTRY_KEY;
kv_vector_data (value)[i] = Qnil;
}
/* Initialize, then set. */
h->key = key;
h->value = value;
h->kv = hash_table_kv_create (size, weak);
h->hash = hash_table_alloc_bytes (size * sizeof *h->hash);
@ -4897,7 +4943,8 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size,
int index_bits = compute_hash_index_bits (size);
h->index_bits = index_bits;
ptrdiff_t index_size = hash_table_index_size (h);
h->index = hash_table_alloc_bytes (index_size * sizeof *h->index);
h->index
= hash_table_alloc_bytes (index_size * sizeof *h->index);
for (ptrdiff_t i = 0; i < index_size; i++)
h->index[i] = -1;
@ -4924,19 +4971,14 @@ copy_hash_table (struct Lisp_Hash_Table *h1)
if (h1->table_size > 0)
{
ptrdiff_t kv_bytes = h1->table_size * word_size;
Lisp_KV_Vector key = hash_table_alloc_kv (h2, h1->table_size);
Lisp_KV_Vector value = hash_table_alloc_kv (h2, h1->table_size);
memcpy (kv_vector_data(key), kv_vector_data (h1->key), kv_bytes);
memcpy (kv_vector_data(value), kv_vector_data (h1->value), kv_bytes);
h2->key = key;
h2->value = value;
ptrdiff_t hash_bytes = h1->table_size * sizeof *h1->hash;
ptrdiff_t size = h1->table_size;
h2->kv
= hash_table_kv_resize (h1->kv, h1->weakness, size, size);
ptrdiff_t hash_bytes = size * sizeof *h1->hash;
h2->hash = hash_table_alloc_bytes (hash_bytes);
memcpy (h2->hash, h1->hash, hash_bytes);
ptrdiff_t next_bytes = h1->table_size * sizeof *h1->next;
ptrdiff_t next_bytes = size * sizeof *h1->next;
h2->next = hash_table_alloc_bytes (next_bytes);
memcpy (h2->next, h1->next, next_bytes);
@ -4954,12 +4996,99 @@ hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash)
return knuth_hash (hash, h->index_bits);
}
#ifdef USE_EPHEMERON_POOL
static size_t
hash_table_kv_ndeleted (hash_table_kv kv)
{
return NILP (kv->ndeleted) ? 0 : XFIXNUM (kv->ndeleted);
}
static size_t
hash_table_ndeleted (struct Lisp_Hash_Table *h)
{
return (h->kv == NULL) ? 0 : hash_table_kv_ndeleted (h->kv);
}
#endif
static size_t
hash_table_count (struct Lisp_Hash_Table *h)
{
#ifndef USE_EPHEMERON_POOL
return h->count;
#else
size_t ndel = (h->kv == NULL) ? 0 : hash_table_kv_ndeleted (h->kv);
return h->count - ndel;
#endif
}
#ifdef USE_EPHEMERON_POOL
/* Reclaim those entries that the GC has marked as unused. */
static void
reclaim_deleted_entries (struct Lisp_Hash_Table *h)
{
eassert (h->count > 0);
size_t ndeleted = hash_table_kv_ndeleted (h->kv);
size_t reclaimed = 0;
/* For each collision chain, ... */
for (ptrdiff_t bucket = 0, index_size = hash_table_index_size (h);
bucket < index_size; bucket++)
/* ... follow the collision chain, reclaiming unused entries. */
for (ptrdiff_t prev = -1, i = HASH_INDEX (h, bucket), next;
i != -1; i = next)
{
next = HASH_NEXT (h, i);
if (hash_unused_entry_key_p (HASH_KEY (h, i)))
{
/* Take out of collision chain. */
if (prev == -1)
set_hash_index_slot (h, bucket, next);
else
set_hash_next_slot (h, prev, next);
/* Add to free list. */
set_hash_next_slot (h, i, h->next_free);
h->next_free = i;
reclaimed++;
eassert (
BASE_EQ (HASH_KEY (h, i), HASH_UNUSED_ENTRY_KEY));
eassert (BASE_EQ (HASH_VALUE (h, i), Qnil));
}
else
prev = i;
}
/* FIXME/igc: use atomic_compare_exchange */
eassert (ndeleted == hash_table_kv_ndeleted (h->kv));
eassert (ndeleted == reclaimed);
h->kv->ndeleted = Qnil;
h->count -= ndeleted;
}
#endif
static bool
maybe_reclaim_deleted_entries (struct Lisp_Hash_Table *h)
{
#ifdef USE_EPHEMERON_POOL
if (hash_table_ndeleted (h) > 0)
{
reclaim_deleted_entries (h);
return true;
}
else
return false;
#else
return false;
#endif
}
/* Resize hash table H if it's too full. If H cannot be resized
because it's already too large, throw an error. */
static void
maybe_resize_hash_table (struct Lisp_Hash_Table *h)
{
maybe_reclaim_deleted_entries (h);
if (h->next_free < 0)
{
ptrdiff_t old_size = HASH_TABLE_SIZE (h);
@ -4978,16 +5107,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
next[i] = i + 1;
next[new_size - 1] = -1;
size_t kv_bytes = old_size * word_size;
Lisp_KV_Vector key = hash_table_alloc_kv (h, new_size);
Lisp_KV_Vector value = hash_table_alloc_kv (h, new_size);
memcpy (kv_vector_data (key), kv_vector_data (h->key), kv_bytes);
memcpy (kv_vector_data (value), kv_vector_data (h->value), kv_bytes);
for (ptrdiff_t i = old_size; i < new_size; i++)
{
kv_vector_data (key)[i] = HASH_UNUSED_ENTRY_KEY;
kv_vector_data (value)[i] = Qnil;
}
hash_table_kv kv2 = hash_table_kv_resize (h->kv, h->weakness,
old_size, new_size);
hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash);
memcpy (hash, h->hash, old_size * sizeof *hash);
@ -5007,12 +5128,9 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
hash_table_free_bytes (h->index, old_index_size * sizeof *h->index);
h->index = index;
Lisp_KV_Vector old = h->key;
h->key = key;
hash_table_free_kv (h, old, old_size);
old = h->value;
h->value = value;
hash_table_free_kv (h, old, old_size);
hash_table_kv old = h->kv;
h->kv = kv2;
hash_table_kv_free (old, old_size);
hash_table_free_bytes (h->hash, old_size * sizeof *h->hash);
h->hash = hash;
@ -5059,8 +5177,7 @@ hash_table_thaw (Lisp_Object hash_table)
if (size == 0)
{
h->key = NULL;
h->value = NULL;
h->kv = hash_table_kv_null ();
h->hash = NULL;
h->next = NULL;
h->index_bits = 0;
@ -5072,8 +5189,12 @@ hash_table_thaw (Lisp_Object hash_table)
h->index_bits = index_bits;
#ifdef HAVE_MPS
eassert (pdumper_object_p (h->key));
eassert (pdumper_object_p (h->value));
# ifndef USE_EPHEMERON_POOL
eassert (pdumper_object_p (h->kv.keys));
eassert (pdumper_object_p (h->kv.values));
# else
eassert (pdumper_object_p (h->kv));
# endif
#endif
h->hash = hash_table_alloc_bytes (size * sizeof *h->hash);
@ -5097,7 +5218,7 @@ hash_table_thaw (Lisp_Object hash_table)
}
}
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
void
weak_hash_table_thaw (Lisp_Object weak_hash_table)
{
@ -5127,19 +5248,15 @@ hash_table_rehash (struct Lisp_Hash_Table *h)
ptrdiff_t j = 0;
for (ptrdiff_t i = 0; i < h->table_size; ++i)
if (!hash_unused_entry_key_p (kv_vector_data (h->key)[i]))
if (!hash_unused_entry_key_p (HASH_KEY (h, i)))
{
h->key[j] = h->key[i];
h->value[j] = h->value[i];
set_hash_key_slot (h, j, HASH_KEY (h, i));
set_hash_value_slot (h, j, HASH_VALUE (h, i));
h->hash[j] = h->hash[i];
++j;
}
for (; j < h->table_size; ++j)
{
kv_vector_data (h->key)[j] = HASH_UNUSED_ENTRY_KEY;
kv_vector_data (h->value)[j] = Qnil;
}
hash_table_kv_init (h->kv, j, h->table_size);
if (h->count < h->table_size)
{
@ -5409,7 +5526,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
#endif // not HAVE_MPS
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
/* Hash value for KEY in hash table H. */
hash_hash_t
weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
@ -5486,17 +5603,17 @@ allocate_weak_hash_table_parts (struct Lisp_Weak_Hash_Table *h,
switch (weak)
{
case Weak_Key:
h->strong->h.key = weak_pointers[1];
h->strong->h.value = strong_pointers[4];
h->strong->h.kv.keys = weak_pointers[1];
h->strong->h.kv.values = strong_pointers[4];
break;
case Weak_Value:
h->strong->h.key = strong_pointers[4];
h->strong->h.value = weak_pointers[1];
h->strong->h.kv.keys = strong_pointers[4];
h->strong->h.kv.values = weak_pointers[1];
break;
case Weak_Key_And_Value:
case Weak_Key_Or_Value:
h->strong->h.key = weak_pointers[1];
h->strong->h.value = weak_pointers[2];
h->strong->h.kv.keys = weak_pointers[1];
h->strong->h.kv.values = weak_pointers[2];
break;
default:
emacs_abort ();
@ -5611,8 +5728,8 @@ make_weak_hash_table (const struct hash_table_test *test,
{
for (ptrdiff_t i = 0; i < size; i++)
{
h->strong->h.key->contents[i] = HASH_UNUSED_ENTRY_KEY;
h->strong->h.value->contents[i] = Qnil;
h->strong->h.kv.keys->contents[i] = HASH_UNUSED_ENTRY_KEY;
h->strong->h.kv.values->contents[i] = Qnil;
}
for (ptrdiff_t i = 0; i < size - 1; i++)
@ -5675,8 +5792,8 @@ maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
for (ptrdiff_t i = 0; i < new_size; i++)
{
h->strong->h.key->contents[i] = HASH_UNUSED_ENTRY_KEY;
h->strong->h.value->contents[i] = Qnil;
h->strong->h.kv.keys->contents[i] = HASH_UNUSED_ENTRY_KEY;
h->strong->h.kv.values->contents[i] = Qnil;
}
ptrdiff_t index_size = (ptrdiff_t) 1 << index_bits;
@ -6344,7 +6461,7 @@ DEFUN ("copy-hash-table", Fcopy_hash_table, Scopy_hash_table, 1, 1, 0,
doc: /* Return a copy of hash table TABLE. */)
(Lisp_Object table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
if (wh)
{
@ -6354,20 +6471,20 @@ DEFUN ("copy-hash-table", Fcopy_hash_table, Scopy_hash_table, 1, 1, 0,
return copy_hash_table (check_hash_table (table));
}
DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
doc: /* Return the number of elements in TABLE. */)
(Lisp_Object table)
{
#ifdef HAVE_MPS
struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
struct Lisp_Weak_Hash_Table *wh
= check_maybe_weak_hash_table (table);
if (wh)
{
table = strong_copy_hash_table (table);
}
#endif
struct Lisp_Hash_Table *h = check_hash_table (table);
return make_fixnum (h->count);
return make_fixnum (hash_table_count (h));
}
@ -6378,7 +6495,7 @@ This function is for compatibility only; it returns a nominal value
without current significance. */)
(Lisp_Object table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
if (!WEAK_HASH_TABLE_P (table))
#endif
CHECK_HASH_TABLE (table);
@ -6393,7 +6510,7 @@ This function is for compatibility only; it returns a nominal value
without current significance. */)
(Lisp_Object table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
if (!WEAK_HASH_TABLE_P (table))
#endif
CHECK_HASH_TABLE (table);
@ -6412,7 +6529,7 @@ hold without growing, but since hash tables grow automatically, this
number is rarely of interest. */)
(Lisp_Object table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
if (WEAK_HASH_TABLE_P (table))
{
struct Lisp_Weak_Hash_Table *h = XWEAK_HASH_TABLE (table);
@ -6428,7 +6545,7 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0,
doc: /* Return the test TABLE uses. */)
(Lisp_Object table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
if (WEAK_HASH_TABLE_P (table))
{
struct Lisp_Weak_Hash_Table *h = XWEAK_HASH_TABLE (table);
@ -6457,7 +6574,7 @@ DEFUN ("hash-table-weakness", Fhash_table_weakness, Shash_table_weakness,
doc: /* Return the weakness of TABLE. */)
(Lisp_Object table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
if (WEAK_HASH_TABLE_P (table))
{
struct Lisp_Weak_Hash_Table *ht = XWEAK_HASH_TABLE (table);
@ -6472,7 +6589,7 @@ DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0,
doc: /* Return t if OBJ is a Lisp hash table object. */)
(Lisp_Object obj)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
return (HASH_TABLE_P (obj) || WEAK_HASH_TABLE_P (obj)) ? Qt : Qnil;
#else
return HASH_TABLE_P (obj) ? Qt : Qnil;
@ -6484,7 +6601,7 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
doc: /* Clear hash table TABLE and return it. */)
(Lisp_Object table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
if (wh)
{
@ -6508,7 +6625,7 @@ provided.
usage: (gethash KEY TABLE &optional DEFAULT) */)
(Lisp_Object key, Lisp_Object table, Lisp_Object dflt)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
if (wh)
{
@ -6518,6 +6635,7 @@ usage: (gethash KEY TABLE &optional DEFAULT) */)
#endif
struct Lisp_Hash_Table *h = check_hash_table (table);
ptrdiff_t i = hash_find (h, key);
eassert (!(i >= 0 && hash_unused_entry_key_p (HASH_VALUE (h, i))));
return i >= 0 ? HASH_VALUE (h, i) : dflt;
}
@ -6528,7 +6646,7 @@ If KEY is already present in table, replace its current value with
VALUE. In any case, return VALUE. */)
(Lisp_Object key, Lisp_Object value, Lisp_Object table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
if (wh)
{
@ -6575,7 +6693,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
doc: /* Remove KEY from TABLE. */)
(Lisp_Object key, Lisp_Object table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
if (wh)
{
@ -6611,7 +6729,7 @@ set a new value for KEY, or `remhash' to remove KEY.
`maphash' always returns nil. */)
(Lisp_Object function, Lisp_Object table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
if (WEAK_HASH_TABLE_P (table))
table = strong_copy_hash_table (table);
#endif
@ -6649,7 +6767,7 @@ DEFUN ("internal--hash-table-histogram",
doc: /* Bucket size histogram of HASH-TABLE. Internal use only. */)
(Lisp_Object hash_table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
if (WEAK_HASH_TABLE_P (hash_table))
return Qnil;
#endif
@ -6682,7 +6800,7 @@ DEFUN ("internal--hash-table-buckets",
Internal use only. */)
(Lisp_Object hash_table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
if (WEAK_HASH_TABLE_P (hash_table))
return Qnil;
#endif
@ -6708,7 +6826,7 @@ DEFUN ("internal--hash-table-index-size",
doc: /* Index size of HASH-TABLE. Internal use only. */)
(Lisp_Object hash_table)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
if (WEAK_HASH_TABLE_P (hash_table))
return make_int
(weak_hash_table_index_size (XWEAK_HASH_TABLE (hash_table)));

532
src/igc.c
View file

@ -483,8 +483,17 @@ static const char *obj_type_names[] = {
"IGC_OBJ_DUMPED_BUFFER_TEXT",
"IGC_OBJ_DUMPED_BIGNUM_DATA",
"IGC_OBJ_DUMPED_BYTES",
#ifndef USE_EPHEMERON_POOL
"IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART",
"IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART",
#endif
#ifdef USE_EPHEMERON_POOL
"IGC_OBJ_PAIR_VECTOR",
"IGC_OBJ_WEAK_KEY_PAIR_VECTOR",
"IGC_OBJ_WEAK_VALUE_PAIR_VECTOR",
"IGC_OBJ_WEAK_OR_PAIR_VECTOR",
"IGC_OBJ_WEAK_AND_PAIR_VECTOR",
#endif
};
static_assert (ARRAYELTS (obj_type_names) == IGC_OBJ_NUM_TYPES);
@ -512,7 +521,9 @@ static const char *pvec_type_names[] = {
"PVEC_BOOL_VECTOR",
"PVEC_BUFFER",
"PVEC_HASH_TABLE",
#ifndef USE_EPHEMERON_POOL
"PVEC_WEAK_HASH_TABLE",
#endif
#ifndef IN_MY_FORK
"PVEC_OBARRAY",
#endif
@ -850,8 +861,17 @@ void gc_init_header (union gc_header *header, enum igc_obj_type type)
case IGC_OBJ_DUMPED_BUFFER_TEXT:
case IGC_OBJ_DUMPED_BIGNUM_DATA:
case IGC_OBJ_DUMPED_BYTES:
#ifndef USE_EPHEMERON_POOL
case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
#endif
#ifdef USE_EPHEMERON_POOL
case IGC_OBJ_PAIR_VECTOR:
case IGC_OBJ_WEAK_KEY_PAIR_VECTOR:
case IGC_OBJ_WEAK_VALUE_PAIR_VECTOR:
case IGC_OBJ_WEAK_OR_PAIR_VECTOR:
case IGC_OBJ_WEAK_AND_PAIR_VECTOR:
#endif
case IGC_OBJ_NUM_TYPES:
emacs_abort ();
}
@ -943,8 +963,13 @@ struct igc_thread
mps_ap_t leaf_ap;
mps_ap_t weak_strong_ap;
mps_ap_t weak_weak_ap;
#ifndef USE_EPHEMERON_POOL
mps_ap_t weak_hash_strong_ap;
mps_ap_t weak_hash_weak_ap;
#endif
#ifdef USE_EPHEMERON_POOL
mps_ap_t ephemeron_ap;
#endif
mps_ap_t immovable_ap;
/* Quick access to the roots used for specpdl, bytecode stack and
@ -999,8 +1024,14 @@ struct igc
mps_pool_t leaf_pool;
mps_fmt_t weak_fmt;
mps_pool_t weak_pool;
#ifndef USE_EPHEMERON_POOL
mps_fmt_t weak_hash_fmt;
mps_pool_t weak_hash_pool;
#endif
#ifdef USE_EPHEMERON_POOL
mps_fmt_t ephemeron_fmt;
mps_pool_t ephemeron_pool;
#endif
mps_fmt_t immovable_fmt;
mps_pool_t immovable_pool;
@ -2090,10 +2121,342 @@ fix_handler (mps_ss_t ss, struct handler *h)
return MPS_RES_OK;
}
#ifdef USE_EPHEMERON_POOL
static struct igc_header *
as_igc_header (union gc_header *h) {
return (struct igc_header *)h;
}
static mps_res_t
fix_pair_vector (mps_ss_t ss, struct pair_vector *pv)
{
size_t nbytes = obj_size (as_igc_header (&pv->gc_header));
size_t header_size = offsetof (struct pair_vector, pairs);
size_t npairs = (nbytes - header_size) / sizeof pv->pairs[0];
MPS_SCAN_BEGIN (ss)
{
for (size_t i = 0; i < npairs; i++)
{
IGC_FIX12_OBJ (ss, &pv->pairs[i].key);
IGC_FIX12_OBJ (ss, &pv->pairs[i].value);
}
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
static void*
decode_ptr (Lisp_Object o)
{
enum Lisp_Type tag = XTYPE (o);
switch (tag)
{
case Lisp_Cons:
return XCONS (o);
case Lisp_Symbol:
return NILP (o) ? NULL : XSYMBOL (o);
case Lisp_Int0:
case Lisp_Int1:
return NULL;
case Lisp_String:
return XSTRING (o);
case Lisp_Vectorlike:
return XVECTOR (o);
case Lisp_Float:
return XFLOAT (o);
case Lisp_Type_Unused0:
emacs_abort ();
}
emacs_abort ();
}
static Lisp_Object
encode_ptr (void *ptr, Lisp_Object orig)
{
enum Lisp_Type tag = XTYPE (orig);
switch (tag)
{
case Lisp_String:
case Lisp_Cons:
case Lisp_Float:
case Lisp_Vectorlike:
return make_lisp_ptr (ptr, tag);
case Lisp_Symbol:
return make_lisp_symbol (ptr);
case Lisp_Int0:
case Lisp_Int1:
case Lisp_Type_Unused0:
emacs_abort ();
}
emacs_abort ();
}
static void
increment_ndeleted (struct pair_vector *pv)
{
EMACS_INT n = NILP (pv->ndeleted) ? 0 : XFIXNUM (pv->ndeleted);
pv->ndeleted = make_fixnum (n + 1);
}
static void
splat_pair (struct pair_vector *pv, Lisp_Object *keyptr,
Lisp_Object *valptr)
{
*keyptr = HASH_UNUSED_ENTRY_KEY;
*valptr = Qnil;
increment_ndeleted (pv);
}
static mps_res_t
fix_weak_key_pair (mps_ss_t ss, struct pair_vector *pv,
Lisp_Object *keyptr, Lisp_Object *valptr)
{
Lisp_Object key = *keyptr;
Lisp_Object val = *valptr;
void *k = decode_ptr (key);
void *v = decode_ptr (val);
mps_res_t res;
if (k != NULL && v != NULL)
{
res = mps_fix_weak_pair (ss, pv, &k, &v);
if (res != MPS_RES_OK)
return res;
if (k == NULL)
splat_pair (pv, keyptr, valptr);
else
{
igc_assert (v != NULL);
*keyptr = encode_ptr (k, key);
*valptr = encode_ptr (v, val);
}
return MPS_RES_OK;
}
else if (k != NULL && v == NULL)
{
res = mps_fix_weak_pair (ss, pv, &k, &v);
if (res != MPS_RES_OK)
return res;
if (k == NULL)
splat_pair (pv, keyptr, valptr);
else
*keyptr = encode_ptr (k, key);
return MPS_RES_OK;
}
else if (k == NULL && v != NULL)
{
MPS_SCAN_BEGIN (ss) { IGC_FIX12_OBJ (ss, valptr); }
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
else
return MPS_RES_OK;
}
static mps_res_t
fix_weak_value_pair (mps_ss_t ss, struct pair_vector *pv,
Lisp_Object *keyptr, Lisp_Object *valptr)
{
Lisp_Object key = *keyptr;
Lisp_Object val = *valptr;
void *k = decode_ptr (key);
void *v = decode_ptr (val);
mps_res_t res;
if (k != NULL && v != NULL)
{
res = mps_fix_weak_pair (ss, pv, &v, &k);
if (res != MPS_RES_OK)
return res;
if (v == NULL)
splat_pair (pv, keyptr, valptr);
else
{
igc_assert (k != NULL);
*keyptr = encode_ptr (k, key);
*valptr = encode_ptr (v, val);
}
return MPS_RES_OK;
}
else if (k != NULL && v == NULL)
{
MPS_SCAN_BEGIN (ss) { IGC_FIX12_OBJ (ss, keyptr); }
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
else if (k == NULL && v != NULL)
{
res = mps_fix_weak_pair (ss, pv, &v, &k);
if (res != MPS_RES_OK)
return res;
if (v == NULL)
splat_pair (pv, keyptr, valptr);
else
{
igc_assert (k == NULL);
*valptr = encode_ptr (v, val);
}
return MPS_RES_OK;
}
else
return MPS_RES_OK;
}
static mps_res_t
fix_weak_or_pair (mps_ss_t ss, struct pair_vector *pv,
Lisp_Object *keyptr, Lisp_Object *valptr)
{
Lisp_Object key = *keyptr;
Lisp_Object val = *valptr;
void *k = decode_ptr (key);
void *v = decode_ptr (val);
mps_res_t res;
if (k != NULL && v != NULL)
{
res = mps_fix_weak_or_pair (ss, pv, &k, &v);
if (res != MPS_RES_OK)
return res;
if (k == NULL)
splat_pair (pv, keyptr, valptr);
else
{
igc_assert (k != NULL);
*keyptr = encode_ptr (k, key);
*valptr = encode_ptr (v, val);
}
return MPS_RES_OK;
}
else if (k != NULL && v == NULL)
{
MPS_SCAN_BEGIN (ss) { IGC_FIX12_OBJ (ss, keyptr); }
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
else if (k == NULL && v != NULL)
{
MPS_SCAN_BEGIN (ss) { IGC_FIX12_OBJ (ss, valptr); }
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
else
return MPS_RES_OK;
}
static mps_res_t
fix_weak_and_pair (mps_ss_t ss, struct pair_vector *pv,
Lisp_Object *keyptr, Lisp_Object *valptr)
{
Lisp_Object key = *keyptr;
Lisp_Object val = *valptr;
void *k = decode_ptr (key);
void *v = decode_ptr (val);
mps_res_t res;
if (k != NULL && v != NULL)
{
res = mps_fix_weak_and_pair (ss, pv, &k, &v);
if (res != MPS_RES_OK)
return res;
if (k == NULL)
splat_pair (pv, keyptr, valptr);
else
{
igc_assert (k != NULL);
*keyptr = encode_ptr (k, key);
*valptr = encode_ptr (v, val);
}
return MPS_RES_OK;
}
else if (k != NULL && v == NULL)
{
res = mps_fix_weak_and_pair (ss, pv, &v, &k);
if (res != MPS_RES_OK)
return res;
if (k == NULL)
splat_pair (pv, keyptr, valptr);
else
{
igc_assert (v == NULL);
*keyptr = encode_ptr (k, key);
}
return MPS_RES_OK;
}
else if (k == NULL && v != NULL)
{
res = mps_fix_weak_and_pair (ss, pv, &v, &k);
if (res != MPS_RES_OK)
return res;
if (v == NULL)
splat_pair (pv, keyptr, valptr);
else
{
igc_assert (k == NULL);
*valptr = encode_ptr (v, val);
}
return MPS_RES_OK;
}
else
return MPS_RES_OK;
}
typedef mps_res_t (*fix_weak_pair) (mps_ss_t ss, struct pair_vector *,
Lisp_Object *keyptr,
Lisp_Object *valptr);
static mps_res_t
scan_pair_vector (mps_ss_t ss, struct pair_vector *pv, fix_weak_pair f)
{
size_t nbytes = obj_size (as_igc_header (&pv->gc_header));
size_t header_size = offsetof (struct pair_vector, pairs);
size_t npairs = (nbytes - header_size) / sizeof pv->pairs[0];
for (size_t i = 0; i < npairs; i++)
{
Lisp_Object *k = &pv->pairs[i].key;
Lisp_Object *v = &pv->pairs[i].value;
mps_res_t res = f (ss, pv, k, v);
if (res != MPS_RES_OK)
return res;
}
return MPS_RES_OK;
}
static mps_res_t
fix_weak_key_pair_vector (mps_ss_t ss, struct pair_vector *pv)
{
return scan_pair_vector (ss, pv, fix_weak_key_pair);
}
static mps_res_t
fix_weak_value_pair_vector (mps_ss_t ss, struct pair_vector *pv)
{
return scan_pair_vector (ss, pv, fix_weak_value_pair);
}
static mps_res_t
fix_weak_or_pair_vector (mps_ss_t ss, struct pair_vector *pv)
{
return scan_pair_vector (ss, pv, fix_weak_or_pair);
}
static mps_res_t
fix_weak_and_pair_vector (mps_ss_t ss, struct pair_vector *pv)
{
return scan_pair_vector (ss, pv, fix_weak_and_pair);
}
#endif
static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v);
static mps_res_t fix_marker_vector (mps_ss_t ss, struct Lisp_Vector *v);
#ifndef USE_EPHEMERON_POOL
static mps_res_t fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong_Part *t);
static mps_res_t fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Part *w);
#endif
static void
collect_stats_1 (struct igc_stat *s, size_t nbytes)
@ -2214,7 +2577,7 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t start)
IGC_FIX_CALL_FN (ss, struct Lisp_Buffer_Local_Value, addr,
fix_blv);
break;
#ifndef USE_EPHEMERON_POOL
case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Strong_Part, addr,
fix_weak_hash_table_strong_part);
@ -2223,6 +2586,32 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t start)
IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Weak_Part, addr,
fix_weak_hash_table_weak_part);
break;
#endif
#ifdef USE_EPHEMERON_POOL
case IGC_OBJ_PAIR_VECTOR:
IGC_FIX_CALL_FN (ss, struct pair_vector, addr, fix_pair_vector);
break;
case IGC_OBJ_WEAK_KEY_PAIR_VECTOR:
IGC_FIX_CALL_FN (ss, struct pair_vector, addr,
fix_weak_key_pair_vector);
break;
case IGC_OBJ_WEAK_VALUE_PAIR_VECTOR:
IGC_FIX_CALL_FN (ss, struct pair_vector, addr,
fix_weak_value_pair_vector);
break;
case IGC_OBJ_WEAK_OR_PAIR_VECTOR:
IGC_FIX_CALL_FN (ss, struct pair_vector, addr,
fix_weak_or_pair_vector);
break;
case IGC_OBJ_WEAK_AND_PAIR_VECTOR:
IGC_FIX_CALL_FN (ss, struct pair_vector, addr,
fix_weak_and_pair_vector);
break;
#endif
}
}
MPS_SCAN_END (ss);
@ -2448,8 +2837,12 @@ fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h)
{
MPS_SCAN_BEGIN (ss)
{
IGC_FIX12_PVEC (ss, &h->key);
IGC_FIX12_PVEC (ss, &h->value);
#ifndef USE_EPHEMERON_POOL
IGC_FIX12_PVEC (ss, &h->kv.keys);
IGC_FIX12_PVEC (ss, &h->kv.values);
#else
IGC_FIX12_RAW (ss, &h->kv);
#endif
IGC_FIX12_WRAPPED_BYTES (ss, &h->hash);
IGC_FIX12_WRAPPED_BYTES (ss, &h->next);
/* If h->table_size == 0, h->index is empty_hash_index_vector which
@ -2461,6 +2854,7 @@ fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h)
return MPS_RES_OK;
}
#ifndef USE_EPHEMERON_POOL
static mps_res_t
fix_weak_hash_table (mps_ss_t ss, struct Lisp_Weak_Hash_Table *h)
{
@ -2502,10 +2896,10 @@ fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong
for (ssize_t i = 0; i < t->h.table_size; i++)
{
if (scan_key)
IGC_FIX12_OBJ (ss, &t->h.key->contents[i]);
IGC_FIX12_OBJ (ss, &t->h.kv.keys->contents[i]);
if (scan_value)
IGC_FIX12_OBJ (ss, &t->h.value->contents[i]);
IGC_FIX12_OBJ (ss, &t->h.kv.values->contents[i]);
}
}
}
@ -2545,9 +2939,9 @@ fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Par
{
if (scan_key)
{
bool was_nil = NILP (t->h.key->contents[i]);
IGC_FIX12_OBJ (ss, &t->h.key->contents[i]);
bool is_now_nil = NILP (t->h.key->contents[i]);
bool was_nil = NILP (t->h.kv.keys->contents[i]);
IGC_FIX12_OBJ (ss, &t->h.kv.keys->contents[i]);
bool is_now_nil = NILP (t->h.kv.keys->contents[i]);
if (is_now_nil && !was_nil)
{
@ -2562,9 +2956,9 @@ fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Par
if (scan_value)
{
bool was_nil = NILP (t->h.value->contents[i]);
IGC_FIX12_OBJ (ss, &t->h.value->contents[i]);
bool is_now_nil = NILP (t->h.value->contents[i]);
bool was_nil = NILP (t->h.kv.values->contents[i]);
IGC_FIX12_OBJ (ss, &t->h.kv.values->contents[i]);
bool is_now_nil = NILP (t->h.kv.values->contents[i]);
if (is_now_nil && !was_nil)
{
@ -2582,6 +2976,7 @@ fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Par
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
#endif
static mps_res_t
fix_char_table (mps_ss_t ss, struct Lisp_Vector *v)
@ -2885,9 +3280,11 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
IGC_FIX_CALL_FN (ss, struct Lisp_Hash_Table, v, fix_hash_table);
break;
#ifndef USE_EPHEMERON_POOL
case PVEC_WEAK_HASH_TABLE:
IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table, v, fix_weak_hash_table);
break;
#endif
case PVEC_CHAR_TABLE:
case PVEC_SUB_CHAR_TABLE:
@ -3312,6 +3709,7 @@ create_weak_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
return res;
}
#ifndef USE_EPHEMERON_POOL
static mps_res_t
create_weak_hash_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
{
@ -3328,6 +3726,7 @@ create_weak_hash_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
IGC_CHECK_RES (res);
return res;
}
#endif
static mps_res_t
create_oldgen_ap (mps_ap_t *ap, mps_pool_t pool, size_t gen_count)
@ -3343,6 +3742,23 @@ create_oldgen_ap (mps_ap_t *ap, mps_pool_t pool, size_t gen_count)
return res;
}
#ifdef USE_EPHEMERON_POOL
static mps_res_t
create_ephemeron_ap (mps_ap_t *ap, mps_pool_t pool)
{
mps_res_t res;
MPS_ARGS_BEGIN (args)
{
MPS_ARGS_ADD (args, MPS_KEY_RANK, mps_rank_ephemeron ());
res = mps_ap_create_k (ap, pool, args);
}
MPS_ARGS_END (args);
IGC_CHECK_RES (res);
return res;
}
#endif
static void
create_thread_aps (struct igc_thread *t)
{
@ -3356,12 +3772,18 @@ create_thread_aps (struct igc_thread *t)
IGC_CHECK_RES (res);
res = create_weak_ap (&t->weak_strong_ap, t, false);
IGC_CHECK_RES (res);
res = create_weak_hash_ap (&t->weak_hash_strong_ap, t, false);
IGC_CHECK_RES (res);
res = create_weak_ap (&t->weak_weak_ap, t, true);
IGC_CHECK_RES (res);
#ifndef USE_EPHEMERON_POOL
res = create_weak_hash_ap (&t->weak_hash_strong_ap, t, false);
IGC_CHECK_RES (res);
res = create_weak_hash_ap (&t->weak_hash_weak_ap, t, true);
IGC_CHECK_RES (res);
#endif
#ifdef USE_EPHEMERON_POOL
res = create_ephemeron_ap (&t->ephemeron_ap, gc->ephemeron_pool);
IGC_CHECK_RES (res);
#endif
}
static struct igc_thread_list *
@ -3421,8 +3843,13 @@ igc_thread_remove (void **pinfo)
mps_ap_destroy (t->d.leaf_ap);
mps_ap_destroy (t->d.weak_strong_ap);
mps_ap_destroy (t->d.weak_weak_ap);
#ifndef USE_EPHEMERON_POOL
mps_ap_destroy (t->d.weak_hash_strong_ap);
mps_ap_destroy (t->d.weak_hash_weak_ap);
#endif
#ifdef USE_EPHEMERON_POOL
mps_ap_destroy (t->d.ephemeron_ap);
#endif
mps_ap_destroy (t->d.immovable_ap);
mps_thread_dereg (deregister_thread (t));
}
@ -3914,7 +4341,9 @@ finalize_vector (mps_addr_t v)
case PVEC_OBARRAY:
#endif
case PVEC_HASH_TABLE:
#ifndef USE_EPHEMERON_POOL
case PVEC_WEAK_HASH_TABLE:
#endif
case PVEC_SYMBOL_WITH_POS:
case PVEC_PROCESS:
case PVEC_RECORD:
@ -4023,7 +4452,9 @@ maybe_finalize (mps_addr_t ref, enum pvec_type tag)
case PVEC_OBARRAY:
#endif
case PVEC_HASH_TABLE:
#ifndef USE_EPHEMERON_POOL
case PVEC_WEAK_HASH_TABLE:
#endif
case PVEC_NORMAL_VECTOR:
case PVEC_FREE:
case PVEC_MARKER:
@ -4324,11 +4755,24 @@ thread_ap (enum igc_obj_type type)
case IGC_OBJ_MARKER_VECTOR:
return t->d.weak_weak_ap;
#ifndef USE_EPHEMERON_POOL
case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
return t->d.weak_hash_weak_ap;
case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
return t->d.weak_hash_strong_ap;
#endif
#ifdef USE_EPHEMERON_POOL
case IGC_OBJ_PAIR_VECTOR:
return t->d.dflt_ap;
case IGC_OBJ_WEAK_KEY_PAIR_VECTOR:
case IGC_OBJ_WEAK_VALUE_PAIR_VECTOR:
case IGC_OBJ_WEAK_OR_PAIR_VECTOR:
case IGC_OBJ_WEAK_AND_PAIR_VECTOR:
return t->d.ephemeron_ap;
#endif
case IGC_OBJ_VECTOR:
case IGC_OBJ_CONS:
@ -4441,6 +4885,7 @@ igc_hash (Lisp_Object key)
return igc_header_hash (h);
}
#ifndef USE_EPHEMERON_POOL
/* Allocate a number of (Emacs) objects in one contiguous MPS object.
This is necessary for weak hash tables because only a single
dependent object is allowed for each MPS object. */
@ -4500,6 +4945,7 @@ alloc_multi (ptrdiff_t count, mps_addr_t ret[count],
off += sizes[i];
}
}
#endif
/* Allocate an object of client size SIZE and of type TYPE from
allocation point AP. Value is a pointer to the new object. */
@ -4733,6 +5179,7 @@ igc_alloc_lisp_obj_vec (size_t n)
return XVECTOR (v)->contents;
}
#ifndef USE_EPHEMERON_POOL
static mps_addr_t
weak_hash_find_dependent (mps_addr_t addr)
{
@ -4755,6 +5202,7 @@ weak_hash_find_dependent (mps_addr_t addr)
return 0;
}
#endif
struct Lisp_Vector *
igc_make_hash_table_vec (size_t n)
@ -4762,6 +5210,7 @@ igc_make_hash_table_vec (size_t n)
return XVECTOR (make_vector (n, Qnil));
}
#ifndef USE_EPHEMERON_POOL
void
igc_alloc_weak_hash_table_strong_part (hash_table_weakness_t weak,
void *pointers[5],
@ -4825,6 +5274,42 @@ igc_alloc_weak_hash_table_weak_part (hash_table_weakness_t weak,
alloc_multi (sizes[2] ? 3 : 2, pointers, sizes, types,
thread_ap (types[0]));
}
#endif
#ifdef USE_EPHEMERON_POOL
struct pair_vector *
igc_alloc_pair_vector (size_t len, hash_table_weakness_t w)
{
struct pair_vector *r;
size_t header_size = offsetof (struct pair_vector, pairs);
size_t nbytes = header_size + len * sizeof r->pairs[0];
switch (w)
{
case Weak_None:
r = alloc (nbytes, IGC_OBJ_PAIR_VECTOR);
return r;
case Weak_Key:
r = alloc (nbytes, IGC_OBJ_WEAK_KEY_PAIR_VECTOR);
return r;
case Weak_Value:
r = alloc (nbytes, IGC_OBJ_WEAK_VALUE_PAIR_VECTOR);
return r;
case Weak_Key_Or_Value:
r = alloc (nbytes, IGC_OBJ_WEAK_OR_PAIR_VECTOR);
return r;
case Weak_Key_And_Value:
r = alloc (nbytes, IGC_OBJ_WEAK_AND_PAIR_VECTOR);
return r;
}
emacs_abort ();
}
#endif
#ifdef HAVE_WINDOW_SYSTEM
struct image_cache *
@ -5059,7 +5544,12 @@ IGC statistics:
walk_pool (gc, gc->dflt_pool, &st);
walk_pool (gc, gc->leaf_pool, &st);
walk_pool (gc, gc->weak_pool, &st);
#ifndef USE_EPHEMERON_POOL
walk_pool (gc, gc->weak_hash_pool, &st);
#endif
#ifdef USE_EPHEMERON_POOL
walk_pool (gc, gc->ephemeron_pool, &st);
#endif
walk_pool (gc, gc->immovable_pool, &st);
Lisp_Object result = Qnil;
@ -5350,6 +5840,12 @@ make_pool_awl0 (struct igc *gc, mps_fmt_t fmt,
find_dependent);
}
static mps_pool_t
make_pool_aeph (struct igc *gc, mps_fmt_t fmt)
{
return make_pool_with_class (gc, fmt, mps_class_aeph (), NULL);
}
static mps_pool_t
make_pool_amcz (struct igc *gc, mps_fmt_t fmt)
{
@ -5374,8 +5870,14 @@ make_igc (void)
gc->leaf_pool = make_pool_amcz (gc, gc->leaf_fmt);
gc->weak_fmt = make_dflt_fmt (gc);
gc->weak_pool = make_pool_awl0 (gc, gc->weak_fmt, NULL);
#ifndef USE_EPHEMERON_POOL
gc->weak_hash_fmt = make_dflt_fmt (gc);
gc->weak_hash_pool = make_pool_awl0 (gc, gc->weak_hash_fmt, weak_hash_find_dependent);
#endif
#ifdef USE_EPHEMERON_POOL
gc->ephemeron_fmt = make_dflt_fmt (gc);
gc->ephemeron_pool = make_pool_aeph (gc, gc->ephemeron_fmt);
#endif
gc->immovable_fmt = make_dflt_fmt (gc);
gc->immovable_pool = make_pool_amc (gc, gc->immovable_fmt);
@ -5717,9 +6219,11 @@ KEY is the key to associate with DEPENDENCY in a hash table. */)
struct igc_header *h = addr;
struct igc_exthdr *exthdr = igc_external_header (h, is_builtin_obj (obj));
Lisp_Object hash = exthdr->extra_dependency;
#ifndef USE_EPHEMERON_POOL
if (!WEAK_HASH_TABLE_P (hash))
exthdr->extra_dependency = hash =
CALLN (Fmake_hash_table, QCtest, Qeq, QCweakness, Qkey);
#endif
Lisp_Object hash2 = Fgethash (key, hash, Qnil);
if (NILP (hash2))
@ -5747,8 +6251,10 @@ KEY is the key associated with DEPENDENCY in a hash table. */)
struct igc_header *h = addr;
struct igc_exthdr *exthdr = igc_external_header (h, is_builtin_obj (repl));
Lisp_Object hash = exthdr->extra_dependency;
#ifndef USE_EPHEMERON_POOL
if (!WEAK_HASH_TABLE_P (hash))
return Qnil;
#endif
Lisp_Object hash2 = Fgethash (key, hash, Qnil);
if (NILP (hash2))

11
src/igc.h
View file

@ -52,8 +52,17 @@ enum igc_obj_type
IGC_OBJ_DUMPED_BUFFER_TEXT,
IGC_OBJ_DUMPED_BIGNUM_DATA,
IGC_OBJ_DUMPED_BYTES,
#ifndef USE_EPHEMERON_POOL
IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART,
IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART,
#endif
#ifdef USE_EPHEMERON_POOL
IGC_OBJ_PAIR_VECTOR,
IGC_OBJ_WEAK_KEY_PAIR_VECTOR,
IGC_OBJ_WEAK_VALUE_PAIR_VECTOR,
IGC_OBJ_WEAK_OR_PAIR_VECTOR,
IGC_OBJ_WEAK_AND_PAIR_VECTOR,
#endif
IGC_OBJ_NUM_TYPES
};
@ -138,6 +147,8 @@ void igc_grow_rdstack (struct read_stack *rs);
struct Lisp_Vector *igc_make_hash_table_vec (size_t n);
void igc_alloc_weak_hash_table_strong_part(hash_table_weakness_t, void *ptrs[5], size_t, size_t);
void igc_alloc_weak_hash_table_weak_part(hash_table_weakness_t, void *ptrs[3], size_t, size_t);
struct pair_vector *igc_alloc_pair_vector (size_t,
hash_table_weakness_t);
void *igc_alloc_bytes (size_t nbytes);
struct image_cache *igc_make_image_cache (void);
struct interval *igc_make_interval (void);

151
src/lisp.h
View file

@ -1037,7 +1037,7 @@ enum pvec_type
PVEC_BOOL_VECTOR,
PVEC_BUFFER,
PVEC_HASH_TABLE,
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
PVEC_WEAK_HASH_TABLE,
#endif
PVEC_OBARRAY,
@ -2611,7 +2611,10 @@ obarray_iter_symbol (obarray_iter_t *it)
/* The structure of a Lisp hash table. */
#ifndef USE_EPHEMERON_POOL
struct Lisp_Weak_Hash_Table;
#endif
struct Lisp_Hash_Table;
struct hash_impl;
@ -2669,6 +2672,7 @@ typedef enum hash_table_weakness_t {
(hash) indices. It's signed and a subtype of ptrdiff_t. */
typedef int32_t hash_idx_t;
#ifndef USE_EPHEMERON_POOL
struct Lisp_Weak_Hash_Table_Strong_Part;
struct Lisp_Weak_Hash_Table_Weak_Part
@ -2686,6 +2690,86 @@ struct Lisp_Weak_Hash_Table
Lisp_Object dump_replacement;
};
struct vector_pair
{
Lisp_KV_Vector keys, values;
};
#endif
#ifdef USE_EPHEMERON_POOL
struct pair_vector
{
GC_HEADER
/* nil or a positive fixnum. If non-nil, it's the number of (weak)
entries "splatted" by the GC. */
Lisp_Object ndeleted;
struct
{
Lisp_Object key, value;
} pairs[FLEXIBLE_ARRAY_MEMBER];
};
#endif
#ifndef USE_EPHEMERON_POOL
typedef struct vector_pair hash_table_kv;
#else
typedef struct pair_vector *hash_table_kv;
#endif
hash_table_kv hash_table_kv_create (size_t size, hash_table_weakness_t);
void hash_table_kv_free (hash_table_kv, size_t size);
INLINE Lisp_Object
hash_table_kv_key (hash_table_kv kv, size_t i)
{
#ifndef USE_EPHEMERON_POOL
return kv_vector_data (kv.keys)[i];
#else
return kv->pairs[i].key;
#endif
}
INLINE Lisp_Object
hash_table_kv_value (hash_table_kv kv, size_t i)
{
#ifndef USE_EPHEMERON_POOL
return kv_vector_data (kv.values)[i];
#else
return kv->pairs[i].value;
#endif
}
INLINE void
hash_table_kv_set_key (hash_table_kv kv, size_t i, Lisp_Object val)
{
#ifndef USE_EPHEMERON_POOL
kv_vector_data (kv.keys)[i] = val;
#else
kv->pairs[i].key = val;
#endif
}
INLINE void
hash_table_kv_set_value (hash_table_kv kv, size_t i, Lisp_Object val)
{
#ifndef USE_EPHEMERON_POOL
kv_vector_data (kv.values)[i] = val;
#else
kv->pairs[i].value = val;
#endif
}
INLINE hash_table_kv
hash_table_kv_null (void)
{
#ifndef USE_EPHEMERON_POOL
return (struct vector_pair) { NULL, NULL };
#else
return NULL;
#endif
}
struct Lisp_Hash_Table
{
struct vectorlike_header header;
@ -2731,8 +2815,7 @@ struct Lisp_Hash_Table
/* Vectors of keys and values. If the key is HASH_UNUSED_ENTRY_KEY,
then this slot is unused. This is gc_marked specially if the table
is weak. */
Lisp_KV_Vector key;
Lisp_KV_Vector value;
hash_table_kv kv;
/* The comparison and hash functions. */
const struct hash_table_test *test;
@ -2809,7 +2892,7 @@ XHASH_TABLE (Lisp_Object a)
return h;
}
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
INLINE bool
WEAK_HASH_TABLE_P (Lisp_Object a)
{
@ -2839,7 +2922,7 @@ INLINE Lisp_Object
HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
eassert (idx >= 0 && idx < h->table_size);
return kv_vector_data (h->key)[idx];
return hash_table_kv_key (h->kv, idx);
}
/* Value is the value part of entry IDX in hash table H. */
@ -2847,7 +2930,7 @@ INLINE Lisp_Object
HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
eassert (idx >= 0 && idx < h->table_size);
return kv_vector_data (h->value)[idx];
return hash_table_kv_value (h->kv, idx);
}
/* Value is the hash code computed for entry IDX in hash table H. */
@ -2879,7 +2962,7 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
return h->test->hashfn (key, h);
}
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
INLINE Lisp_Object
make_lisp_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
{
@ -2892,13 +2975,13 @@ INLINE Lisp_Object
WEAK_HASH_KEY (const struct Lisp_Weak_Hash_Table *wh, ptrdiff_t idx)
{
eassert (idx >= 0 && idx < wh->strong->h.table_size);
return wh->strong->h.key->contents[idx];
return wh->strong->h.kv.keys->contents[idx];
}
INLINE Lisp_Object
WEAK_HASH_VALUE (const struct Lisp_Weak_Hash_Table *wh, ptrdiff_t idx)
{
return wh->strong->h.value->contents[idx];
return wh->strong->h.kv.values->contents[idx];
}
/* Value is the hash code computed for entry IDX in hash table H. */
@ -2926,12 +3009,13 @@ weak_hash_table_index_size (const struct Lisp_Weak_Hash_Table *h)
extern hash_hash_t weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Object key);
#endif
#ifndef USE_EPHEMERON_POOL
/* Iterate K and V as key and value of valid entries in hash table H.
The body may remove the current entry or alter its value slot, but not
mutate TABLE in any other way. */
# define DOHASH(h, k, v) \
for (Lisp_Object *dohash_##k##_##v##_k = kv_vector_data ((h)->key), \
*dohash_##k##_##v##_v = kv_vector_data ((h)->value), \
for (Lisp_Object *dohash_##k##_##v##_k = kv_vector_data ((h)->kv.keys), \
*dohash_##k##_##v##_v = kv_vector_data ((h)->kv.values), \
*dohash_##k##_##v##_end = dohash_##k##_##v##_k \
+ HASH_TABLE_SIZE (h), \
*dohash_##k##_##v##_base = dohash_##k##_##v##_k, \
@ -2940,7 +3024,7 @@ extern hash_hash_t weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Obje
&& (k = dohash_##k##_##v##_k[0], \
v = dohash_##k##_##v##_v[0], /*maybe unused*/ (void)v, \
true); \
eassert (dohash_##k##_##v##_base == kv_vector_data ((h)->key) \
eassert (dohash_##k##_##v##_base == kv_vector_data ((h)->kv.keys) \
&& dohash_##k##_##v##_end \
== dohash_##k##_##v##_base \
+ HASH_TABLE_SIZE (h)), \
@ -2948,13 +3032,29 @@ extern hash_hash_t weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Obje
if (hash_unused_entry_key_p (k)) \
; \
else
#endif
#ifdef USE_EPHEMERON_POOL
# define DOHASH(h, k, v) \
for (Lisp_Object _dohash_i = make_fixnum (0), \
_dohash_end = make_fixnum (HASH_TABLE_SIZE (h)), \
k, v; \
XFIXNUM (_dohash_i) < XFIXNUM (_dohash_end) \
&& (k = HASH_KEY (h, XFIXNUM (_dohash_i)), \
v = HASH_VALUE (h, XFIXNUM (_dohash_i)), true); \
_dohash_i = make_fixnum (XFIXNUM (_dohash_i) + 1)) \
if (hash_unused_entry_key_p (k)) \
continue; \
else
#endif
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
/* Iterate K and V as key and value of valid entries in weak hash table H.
The body may remove the current entry or alter its value slot, but not
mutate TABLE in any other way. */
# define DOHASH_WEAK(ht, k, v) \
for (Lisp_Object *dohash_##k##_##v##_k = (ht)->strong->h.key->contents, \
*dohash_##k##_##v##_v = (ht)->strong->h.value->contents, \
for (Lisp_Object *dohash_##k##_##v##_k = (ht)->strong->h.kv.keys->contents, \
*dohash_##k##_##v##_v = (ht)->strong->h.kv.values->contents, \
*dohash_##k##_##v##_end = dohash_##k##_##v##_k \
+ WEAK_HASH_TABLE_SIZE (ht), \
*dohash_##k##_##v##_base = dohash_##k##_##v##_k; \
@ -2962,7 +3062,7 @@ extern hash_hash_t weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Obje
&& (k = dohash_##k##_##v##_k[0], \
v = dohash_##k##_##v##_v[0], \
true); \
eassert (dohash_##k##_##v##_base == (ht)->strong->h.key->contents \
eassert (dohash_##k##_##v##_base == (ht)->strong->h.kv.keys->contents \
&& dohash_##k##_##v##_end \
== dohash_##k##_##v##_base \
+ WEAK_HASH_TABLE_SIZE (ht)), \
@ -2972,6 +3072,7 @@ extern hash_hash_t weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Obje
else if (PSEUDOVECTORP (k, PVEC_FREE) || PSEUDOVECTORP (v, PVEC_FREE)) \
; \
else
#endif
/* Iterate I as index of valid entries in hash table H.
Unlike DOHASH, this construct copes with arbitrary table mutations
@ -2985,6 +3086,7 @@ extern hash_hash_t weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Obje
; \
else
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
/* Iterate I as index of valid entries in weak hash table H.
Unlike DOHASH, this construct copes with arbitrary table mutations
in the body. The consequences of such mutations are limited to
@ -2996,6 +3098,7 @@ extern hash_hash_t weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Obje
if (hash_unused_entry_key_p (WEAK_HASH_KEY (h, i))) \
; \
else
#endif
void hash_table_thaw (Lisp_Object hash_table);
void hash_table_rehash (struct Lisp_Hash_Table *h);
@ -4253,17 +4356,25 @@ INLINE void
set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
eassert (idx >= 0 && idx < h->table_size);
kv_vector_data (h->key)[idx] = val;
#ifndef USE_EPHEMERON_POOL
kv_vector_data (h->kv.keys)[idx] = val;
#else
h->kv->pairs[idx].key = val;
#endif
}
INLINE void
set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
eassert (idx >= 0 && idx < h->table_size);
kv_vector_data (h->value)[idx] = val;
#ifndef USE_EPHEMERON_POOL
kv_vector_data (h->kv.values)[idx] = val;
#else
h->kv->pairs[idx].value = val;
#endif
}
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
void weak_hash_table_thaw (Lisp_Object hash_table);
INLINE void
@ -4271,7 +4382,7 @@ set_weak_hash_key_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx,
Lisp_Object val)
{
eassert (idx >= 0 && idx < h->strong->h.table_size);
h->strong->h.key->contents[idx] = val;
h->strong->h.kv.keys->contents[idx] = val;
}
INLINE void
@ -4279,7 +4390,7 @@ set_weak_hash_value_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx,
Lisp_Object val)
{
eassert (idx >= 0 && idx < h->strong->h.table_size);
h->strong->h.value->contents[idx] = val;
h->strong->h.kv.values->contents[idx] = val;
}
#endif

122
src/pdumper.c
View file

@ -2706,21 +2706,24 @@ dump_vectorlike_generic (struct dump_context *ctx,
/* Return a vector of KEY, VALUE pairs in the given hash table H.
No room for growth is included. */
static void
hash_table_contents (struct Lisp_Hash_Table *h, Lisp_KV_Vector *key,
Lisp_KV_Vector *value)
static hash_table_kv
hash_table_contents (struct Lisp_Hash_Table *h, hash_idx_t *count)
{
ptrdiff_t size = h->count;
*key = hash_table_alloc_kv (h, size);
*value = hash_table_alloc_kv (h, size);
Lisp_Object lh = make_lisp_ptr (h, Lisp_Vectorlike);
ptrdiff_t size = XFIXNUM (Fhash_table_count (lh));
hash_table_kv kv = hash_table_kv_create (size, Weak_None);
ptrdiff_t n = 0;
DOHASH (h, k, v)
{
kv_vector_data (*key)[n] = k;
kv_vector_data (*value)[n] = v;
hash_table_kv_set_key (kv, n, k);
hash_table_kv_set_value (kv, n, v);
++n;
}
eassert (size == n);
*count = n;
return kv;
}
static dump_off
@ -2756,10 +2759,7 @@ hash_table_std_test (const struct hash_table_test *t)
static void
hash_table_freeze (struct Lisp_Hash_Table *h)
{
Lisp_KV_Vector key, value;
hash_table_contents (h, &key, &value);
h->key = key;
h->value = value;
h->kv = hash_table_contents (h, &h->count);
h->next = NULL;
h->hash = NULL;
h->index = NULL;
@ -2796,16 +2796,88 @@ dump_hash_vec (struct dump_context *ctx,
return start_offset;
}
#ifdef USE_EPHEMERON_POOL
static void
dump_hash_table_kv_slot (struct dump_context *ctx, Lisp_Object *slot)
{
eassert (!hash_unused_entry_key_p (*slot));
Lisp_Object out;
dump_object_start_1 (ctx, &out, sizeof out);
dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG);
dump_object_finish_1 (ctx, &out, sizeof out);
}
static dump_off
dump_hash_table_kv (struct dump_context *ctx,
const hash_table_kv kv, size_t len)
{
dump_align_output (ctx, DUMP_ALIGNMENT);
struct pair_vector out;
dump_off kv_start = dump_object_start (ctx, kv, IGC_OBJ_PAIR_VECTOR,
&out, sizeof (out));
DUMP_FIELD_COPY (&out, kv, gc_header);
eassert (NILP (kv->ndeleted));
DUMP_FIELD_COPY (&out, kv, ndeleted);
dump_object_finish_1 (ctx, &out, sizeof (out));
struct dump_flags old_flags = ctx->flags;
ctx->flags.pack_objects = true;
for (size_t i = 0; i < len; i++)
{
dump_hash_table_kv_slot (ctx, &kv->pairs[i].key);
dump_hash_table_kv_slot (ctx, &kv->pairs[i].value);
}
ctx->flags = old_flags;
dump_align_output (ctx, DUMP_ALIGNMENT);
#ifdef HAVE_MPS
dump_igc_finish_obj (ctx);
#endif
return kv_start;
}
#endif
#if 0
static dump_off
dump_hash_table_key (struct dump_context *ctx, struct Lisp_Hash_Table *h)
{
return dump_hash_vec (ctx, h->key, h->count);
return dump_hash_vec (ctx, h->kv.s.key, h->count);
}
static dump_off
dump_hash_table_value (struct dump_context *ctx, struct Lisp_Hash_Table *h)
{
return dump_hash_vec (ctx, h->value, h->count);
return dump_hash_vec (ctx, h->kv.s.value, h->count);
}
#endif
static void
dump_hash_table_kv_part (struct dump_context *ctx,
dump_off h_start,
struct Lisp_Hash_Table *h)
{
#ifndef USE_EPHEMERON_POOL
if (h->kv.keys)
{
dump_off k = dump_hash_vec (ctx, h->kv.keys, h->count);
dump_off v = dump_hash_vec (ctx, h->kv.values, h->count);
dump_off k_off = dump_offsetof (struct Lisp_Hash_Table, kv.keys);
dump_off v_off = dump_offsetof (struct Lisp_Hash_Table, kv.values);
dump_remember_fixup_ptr_raw (ctx, h_start + k_off, k);
dump_remember_fixup_ptr_raw (ctx, h_start + v_off, v);
}
#else
if (h->kv)
{
dump_off kv = dump_hash_table_kv (ctx, h->kv, h->count);
dump_off kv_off = dump_offsetof (struct Lisp_Hash_Table, kv);
dump_remember_fixup_ptr_raw (ctx, h_start + kv_off, kv);
}
#endif
}
static dump_off
@ -2834,26 +2906,14 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object)
DUMP_FIELD_COPY (out, hash, weakness);
DUMP_FIELD_COPY (out, hash, mutable);
DUMP_FIELD_COPY (out, hash, frozen_test);
if (hash->key)
dump_field_fixup_later (ctx, out, hash, &hash->key);
if (hash->value)
dump_field_fixup_later (ctx, out, hash, &hash->value);
dump_field_fixup_later (ctx, out, hash, &hash->kv);
eassert (hash->next_weak == NULL);
dump_off offset = finish_dump_pvec (ctx, &out->header);
if (hash->key)
dump_remember_fixup_ptr_raw
(ctx,
offset + dump_offsetof (struct Lisp_Hash_Table, key),
dump_hash_table_key (ctx, hash));
if (hash->value)
dump_remember_fixup_ptr_raw
(ctx,
offset + dump_offsetof (struct Lisp_Hash_Table, value),
dump_hash_table_value (ctx, hash));
dump_hash_table_kv_part (ctx, offset, hash);
return offset;
}
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
static dump_off
dump_weak_hash_table (struct dump_context *ctx, Lisp_Object object)
{
@ -3202,7 +3262,7 @@ dump_vectorlike (struct dump_context *ctx,
return dump_vectorlike_generic (ctx, &v->header);
case PVEC_BOOL_VECTOR:
return dump_bool_vector(ctx, v);
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
case PVEC_WEAK_HASH_TABLE:
return dump_weak_hash_table (ctx, lv);
#endif
@ -6364,7 +6424,7 @@ thaw_hash_tables (void)
Lisp_Object table = AREF (hash_tables, i);
if (HASH_TABLE_P (table))
hash_table_thaw (table);
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
else if (WEAK_HASH_TABLE_P (table))
weak_hash_table_thaw (table);
#endif

17
src/print.c
View file

@ -2237,7 +2237,7 @@ print_vectorlike_unreadable (Lisp_Object obj, bool escapeflag, char *buf,
case PVEC_CHAR_TABLE:
case PVEC_SUB_CHAR_TABLE:
case PVEC_HASH_TABLE:
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
case PVEC_WEAK_HASH_TABLE:
#endif
case PVEC_BIGNUM:
@ -2814,22 +2814,27 @@ print_object (Lisp_Object obj, bool escapeflag, struct print_context *pc)
}
hash_table_data:
if (h->count > 0)
EMACS_INT count = XFIXNAT (Fhash_table_count (obj));
if (count > 0)
{
ptrdiff_t size = h->count;
ptrdiff_t size = count;
print_c_string (" data (", printcharfun);
/* Don't print more elements than the specified maximum. */
if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
size = XFIXNAT (Vprint_length);
/* FIXME: For weak hash tables, the GC can delete
entries. This can lead to an out-of-bounds access
before the test .u.hash.printed >= .u.hash.nobjs
becomes true. */
print_stack_push ((struct print_stack_entry){
.type = PE_hash,
.u.hash.obj = obj,
.u.hash.nobjs = size * 2,
.u.hash.idx = 0,
.u.hash.printed = 0,
.u.hash.truncated = (size < h->count),
.u.hash.truncated = (size < count),
});
}
else
@ -2839,14 +2844,14 @@ print_object (Lisp_Object obj, bool escapeflag, struct print_context *pc)
--print_depth; /* Done with this. */
}
goto next_obj;
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
strong_hash_table:
#endif
h = XHASH_TABLE (obj);
goto hash_table_data;
}
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
case PVEC_WEAK_HASH_TABLE:
{
struct Lisp_Weak_Hash_Table *h = XWEAK_HASH_TABLE (obj);

2
src/window.c
View file

@ -3443,7 +3443,7 @@ window_discard_buffer_from_window (Lisp_Object buffer, Lisp_Object window, bool
void
window_discard_buffer_from_dead_windows (Lisp_Object buffer)
{
#ifdef HAVE_MPS
#if defined HAVE_MPS && !defined USE_EPHEMERON_POOL
struct Lisp_Weak_Hash_Table *h = XWEAK_HASH_TABLE (window_dead_windows_table);
Lisp_Object k, v;

21
test/src/fns-tests.el
View file

@ -1307,7 +1307,8 @@
(cl-loop for (k1 . v1) in expected
for (k2 . v2) in actual
do (ft--check-entry w k1 v1 k2 v2))
(should (= (length expected) (length actual)))))
(should (= (length expected) (length actual)))
(should (= (hash-table-count table) (length expected)))))
(defun ft--gc (weakness)
(cond ((fboundp 'igc--collect)
@ -1388,6 +1389,23 @@
(dolist (test '(eq eql equal))
(ft--test-weak-fixnums w test))))
(defun ft--test-weak-fixnums2 (weakness test)
(let ((h (make-hash-table :weakness weakness :test test)))
(dotimes (i 3)
(cl-ecase i
(#b00 (dotimes (i 10)
(puthash i (lognot i) h)))
(#b01 (dotimes (i 10)
(puthash i (cons nil nil) h)))
(#b10 (dotimes (i 10)
(puthash (cons nil nil) i h)))))
(ft--gc weakness)))
(ert-deftest ft-weak-fixnums2 ()
(dolist (w '(key value key-and-value key-or-value))
(dolist (test '(eq eql equal))
(ft--test-weak-fixnums2 w test))))
(defun ft--test-ephemeron-table (weakness)
(let* ((h (make-hash-table :weakness weakness :test 'eq))
(n 1000))
@ -1395,6 +1413,7 @@
(let* ((obj (cons 'a i)))
(puthash obj obj h)))
(ft--gc weakness)
(should (< (length (ft--hash-table-entries h)) n))
(should (< (hash-table-count h) n))))
(ert-deftest ft-ephemeron-table ()