From b3ee5b351e1bcc604efd9d1dfda281c3f4ba9b42 Mon Sep 17 00:00:00 2001 From: Helmut Eller Date: Mon, 2 Feb 2026 22:29:19 +0100 Subject: [PATCH] Alternative implementation for weak hash tables 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. --- src/alloc.c | 10 +- src/data.c | 2 +- src/fns.c | 288 ++++++++++++++++------- src/igc.c | 532 ++++++++++++++++++++++++++++++++++++++++-- src/igc.h | 11 + src/lisp.h | 151 ++++++++++-- src/pdumper.c | 122 +++++++--- src/print.c | 17 +- src/window.c | 2 +- test/src/fns-tests.el | 21 +- 10 files changed, 992 insertions(+), 164 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index d0999a655fc..5e234483d94 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -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 { diff --git a/src/data.c b/src/data.c index d62e290895c..4314ca0294e 100644 --- a/src/data.c +++ b/src/data.c @@ -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; diff --git a/src/fns.c b/src/fns.c index 85c27d0e625..5dbdb21202b 100644 --- a/src/fns.c +++ b/src/fns.c @@ -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))); diff --git a/src/igc.c b/src/igc.c index 7d5a5af7b2d..f087221d3e4 100644 --- a/src/igc.c +++ b/src/igc.c @@ -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)) diff --git a/src/igc.h b/src/igc.h index 131613b5044..19dabc62e8c 100644 --- a/src/igc.h +++ b/src/igc.h @@ -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); diff --git a/src/lisp.h b/src/lisp.h index a378fe13ce3..2d25f781091 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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 diff --git a/src/pdumper.c b/src/pdumper.c index f5b646d175f..85931b06362 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -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 diff --git a/src/print.c b/src/print.c index d9111fbe967..ce49089ca1c 100644 --- a/src/print.c +++ b/src/print.c @@ -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); diff --git a/src/window.c b/src/window.c index 4e2a2f631a1..886036ca011 100644 --- a/src/window.c +++ b/src/window.c @@ -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; diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 7c65e19f43d..b25fd6a09d8 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -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 ()