diff --git a/src/alloc.c b/src/alloc.c index 09b51ba2a08..5d47d3f7851 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6230,6 +6230,16 @@ purecopy (Lisp_Object obj) obj = make_lisp_hash_table (purecopy_hash_table (table)); } + else if (WEAK_HASH_TABLE_P (obj)) + { + /* Instead, add the hash table to the list of pinned objects, + so that it will be marked during GC. */ + struct pinned_object *o = xmalloc (sizeof *o); + o->object = obj; + o->next = pinned_objects; + pinned_objects = o; + return obj; /* Don't hash cons it. */ + } else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj)) { struct Lisp_Vector *objp = XVECTOR (obj); diff --git a/src/data.c b/src/data.c index dcf869c1a0e..996f57e2123 100644 --- a/src/data.c +++ b/src/data.c @@ -251,6 +251,7 @@ DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0, case PVEC_BOOL_VECTOR: return Qbool_vector; case PVEC_FRAME: return Qframe; case PVEC_HASH_TABLE: return Qhash_table; + case PVEC_WEAK_HASH_TABLE: return Qhash_table; case PVEC_OBARRAY: return Qobarray; case PVEC_FONT: if (FONT_SPEC_P (object)) diff --git a/src/fns.c b/src/fns.c index f7603626454..3049ae37d65 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4583,12 +4583,28 @@ set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) eassert (idx >= 0 && idx < h->table_size); h->next[idx] = val; } + +static void +set_weak_hash_next_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) +{ + eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size)); + h->strong->next[idx].lisp_object = make_fixnum (val); +} + static void set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, hash_hash_t val) { eassert (idx >= 0 && idx < h->table_size); h->hash[idx] = val; } + +static void +set_weak_hash_hash_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, hash_hash_t val) +{ + eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size)); + h->strong->hash[idx].lisp_object = make_fixnum (val); +} + static void set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { @@ -4596,6 +4612,13 @@ set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) h->index[idx] = val; } +static void +set_weak_hash_index_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) +{ + eassert (idx >= 0 && idx < weak_hash_table_index_size (h)); + h->strong->index[idx].lisp_object = make_fixnum (val); +} + /* If OBJ is a Lisp hash table, return a pointer to its struct Lisp_Hash_Table. Otherwise, signal an error. */ @@ -4606,6 +4629,14 @@ check_hash_table (Lisp_Object obj) return XHASH_TABLE (obj); } +static struct Lisp_Weak_Hash_Table * +check_maybe_weak_hash_table (Lisp_Object obj) +{ + if (WEAK_HASH_TABLE_P (obj)) + return XWEAK_HASH_TABLE (obj); + return NULL; +} + /* Value is the next integer I >= N, N >= 0 which is "almost" a prime number. A number is "almost" a prime number if it is not divisible @@ -4687,6 +4718,13 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) return h->next[idx]; } +static ptrdiff_t +WEAK_HASH_NEXT (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx) +{ + eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size)); + return XFIXNUM (h->strong->next[idx].lisp_object); +} + /* Return the index of the element in hash table H that is the start of the collision list at index IDX, or -1 if the list is empty. */ @@ -4697,6 +4735,13 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) return h->index[idx]; } +static ptrdiff_t +WEAK_HASH_INDEX (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx) +{ + eassert (idx >= 0 && idx < weak_hash_table_index_size (h)); + return XFIXNUM (h->strong->index[idx].lisp_object); +} + /* Restore a hash table's mutability after the critical section exits. */ static void @@ -4821,6 +4866,48 @@ allocate_hash_table (void) return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE); } +static struct Lisp_Weak_Hash_Table * +allocate_weak_hash_table (hash_table_weakness_t weak, ssize_t size, ssize_t index_bits) +{ + struct Lisp_Weak_Hash_Table *ret = + ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Weak_Hash_Table, PVEC_WEAK_HASH_TABLE); + ret->strong = igc_alloc_weak_hash_table_strong_part (weak, size, index_bits); + ret->strong->hash = ret->strong->entries + 0; + ret->strong->value = ret->strong->entries + 1 * size; + ret->strong->next = ret->strong->entries + 2 * size; + ret->strong->index = ret->strong->entries + 3 * size; + ret->weak = igc_alloc_weak_hash_table_weak_part (weak, size, index_bits); + ret->strong->weak = ret->weak; + ret->weak->strong = ret->strong; + ret->strong->key = ret->weak->entries; + return ret; +} + +Lisp_Object +strengthen_hash_table (Lisp_Object weak) +{ + Lisp_Object ret = make_hash_table (XWEAK_HASH_TABLE (weak)->strong->test, 0, Weak_None, 0); + + Lisp_Object k, v; + DOHASH_WEAK (XWEAK_HASH_TABLE (weak), k, v) + { + Fputhash (k, v, ret); + } + + return ret; +} + +Lisp_Object +strengthen_hash_table_for_dump (struct Lisp_Weak_Hash_Table *weak) +{ + if (!NILP (weak->dump_replacement)) + return weak->dump_replacement; + Lisp_Object ret = strengthen_hash_table (make_lisp_weak_hash_table (weak)); + weak->dump_replacement = ret; + + return ret; +} + /* Compute the size of the index (as log2) from the table capacity. */ static int compute_hash_index_bits (hash_idx_t size) @@ -4855,6 +4942,54 @@ compute_hash_index_bits (hash_idx_t size) `purecopy' when Emacs is being dumped. Such tables can no longer be changed after purecopy. */ +Lisp_Object +make_weak_hash_table (const struct hash_table_test *test, EMACS_INT size, + hash_table_weakness_t weak, bool purecopy) +{ + eassert (!purecopy); + eassert (SYMBOLP (test->name)); + eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX)); + + if (size < 65) + size = 65; + + struct Lisp_Weak_Hash_Table *h = allocate_weak_hash_table (weak, size, compute_hash_index_bits (size)); + + h->strong->test = test; + h->strong->weakness = weak; + h->strong->count = make_fixnum (0); + h->strong->table_size = make_fixnum (size); + + if (size == 0) + { + emacs_abort (); + } + else + { + for (ptrdiff_t i = 0; i < size; i++) + { + h->strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY; + h->strong->value[i].ptr = 0; + } + + for (ptrdiff_t i = 0; i < size - 1; i++) + h->strong->next[i].lisp_object = make_fixnum(i + 1); + h->strong->next[size - 1].lisp_object = make_fixnum(-1); + + int index_bits = compute_hash_index_bits (size); + h->strong->index_bits = make_fixnum (index_bits); + ptrdiff_t index_size = weak_hash_table_index_size (h); + for (ptrdiff_t i = 0; i < index_size; i++) + h->strong->index[i].lisp_object = make_fixnum (-1); + + h->strong->next_free = make_fixnum (0); + } + + h->strong->purecopy = purecopy; + h->strong->mutable = true; + return make_lisp_weak_hash_table (h); +} + Lisp_Object make_hash_table (const struct hash_table_test *test, EMACS_INT size, hash_table_weakness_t weak, bool purecopy) @@ -4862,6 +4997,10 @@ 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)); + if (weak != Weak_None) + { + return make_weak_hash_table (test, size, weak, purecopy); + } struct Lisp_Hash_Table *h = allocate_hash_table (); h->test = test; @@ -4961,6 +5100,13 @@ hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash) return knuth_hash (hash, h->index_bits); } +/* Compute index into the index vector from a hash value. */ +static inline ptrdiff_t +weak_hash_index_index (struct Lisp_Weak_Hash_Table *h, hash_hash_t hash) +{ + return knuth_hash (hash, XFIXNUM (h->strong->index_bits)); +} + /* Resize hash table H if it's too full. If H cannot be resized because it's already too large, throw an error. */ @@ -5042,6 +5188,71 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) } } +static void +maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table *h) +{ + if (XFIXNUM (h->strong->next_free) < 0) + { + ptrdiff_t old_size = WEAK_HASH_TABLE_SIZE (h); + ptrdiff_t min_size = 6; + ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2); + /* Grow aggressively at small sizes, then just double. */ + ptrdiff_t new_size = + old_size == 0 + ? min_size + : (base_size <= 64 ? base_size * 4 : base_size * 2); + + ptrdiff_t index_bits = compute_hash_index_bits (new_size); + + struct Lisp_Weak_Hash_Table_Strong_Part *strong = + igc_alloc_weak_hash_table_strong_part (h->strong->weakness, new_size, index_bits); + struct Lisp_Weak_Hash_Table_Weak_Part *weak = + igc_alloc_weak_hash_table_weak_part (h->strong->weakness, new_size, index_bits); + + memcpy (strong, h->strong, sizeof *strong); + + strong->hash = strong->entries + 0; + strong->value = strong->entries + 1 * new_size; + strong->next = strong->entries + 2 * new_size; + strong->index = strong->entries + 3 * new_size; + strong->key = weak->entries; + strong->count = make_fixnum (0); + weak->strong = strong; + strong->weak = weak; + + for (ptrdiff_t i = 0; i < new_size - 1; i++) + strong->next[i].lisp_object = make_fixnum (i + 1); + strong->next[new_size - 1].lisp_object = make_fixnum (-1); + + for (ptrdiff_t i = 0; i < new_size; i++) + { + strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY; + strong->value[i].lisp_object = Qnil; + } + + ptrdiff_t index_size = (ptrdiff_t)1 << index_bits; + for (ptrdiff_t i = 0; i < index_size; i++) + strong->index[i].lisp_object = make_fixnum (-1); + + strong->index_bits = make_fixnum (index_bits); + strong->table_size = make_fixnum (new_size); + strong->next_free = make_fixnum (0); + + struct Lisp_Weak_Hash_Table *pseudo = + ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Weak_Hash_Table, PVEC_WEAK_HASH_TABLE); + pseudo->strong = strong; + pseudo->weak = weak; + Lisp_Object k, v; + DOHASH_WEAK (h, k, v) + { + Fputhash (k, v, make_lisp_weak_hash_table (pseudo)); + } + + h->strong = strong; + h->weak = weak; + } +} + static const struct hash_table_test * hash_table_test_from_std (hash_table_std_test_t test) { @@ -5058,6 +5269,7 @@ hash_table_test_from_std (hash_table_std_test_t test) void hash_table_thaw (Lisp_Object hash_table) { + eassert (HASH_TABLE_P (hash_table)); struct Lisp_Hash_Table *h = XHASH_TABLE (hash_table); /* Freezing discarded most non-essential information; recompute it. @@ -5173,6 +5385,24 @@ hash_lookup_with_hash (struct Lisp_Hash_Table *h, return -1; } +/* Look up KEY with hash HASH in weak hash table H. + Return entry index or -1 if none. */ +static ptrdiff_t +weak_hash_lookup_with_hash (struct Lisp_Weak_Hash_Table *h, + Lisp_Object key, hash_hash_t hash) +{ + ptrdiff_t start_of_bucket = weak_hash_index_index (h, hash); + for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket); + 0 <= i; i = WEAK_HASH_NEXT (h, i)) + if (EQ (key, WEAK_HASH_KEY (h, i)) + || (h->strong->test->cmpfn + && hash == WEAK_HASH_HASH (h, i) + && !NILP (h->strong->test->cmpfn (key, WEAK_HASH_KEY (h, i), NULL)))) + return i; + + return -1; +} + /* Look up KEY in table H. Return entry index or -1 if none. */ ptrdiff_t hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key) @@ -5180,6 +5410,12 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key) return hash_lookup_with_hash (h, key, hash_from_key (h, key)); } +ptrdiff_t +weak_hash_lookup (struct Lisp_Weak_Hash_Table *h, Lisp_Object key) +{ + return weak_hash_lookup_with_hash (h, key, weak_hash_from_key (h, key)); +} + /* Look up KEY in hash table H. Return its hash value in *PHASH. Value is the index of the entry in H matching KEY, or -1 if not found. */ ptrdiff_t @@ -5229,6 +5465,36 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, return i; } +/* Put an entry into weak hash table H that associates KEY with VALUE. + HASH is a previously computed hash code of KEY. + Value is the index of the entry in H matching KEY. */ + +ptrdiff_t +weak_hash_put (struct Lisp_Weak_Hash_Table *h, Lisp_Object key, Lisp_Object value, + hash_hash_t hash) +{ + //eassert (!hash_unused_entry_key_p (key)); + /* Increment count after resizing because resizing may fail. */ + maybe_resize_weak_hash_table (h); + h->strong->count = make_fixnum (XFIXNUM (h->strong->count) + 1); + + /* Store key/value in the key_and_value vector. */ + ptrdiff_t i = XFIXNUM (h->strong->next_free); + //eassert (hash_unused_entry_key_p (HASH_KEY (h, i))); + h->strong->next_free = make_fixnum (WEAK_HASH_NEXT (h, i)); + set_weak_hash_key_slot (h, i, key); + set_weak_hash_value_slot (h, i, value); + + /* Remember its hash code. */ + set_weak_hash_hash_slot (h, i, hash); + + /* Add new entry to its collision chain. */ + ptrdiff_t start_of_bucket = weak_hash_index_index (h, hash); + set_weak_hash_next_slot (h, i, WEAK_HASH_INDEX (h, start_of_bucket)); + set_weak_hash_index_slot (h, start_of_bucket, i); + return i; +} + /* Remove the entry matching KEY from hash table H, if there is one. */ @@ -5270,6 +5536,82 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) } +/* Remove the entry matching KEY from weak hash table H, if there is one. */ + +void +weak_hash_remove_from_table (struct Lisp_Weak_Hash_Table *h, Lisp_Object key) +{ + hash_hash_t hashval = weak_hash_from_key (h, key); + ptrdiff_t start_of_bucket = weak_hash_index_index (h, hashval); + ptrdiff_t prev = -1; + + for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket); + 0 <= i; + i = WEAK_HASH_NEXT (h, i)) + { + if (EQ (key, WEAK_HASH_KEY (h, i)) + || (h->strong->test->cmpfn + && hashval == WEAK_HASH_HASH (h, i) + && !NILP (h->strong->test->cmpfn (key, WEAK_HASH_KEY (h, i), NULL)))) + { + /* Take entry out of collision chain. */ + if (prev < 0) + set_weak_hash_index_slot (h, start_of_bucket, WEAK_HASH_NEXT (h, i)); + else + set_weak_hash_next_slot (h, prev, WEAK_HASH_NEXT (h, i)); + + /* Clear slots in key_and_value and add the slots to + the free list. */ + set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); + set_weak_hash_value_slot (h, i, Qnil); + set_weak_hash_next_slot (h, i, XFIXNUM (h->strong->next_free)); + h->strong->next_free = make_fixnum (i); + h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1); + break; + } + + prev = i; + } +} + + +/* Remove the entry at ID0 from weak hash table H. Called from GC with H + being a pointer to a structure on the stack. */ + +void +weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table *h, ptrdiff_t i0) +{ + hash_hash_t hashval = WEAK_HASH_HASH (h, i0); + ptrdiff_t start_of_bucket = weak_hash_index_index (h, hashval); + ptrdiff_t prev = -1; + + for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket); + 0 <= i; + i = WEAK_HASH_NEXT (h, i)) + { + if (i == i0) + { + /* Take entry out of collision chain. */ + if (prev < 0) + set_weak_hash_index_slot (h, start_of_bucket, WEAK_HASH_NEXT (h, i)); + else + set_weak_hash_next_slot (h, prev, WEAK_HASH_NEXT (h, i)); + + /* Clear slots in key_and_value and add the slots to + the free list. */ + set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); + set_weak_hash_value_slot (h, i, Qnil); + set_weak_hash_next_slot (h, i, XFIXNUM (h->strong->next_free)); + h->strong->next_free = make_fixnum (i); + h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1); + break; + } + + prev = i; + } +} + + /* Clear hash table H. */ static void @@ -5294,6 +5636,30 @@ hash_clear (struct Lisp_Hash_Table *h) } } +/* Clear weak hash table H. */ + +static void +weak_hash_clear (struct Lisp_Weak_Hash_Table *h) +{ + if (XFIXNUM (h->strong->count) > 0) + { + ptrdiff_t size = WEAK_HASH_TABLE_SIZE (h); + for (ptrdiff_t i = 0; i < size; i++) + { + set_weak_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); + set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); + set_weak_hash_value_slot (h, i, Qnil); + } + + ptrdiff_t index_size = weak_hash_table_index_size (h); + for (ptrdiff_t i = 0; i < index_size; i++) + h->strong->index[i].lisp_object = make_fixnum (-1); + + h->strong->next_free = make_fixnum (0); + h->strong->count = make_fixnum (0); + } +} + /************************************************************************ Weak Hash Tables @@ -5920,6 +6286,11 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0, doc: /* Return the number of elements in TABLE. */) (Lisp_Object table) { + struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table); + if (wh) + { + return wh->strong->count; + } struct Lisp_Hash_Table *h = check_hash_table (table); return make_fixnum (h->count); } @@ -5999,7 +6370,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) { - return HASH_TABLE_P (obj) ? Qt : Qnil; + return (HASH_TABLE_P (obj) || WEAK_HASH_TABLE_P (obj)) ? Qt : Qnil; } @@ -6007,6 +6378,12 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0, doc: /* Clear hash table TABLE and return it. */) (Lisp_Object table) { + struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table); + if (wh) + { + weak_hash_clear (wh); + return table; + } struct Lisp_Hash_Table *h = check_hash_table (table); check_mutable_hash_table (table, h); hash_clear (h); @@ -6020,6 +6397,12 @@ DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0, If KEY is not found, return DFLT which defaults to nil. */) (Lisp_Object key, Lisp_Object table, Lisp_Object dflt) { + struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table); + if (wh) + { + ptrdiff_t i = weak_hash_lookup (wh, key); + return i >= 0 ? WEAK_HASH_VALUE (wh, i) : dflt; + } struct Lisp_Hash_Table *h = check_hash_table (table); ptrdiff_t i = hash_lookup (h, key); return i >= 0 ? HASH_VALUE (h, i) : dflt; @@ -6032,6 +6415,17 @@ DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0, VALUE. In any case, return VALUE. */) (Lisp_Object key, Lisp_Object value, Lisp_Object table) { + struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table); + if (wh) + { + EMACS_UINT hash = weak_hash_from_key (wh, key); + ptrdiff_t i = weak_hash_lookup_with_hash (wh, key, hash); + if (i >= 0) + set_weak_hash_value_slot (wh, i, value); + else + weak_hash_put (wh, key, value, hash); + return value; + } struct Lisp_Hash_Table *h = check_hash_table (table); check_mutable_hash_table (table, h); @@ -6050,6 +6444,12 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0, doc: /* Remove KEY from TABLE. */) (Lisp_Object key, Lisp_Object table) { + struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table); + if (wh) + { + weak_hash_remove_from_table (wh, key); + return Qnil; + } struct Lisp_Hash_Table *h = check_hash_table (table); check_mutable_hash_table (table, h); hash_remove_from_table (h, key); @@ -6065,6 +6465,13 @@ DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0, `maphash' always returns nil. */) (Lisp_Object function, Lisp_Object table) { + struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table); + if (wh) + { + DOHASH_WEAK_SAFE (wh, i) + call2 (function, WEAK_HASH_KEY (wh, i), WEAK_HASH_VALUE (wh, i)); + return Qnil; + } struct Lisp_Hash_Table *h = check_hash_table (table); /* We can't use DOHASH here since FUNCTION may violate the rules and we shouldn't crash as a result (although the effects are diff --git a/src/igc.c b/src/igc.c index 2165a69cacf..482272e9a89 100644 --- a/src/igc.c +++ b/src/igc.c @@ -372,6 +372,8 @@ #define IGC_DEFINE_LIST(data) \ "IGC_OBJ_DUMPED_BUFFER_TEXT", "IGC_OBJ_DUMPED_BIGNUM_DATA", "IGC_OBJ_DUMPED_BYTES", + "IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART", + "IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART", }; static_assert (ARRAYELTS (obj_type_names) == IGC_OBJ_NUM_TYPES); @@ -399,6 +401,7 @@ obj_type_name (enum igc_obj_type type) "PVEC_BOOL_VECTOR", "PVEC_BUFFER", "PVEC_HASH_TABLE", + "PVEC_WEAK_HASH_TABLE", #ifndef IN_MY_FORK "PVEC_OBARRAY", #endif @@ -460,8 +463,8 @@ pvec_type_name (enum pvec_type type) enum { - IGC_TYPE_BITS = 5, - IGC_HASH_BITS = 27, + IGC_TYPE_BITS = 6, + IGC_HASH_BITS = 26, IGC_SIZE_BITS = 32, IGC_HASH_MASK = (1 << IGC_HASH_BITS) - 1, }; @@ -562,6 +565,32 @@ object_nelems (void *client, size_t elem_size) return obj_client_size (h) / elem_size; } +Lisp_Object +igc_ptr_to_lisp (void *client) +{ + if (client == 0) + return Qnil; + mps_addr_t base = client_to_base (client); + struct igc_header *h = base; + switch (h->obj_type) + { + case IGC_OBJ_STRING: + return make_lisp_ptr (client, Lisp_String); + + case IGC_OBJ_VECTOR: + return make_lisp_ptr (client, Lisp_Vectorlike); + + case IGC_OBJ_CONS: + return make_lisp_ptr (client, Lisp_Cons); + + return make_lisp_ptr (client, Lisp_Float); + + default: + IGC_NOT_IMPLEMENTED (); + emacs_abort (); + } +} + /* Round NBYTES to the next multiple of ALIGN. */ static size_t @@ -638,6 +667,8 @@ IGC_DEFINE_LIST (igc_root); mps_ap_t leaf_ap; mps_ap_t weak_strong_ap; mps_ap_t weak_weak_ap; + mps_ap_t weak_hash_strong_ap; + mps_ap_t weak_hash_weak_ap; mps_ap_t immovable_ap; /* Quick access to the roots used for specpdl, bytecode stack and @@ -674,6 +705,8 @@ IGC_DEFINE_LIST (igc_thread); mps_pool_t leaf_pool; mps_fmt_t weak_fmt; mps_pool_t weak_pool; + mps_fmt_t weak_hash_fmt; + mps_pool_t weak_hash_pool; mps_fmt_t immovable_fmt; mps_pool_t immovable_pool; @@ -1522,6 +1555,8 @@ fix_charset_table (mps_ss_t ss, struct charset *table, size_t nbytes) static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v); static mps_res_t fix_vector_weak (mps_ss_t ss, struct Lisp_Vector *v); +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); static mps_res_t dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, @@ -1645,6 +1680,15 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, IGC_FIX_CALL (ss, fix_charset_table (ss, (struct charset *)client, obj_size (header))); break; + + case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART: + IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Strong_Part, client, + fix_weak_hash_table_strong_part); + break; + case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART: + IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Weak_Part, client, + fix_weak_hash_table_weak_part); + break; } } MPS_SCAN_END (ss); @@ -1841,6 +1885,60 @@ fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h) return MPS_RES_OK; } +static mps_res_t +fix_weak_hash_table (mps_ss_t ss, struct Lisp_Weak_Hash_Table *h) +{ + MPS_SCAN_BEGIN (ss) + { + IGC_FIX12_RAW (ss, &h->strong); + IGC_FIX12_RAW (ss, &h->weak); + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} + +static mps_res_t +fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong_Part *t) +{ + MPS_SCAN_BEGIN (ss) + { + for (ssize_t i = 0; i < 4 * XFIXNUM (t->table_size); i++) + { + IGC_FIX12_OBJ (ss, &t->entries[i].lisp_object); + } + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} + +static mps_res_t +fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Part *w) +{ + MPS_SCAN_BEGIN (ss) + { + IGC_FIX12_RAW (ss, &w->strong); + struct Lisp_Weak_Hash_Table_Strong_Part *t = w->strong; + for (ssize_t i = 0; i < 4 * XFIXNUM (t->table_size); i++) + { + bool was_nil = NILP (w->entries[i].lisp_object); + IGC_FIX12_OBJ (ss, &w->entries[i].lisp_object); + bool is_now_nil = NILP (w->entries[i].lisp_object); + + if (is_now_nil && !was_nil) + { + struct Lisp_Weak_Hash_Table pseudo_h = + { + .strong = t, + .weak = w, + }; + weak_hash_splat_from_table (&pseudo_h, i); + } + } + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} + static mps_res_t fix_char_table (mps_ss_t ss, struct Lisp_Vector *v) { @@ -2133,6 +2231,10 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v) IGC_FIX_CALL_FN (ss, struct Lisp_Hash_Table, v, fix_hash_table); break; + case PVEC_WEAK_HASH_TABLE: + IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table, v, fix_weak_hash_table); + break; + case PVEC_CHAR_TABLE: case PVEC_SUB_CHAR_TABLE: IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_char_table); @@ -2261,6 +2363,7 @@ fix_vector_weak (mps_ss_t ss, struct Lisp_Vector *v) case PVEC_FRAME: case PVEC_WINDOW: case PVEC_HASH_TABLE: + case PVEC_WEAK_HASH_TABLE: case PVEC_CHAR_TABLE: case PVEC_SUB_CHAR_TABLE: case PVEC_BOOL_VECTOR: @@ -2564,6 +2667,22 @@ create_weak_ap (mps_ap_t *ap, struct igc_thread *t, bool weak) return res; } +static mps_res_t +create_weak_hash_ap (mps_ap_t *ap, struct igc_thread *t, bool weak) +{ + struct igc *gc = t->gc; + mps_res_t res; + mps_pool_t pool = gc->weak_hash_pool; + MPS_ARGS_BEGIN (args) + { + MPS_ARGS_ADD (args, MPS_KEY_RANK, + weak ? mps_rank_weak () : mps_rank_exact ()); + res = mps_ap_create_k (ap, pool, args); + } + MPS_ARGS_END (args); + return res; +} + static void create_thread_aps (struct igc_thread *t) { @@ -2576,8 +2695,10 @@ create_thread_aps (struct igc_thread *t) res = mps_ap_create_k (&t->immovable_ap, gc->immovable_pool, mps_args_none); IGC_CHECK_RES (res); res = create_weak_ap (&t->weak_strong_ap, t, false); + 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); + res = create_weak_hash_ap (&t->weak_hash_weak_ap, t, true); IGC_CHECK_RES (res); } @@ -2637,6 +2758,8 @@ 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); + mps_ap_destroy (t->d.weak_hash_strong_ap); + mps_ap_destroy (t->d.weak_hash_weak_ap); mps_ap_destroy (t->d.immovable_ap); mps_thread_dereg (deregister_thread (t)); } @@ -2956,6 +3079,7 @@ finalize_vector (mps_addr_t v) case PVEC_OBARRAY: #endif case PVEC_HASH_TABLE: + case PVEC_WEAK_HASH_TABLE: case PVEC_SYMBOL_WITH_POS: case PVEC_PROCESS: case PVEC_RECORD: @@ -3005,6 +3129,8 @@ finalize (struct igc *gc, mps_addr_t base) case IGC_OBJ_DUMPED_BIGNUM_DATA: case IGC_OBJ_DUMPED_BYTES: case IGC_OBJ_BYTES: + case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART: + case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART: case IGC_OBJ_NUM_TYPES: emacs_abort (); @@ -3060,6 +3186,7 @@ maybe_finalize (mps_addr_t client, enum pvec_type tag) case PVEC_OBARRAY: #endif case PVEC_HASH_TABLE: + case PVEC_WEAK_HASH_TABLE: case PVEC_NORMAL_VECTOR: case PVEC_FREE: case PVEC_MARKER: @@ -3300,6 +3427,12 @@ thread_ap (enum igc_obj_type type) case IGC_OBJ_VECTOR_WEAK: return t->d.weak_weak_ap; + 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; + case IGC_OBJ_VECTOR: case IGC_OBJ_CONS: case IGC_OBJ_SYMBOL: @@ -3664,12 +3797,51 @@ igc_alloc_lisp_obj_vec (size_t n) return alloc (n * sizeof (Lisp_Object), IGC_OBJ_OBJ_VEC); } +static mps_addr_t +weak_hash_find_dependent (mps_addr_t base) +{ + struct igc_header *h = base; + switch (h->obj_type) + { + case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART: + { + mps_addr_t client = base_to_client (base); + struct Lisp_Weak_Hash_Table_Weak_Part *w = client; + return client_to_base (w->strong); + } + case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART: + { + mps_addr_t client = base_to_client (base); + struct Lisp_Weak_Hash_Table_Strong_Part *w = client; + return client_to_base (w->weak); + } + default: + emacs_abort (); + } + + return 0; +} + Lisp_Object * igc_make_hash_table_vec (size_t n) { return alloc (n * sizeof (Lisp_Object), IGC_OBJ_HASH_VEC); } +struct Lisp_Weak_Hash_Table_Strong_Part * +igc_alloc_weak_hash_table_strong_part (hash_table_weakness_t weak, size_t size, size_t index_bits) +{ + return alloc (sizeof (struct Lisp_Weak_Hash_Table_Strong_Part) + 5 * size * sizeof (union Lisp_Weak_Hash_Table_Entry), + IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART); +} + +struct Lisp_Weak_Hash_Table_Weak_Part * +igc_alloc_weak_hash_table_weak_part (hash_table_weakness_t weak, size_t size, size_t index_bits) +{ + return alloc (sizeof (struct Lisp_Weak_Hash_Table_Weak_Part) + 5 * size * sizeof (union Lisp_Weak_Hash_Table_Entry), + IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART); +} + /* Like xpalloc, but uses 'alloc' instead of xrealloc, and should only be used for growing a vector of pointers whose current size is N pointers. */ @@ -3865,6 +4037,7 @@ DEFUN ("igc-info", Figc_info, Sigc_info, 0, 0, 0, doc : /* */) walk_pool (gc, gc->dflt_pool, &st); walk_pool (gc, gc->leaf_pool, &st); walk_pool (gc, gc->weak_pool, &st); + walk_pool (gc, gc->weak_hash_pool, &st); walk_pool (gc, gc->immovable_pool, &st); Lisp_Object result = Qnil; @@ -3964,7 +4137,7 @@ make_dflt_fmt (struct igc *gc) } static mps_pool_t -make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls) +make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls, mps_awl_find_dependent_t find_dependent) { mps_res_t res; mps_pool_t pool; @@ -3973,6 +4146,8 @@ make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls) MPS_ARGS_ADD (args, MPS_KEY_FORMAT, fmt); MPS_ARGS_ADD (args, MPS_KEY_CHAIN, gc->chain); MPS_ARGS_ADD (args, MPS_KEY_INTERIOR, true); + if (find_dependent) + MPS_ARGS_ADD (args, MPS_KEY_AWL_FIND_DEPENDENT, find_dependent); res = mps_pool_create_k (&pool, gc->arena, cls, args); } MPS_ARGS_END (args); @@ -3983,25 +4158,25 @@ make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls) static mps_pool_t make_pool_amc (struct igc *gc, mps_fmt_t fmt) { - return make_pool_with_class (gc, fmt, mps_class_amc ()); + return make_pool_with_class (gc, fmt, mps_class_amc (), NULL); } static mps_pool_t make_pool_ams (struct igc *gc, mps_fmt_t fmt) { - return make_pool_with_class (gc, fmt, mps_class_ams ()); + return make_pool_with_class (gc, fmt, mps_class_ams (), NULL); } static mps_pool_t -make_pool_awl (struct igc *gc, mps_fmt_t fmt) +make_pool_awl (struct igc *gc, mps_fmt_t fmt, mps_awl_find_dependent_t find_dependent) { - return make_pool_with_class (gc, fmt, mps_class_awl ()); + return make_pool_with_class (gc, fmt, mps_class_awl (), find_dependent); } static mps_pool_t make_pool_amcz (struct igc *gc, mps_fmt_t fmt) { - return make_pool_with_class (gc, fmt, mps_class_amcz ()); + return make_pool_with_class (gc, fmt, mps_class_amcz (), NULL); } static struct igc * @@ -4020,7 +4195,9 @@ make_igc (void) gc->leaf_fmt = make_dflt_fmt (gc); gc->leaf_pool = make_pool_amcz (gc, gc->leaf_fmt); gc->weak_fmt = make_dflt_fmt (gc); - gc->weak_pool = make_pool_awl (gc, gc->weak_fmt); + gc->weak_pool = make_pool_awl (gc, gc->weak_fmt, NULL); + gc->weak_hash_fmt = make_dflt_fmt (gc); + gc->weak_hash_pool = make_pool_awl (gc, gc->weak_hash_fmt, weak_hash_find_dependent); gc->immovable_fmt = make_dflt_fmt (gc); gc->immovable_pool = make_pool_ams (gc, gc->immovable_fmt); diff --git a/src/igc.h b/src/igc.h index 95a0d25cbba..036fec5e238 100644 --- a/src/igc.h +++ b/src/igc.h @@ -56,6 +56,8 @@ #define EMACS_IGC_H IGC_OBJ_DUMPED_BUFFER_TEXT, IGC_OBJ_DUMPED_BIGNUM_DATA, IGC_OBJ_DUMPED_BYTES, + IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART, + IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART, IGC_OBJ_NUM_TYPES }; @@ -122,6 +124,8 @@ #define EMACS_IGC_H void *igc_grow_ptr_vec (void *v, ptrdiff_t *n, ptrdiff_t n_incr_min, ptrdiff_t n_max); void igc_grow_rdstack (struct read_stack *rs); Lisp_Object *igc_make_hash_table_vec (size_t n); +struct Lisp_Weak_Hash_Table_Strong_Part *igc_alloc_weak_hash_table_strong_part(hash_table_weakness_t, size_t, size_t); +struct Lisp_Weak_Hash_Table_Weak_Part *igc_alloc_weak_hash_table_weak_part(hash_table_weakness_t, size_t, size_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 54f0a1715ea..525a87b01d9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1039,6 +1039,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG) PVEC_BOOL_VECTOR, PVEC_BUFFER, PVEC_HASH_TABLE, + PVEC_WEAK_HASH_TABLE, PVEC_OBARRAY, PVEC_TERMINAL, PVEC_WINDOW_CONFIGURATION, @@ -2558,6 +2559,7 @@ #define DOOBARRAY(oa, it) \ /* The structure of a Lisp hash table. */ +struct Lisp_Weak_Hash_Table; struct Lisp_Hash_Table; struct hash_impl; @@ -2605,6 +2607,55 @@ #define DOOBARRAY(oa, it) \ (hash) indices. It's signed and a subtype of ptrdiff_t. */ typedef int32_t hash_idx_t; +/* The reason for this unusual union is an MPS peculiarity on 32-bit x86 systems. */ +union Lisp_Weak_Hash_Table_Entry +{ + void *ptr; + Lisp_Object lisp_object; /* must be a fixnum or HASH_UNUSED_ENTRY_KEY! */ +}; + +struct Lisp_Weak_Hash_Table_Strong_Part +{ + Lisp_Object index_bits; + Lisp_Object count; + Lisp_Object next_free; + Lisp_Object table_size; + struct Lisp_Weak_Hash_Table_Weak_Part *weak; + const struct hash_table_test *test; + union Lisp_Weak_Hash_Table_Entry *index; /* internal pointer */ + union Lisp_Weak_Hash_Table_Entry *hash; /* either internal pointer or pointer to dependent object */ + union Lisp_Weak_Hash_Table_Entry *key; /* either internal pointer or pointer to dependent object */ + union Lisp_Weak_Hash_Table_Entry *value; /* either internal pointer or pointer to dependent object */ + union Lisp_Weak_Hash_Table_Entry *next; /* internal pointer */ + hash_table_weakness_t weakness : 3; + hash_table_std_test_t frozen_test : 2; + + /* True if the table can be purecopied. The table cannot be + changed afterwards. */ + bool_bf purecopy : 1; + + /* True if the table is mutable. Ordinarily tables are mutable, but + pure tables are not, and while a table is being mutated it is + immutable for recursive attempts to mutate it. */ + bool_bf mutable : 1; + union Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER]; +}; + +struct Lisp_Weak_Hash_Table_Weak_Part +{ + struct Lisp_Weak_Hash_Table_Strong_Part *strong; + union Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER]; +}; + +struct Lisp_Weak_Hash_Table +{ + union vectorlike_header header; + + struct Lisp_Weak_Hash_Table_Strong_Part *strong; + struct Lisp_Weak_Hash_Table_Weak_Part *weak; + Lisp_Object dump_replacement; +}; + struct Lisp_Hash_Table { union vectorlike_header header; @@ -2725,6 +2776,23 @@ XHASH_TABLE (Lisp_Object a) return h; } +INLINE bool +WEAK_HASH_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_WEAK_HASH_TABLE); +} + +INLINE struct Lisp_Weak_Hash_Table * +XWEAK_HASH_TABLE (Lisp_Object a) +{ + eassert (WEAK_HASH_TABLE_P (a)); + struct Lisp_Weak_Hash_Table *h + = XUNTAG (a, Lisp_Vectorlike, struct Lisp_Weak_Hash_Table); + igc_check_fwd (h); + return h; +} + +extern Lisp_Object igc_ptr_to_lisp (void *ptr); INLINE Lisp_Object make_lisp_hash_table (struct Lisp_Hash_Table *h) { @@ -2732,6 +2800,13 @@ make_lisp_hash_table (struct Lisp_Hash_Table *h) return make_lisp_ptr (h, Lisp_Vectorlike); } +INLINE Lisp_Object +make_lisp_weak_hash_table (struct Lisp_Weak_Hash_Table *h) +{ + eassert (PSEUDOVECTOR_TYPEP (&h->header, PVEC_WEAK_HASH_TABLE)); + return make_lisp_ptr (h, Lisp_Vectorlike); +} + /* Value is the key part of entry IDX in hash table H. */ INLINE Lisp_Object HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx) @@ -2740,6 +2815,14 @@ HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx) return h->key[idx]; } +/* Value is the key part of entry IDX in hash table H. */ +INLINE Lisp_Object +WEAK_HASH_KEY (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx) +{ + eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size)); + return h->strong->key[idx].lisp_object; +} + /* Value is the value part of entry IDX in hash table H. */ INLINE Lisp_Object HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx) @@ -2748,6 +2831,12 @@ HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx) return h->value[idx]; } +INLINE Lisp_Object +WEAK_HASH_VALUE (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx) +{ + return h->strong->value[idx].lisp_object; +} + /* Value is the hash code computed for entry IDX in hash table H. */ INLINE hash_hash_t HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx) @@ -2756,6 +2845,14 @@ HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx) return h->hash[idx]; } +/* Value is the hash code computed for entry IDX in hash table H. */ +INLINE hash_hash_t +WEAK_HASH_HASH (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx) +{ + eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size)); + return XFIXNUM (h->strong->hash[idx].lisp_object); +} + /* Value is the size of hash table H. */ INLINE ptrdiff_t HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) @@ -2763,6 +2860,13 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) return h->table_size; } +/* Value is the size of hash table H. */ +INLINE ptrdiff_t +WEAK_HASH_TABLE_SIZE (const struct Lisp_Weak_Hash_Table *h) +{ + return XFIXNUM (h->strong->table_size); +} + /* Size of the index vector in hash table H. */ INLINE ptrdiff_t hash_table_index_size (const struct Lisp_Hash_Table *h) @@ -2770,6 +2874,12 @@ hash_table_index_size (const struct Lisp_Hash_Table *h) return (ptrdiff_t)1 << h->index_bits; } +INLINE ptrdiff_t +weak_hash_table_index_size (const struct Lisp_Weak_Hash_Table *h) +{ + return (ptrdiff_t)1 << XFIXNUM (h->strong->index_bits); +} + /* Hash value for KEY in hash table H. */ INLINE hash_hash_t hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) @@ -2777,6 +2887,13 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) return h->test->hashfn (key, h); } +/* Hash value for KEY in hash table H. */ +INLINE hash_hash_t +weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Object key) +{ + return h->strong->test->hashfn (key, NULL); +} + /* 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. */ @@ -2800,6 +2917,28 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) ; \ else +/* 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_WEAK(h, k, v) \ + for (union Lisp_Weak_Hash_Table_Entry *dohash_##k##_##v##_k = (h)->strong->key, \ + *dohash_##k##_##v##_v = (h)->strong->value, \ + *dohash_##k##_##v##_end = dohash_##k##_##v##_k \ + + WEAK_HASH_TABLE_SIZE (h), \ + *dohash_##k##_##v##_base = dohash_##k##_##v##_k; \ + dohash_##k##_##v##_k < dohash_##k##_##v##_end \ + && (k = dohash_##k##_##v##_k[0].lisp_object, \ + v = dohash_##k##_##v##_v[0].lisp_object, /*maybe unused*/ (void)v, \ + true); \ + eassert (dohash_##k##_##v##_base == (h)->strong->key \ + && dohash_##k##_##v##_end \ + == dohash_##k##_##v##_base \ + + WEAK_HASH_TABLE_SIZE (h)), \ + ++dohash_##k##_##v##_k, ++dohash_##k##_##v##_v) \ + if (hash_unused_entry_key_p (k)) \ + ; \ + else + /* Iterate I as index of valid entries in hash table H. Unlike DOHASH, this construct copes with arbitrary table mutations in the body. The consequences of such mutations are limited to @@ -2812,6 +2951,18 @@ #define DOHASH_SAFE(h, i) \ ; \ else +/* Iterate I as index of valid entries in hash table H. + Unlike DOHASH, this construct copes with arbitrary table mutations + in the body. The consequences of such mutations are limited to + whether and in what order entries are encountered by the loop + (which is usually bad enough), but not crashing or corrupting the + Lisp state. */ +#define DOHASH_WEAK_SAFE(h, i) \ + for (ptrdiff_t i = 0; i < WEAK_HASH_TABLE_SIZE (h); i++) \ + if (hash_unused_entry_key_p (WEAK_HASH_KEY (h, i))) \ + ; \ + else + void hash_table_thaw (Lisp_Object hash_table); void hash_table_rehash (struct Lisp_Hash_Table *h); @@ -4086,6 +4237,13 @@ set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) h->key[idx] = val; } +INLINE void +set_weak_hash_key_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size)); + h->strong->key[idx].lisp_object = val; +} + INLINE void set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { @@ -4093,6 +4251,13 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) h->value[idx] = val;; } +INLINE void +set_weak_hash_value_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size) ); + h->strong->value[idx].lisp_object = val; +} + /* Use these functions to set Lisp_Object or pointer slots of struct Lisp_Symbol. */ @@ -4354,13 +4519,23 @@ #define CONS_TO_INTEGER(cons, type, var) \ EMACS_UINT sxhash (Lisp_Object); Lisp_Object make_hash_table (const struct hash_table_test *, EMACS_INT, hash_table_weakness_t, bool); +Lisp_Object make_weak_hash_table (const struct hash_table_test *, EMACS_INT, + hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); +Lisp_Object strengthen_hash_table (Lisp_Object weak); +Lisp_Object strengthen_hash_table_for_dump (struct Lisp_Weak_Hash_Table *); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object); +ptrdiff_t weak_hash_lookup (struct Lisp_Weak_Hash_Table *, Lisp_Object); ptrdiff_t hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key, hash_hash_t *phash); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, hash_hash_t); +ptrdiff_t weak_hash_put (struct Lisp_Weak_Hash_Table *, Lisp_Object, Lisp_Object, + hash_hash_t); void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object); +void weak_hash_remove_from_table (struct Lisp_Weak_Hash_Table *, Lisp_Object); +void weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table *h, ptrdiff_t i0); + extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal; extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t *, ptrdiff_t *); diff --git a/src/pdumper.c b/src/pdumper.c index a560dd06ba8..8f4d3f3dc25 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1441,6 +1441,11 @@ dump_enqueue_object (struct dump_context *ctx, Lisp_Object object, struct link_weight weight) { + if (WEAK_HASH_TABLE_P (object)) + { + strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (object)); + object = XWEAK_HASH_TABLE (object)->dump_replacement; + } if (dump_object_needs_dumping_p (object)) { dump_off state = dump_recall_object (ctx, object); @@ -1943,6 +1948,11 @@ dump_field_lv_or_rawptr (struct dump_context *ctx, /* We don't know about the target object yet, so add a fixup. When we process the fixup, we'll have dumped the target object. */ + if (WEAK_HASH_TABLE_P (value)) + { + strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (value)); + value = XWEAK_HASH_TABLE (value)->dump_replacement; + } out_value = (intptr_t) 0xDEADF00D; dump_remember_fixup_lv (ctx, out_field_offset, @@ -3129,6 +3139,13 @@ dump_vectorlike (struct dump_context *ctx, return dump_vectorlike_generic (ctx, &v->header); case PVEC_BOOL_VECTOR: return dump_bool_vector(ctx, v); + case PVEC_WEAK_HASH_TABLE: + if (WEAK_HASH_TABLE_P (lv)) + { + strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (lv)); + lv = XWEAK_HASH_TABLE (lv)->dump_replacement; + } + return dump_hash_table (ctx, lv); case PVEC_HASH_TABLE: return dump_hash_table (ctx, lv); case PVEC_OBARRAY: diff --git a/src/print.c b/src/print.c index 2840252246f..f0453b72188 100644 --- a/src/print.c +++ b/src/print.c @@ -2188,6 +2188,7 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun, case PVEC_CHAR_TABLE: case PVEC_SUB_CHAR_TABLE: case PVEC_HASH_TABLE: + case PVEC_WEAK_HASH_TABLE: case PVEC_BIGNUM: case PVEC_BOOL_VECTOR: /* Impossible cases. */ @@ -2786,6 +2787,54 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) goto next_obj; } + case PVEC_WEAK_HASH_TABLE: + { + struct Lisp_Weak_Hash_Table *h = XWEAK_HASH_TABLE (obj); + /* Implement a readable output, e.g.: + #s(hash-table test equal data (k1 v1 k2 v2)) */ + print_c_string ("#s(hash-table", printcharfun); + + if (!BASE_EQ (h->strong->test->name, Qeql)) + { + print_c_string (" test ", printcharfun); + print_object (h->strong->test->name, printcharfun, escapeflag); + } + + if (h->strong->weakness != Weak_None) + { + print_c_string (" weakness ", printcharfun); + print_object (hash_table_weakness_symbol (h->strong->weakness), + printcharfun, escapeflag); + } + + /* XXX: strengthen first, then count */ + ptrdiff_t size = XFIXNUM (h->strong->count); + if (size > 0) + { + 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); + + print_stack_push ((struct print_stack_entry){ + .type = PE_hash, + .u.hash.obj = strengthen_hash_table (obj), + .u.hash.nobjs = size * 2, + .u.hash.idx = 0, + .u.hash.printed = 0, + .u.hash.truncated = (size < XFIXNUM (h->strong->count)), + }); + } + else + { + /* Empty table: we can omit the data entirely. */ + printchar (')', printcharfun); + --print_depth; /* Done with this. */ + } + goto next_obj; + } + case PVEC_BIGNUM: print_bignum (obj, printcharfun); break;