From: Mattias Engdegård Date: Fri, 27 Oct 2023 20:15:09 +0000 (+0200) Subject: Use non-Lisp allocation for internal hash-table vectors X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fa5c07fc87d557e642fc325852e8d0c87a9c176e;p=emacs.git Use non-Lisp allocation for internal hash-table vectors Using xmalloc for allocating these arrays is much cheaper than using Lisp vectors since they are no longer marked or swept by the GC, and deallocated much sooner. This makes GC faster and less frequent, and improves temporal locality. Zero-sized tables use NULL for their (0-length) vectors except the index vector which has size 1 and uses a shared constant static vector since it cannot be modified anyway. This makes creation and destruction of zero-sized hash tables very fast; they consume no memory outside the base object. * src/lisp.h (struct Lisp_Hash_Table): Retype the index, next, hash and key_and_value vectors from Lisp_Object to appropriately typed arrays (although hash values are still stored as Lisp fixnums). Add explicit table_size and index_size members. All users updated. * src/alloc.c (gcstat): Add total_hash_table_bytes. (hash_table_allocated_bytes): New. (cleanup_vector): Free hash table vectors when sweeping the object. (hash_table_alloc_bytes, hash_table_free_bytes): New. (sweep_vectors): Update gcstat.total_hash_table_bytes. (total_bytes_of_live_objects): Use it. (purecopy_hash_table): Adapt allocation of hash table vectors. (process_mark_stack): No more Lisp slots in the struct to trace. * src/fns.c (empty_hash_index_vector): New. (allocate_hash_table): Allocate without automatically GCed slots. (alloc_larger_vector): Remove. (make_hash_table, copy_hash_table, maybe_resize_hash_table): Adapt vector allocation and initialisation. * src/pdumper.c (hash_table_freeze, hash_table_thaw, dump_hash_table) (dump_hash_table_contents): Adapt dumping and loading to field changes. --- diff --git a/src/alloc.c b/src/alloc.c index 636b4972c84..7432163db25 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -359,8 +359,16 @@ static struct gcstat object_ct total_floats, total_free_floats; object_ct total_intervals, total_free_intervals; object_ct total_buffers; + + /* Size of the ancillary arrays of live hash-table objects. + The objects themselves are not included (counted as vectors above). */ + byte_ct total_hash_table_bytes; } gcstat; +/* Total size of ancillary arrays of all allocated hash-table objects, + both dead and alive. This number is always kept up-to-date. */ +static ptrdiff_t hash_table_allocated_bytes = 0; + /* Points to memory space allocated as "spare", to be freed if we run out of memory. We keep one large block, four cons-blocks, and two string blocks. */ @@ -3430,6 +3438,23 @@ cleanup_vector (struct Lisp_Vector *vector) } #endif break; + case PVEC_HASH_TABLE: + { + struct Lisp_Hash_Table *h = PSEUDOVEC_STRUCT (vector, Lisp_Hash_Table); + if (h->table_size > 0) + { + eassert (h->index_size > 1); + xfree (h->index); + xfree (h->key_and_value); + xfree (h->next); + xfree (h->hash); + ptrdiff_t bytes = (h->table_size * (2 * sizeof *h->key_and_value + + sizeof *h->hash + + sizeof *h->next) + + h->index_size * sizeof *h->index); + hash_table_allocated_bytes -= bytes; + } + } /* Keep the switch exhaustive. */ case PVEC_NORMAL_VECTOR: case PVEC_FREE: @@ -3440,7 +3465,6 @@ cleanup_vector (struct Lisp_Vector *vector) case PVEC_WINDOW: case PVEC_BOOL_VECTOR: case PVEC_BUFFER: - case PVEC_HASH_TABLE: case PVEC_TERMINAL: case PVEC_WINDOW_CONFIGURATION: case PVEC_OTHER: @@ -3554,6 +3578,8 @@ sweep_vectors (void) lisp_free (lv); } } + + gcstat.total_hash_table_bytes = hash_table_allocated_bytes; } /* Maximum number of elements in a vector. This is a macro so that it @@ -5606,6 +5632,28 @@ valid_lisp_object_p (Lisp_Object obj) return 0; } +/* Like xmalloc, but makes allocation count toward the total consing. + Return NULL for a zero-sized allocation. */ +void * +hash_table_alloc_bytes (ptrdiff_t nbytes) +{ + if (nbytes == 0) + return NULL; + tally_consing (nbytes); + hash_table_allocated_bytes += nbytes; + return xmalloc (nbytes); +} + +/* Like xfree, but makes allocation count toward the total consing. */ +void +hash_table_free_bytes (void *p, ptrdiff_t nbytes) +{ + tally_consing (-nbytes); + hash_table_allocated_bytes -= nbytes; + xfree (p); +} + + /*********************************************************************** Pure Storage Management ***********************************************************************/ @@ -5897,10 +5945,28 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) pure->test.name = purecopy (table->test.name); pure->test.user_hash_function = purecopy (table->test.user_hash_function); pure->test.user_cmp_function = purecopy (table->test.user_cmp_function); - pure->hash = purecopy (table->hash); - pure->next = purecopy (table->next); - pure->index = purecopy (table->index); - pure->key_and_value = purecopy (table->key_and_value); + + if (table->table_size > 0) + { + ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash; + pure->hash = pure_alloc (hash_bytes, -(int)sizeof *table->hash); + memcpy (pure->hash, table->hash, hash_bytes); + + ptrdiff_t next_bytes = table->table_size * sizeof *table->next; + pure->next = pure_alloc (next_bytes, -(int)sizeof *table->next); + memcpy (pure->next, table->next, next_bytes); + + ptrdiff_t nvalues = table->table_size * 2; + ptrdiff_t kv_bytes = nvalues * sizeof *table->key_and_value; + pure->key_and_value = pure_alloc (kv_bytes, + -(int)sizeof *table->key_and_value); + for (ptrdiff_t i = 0; i < nvalues; i++) + pure->key_and_value[i] = purecopy (table->key_and_value[i]); + + ptrdiff_t index_bytes = table->index_size * sizeof *table->index; + pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index); + memcpy (pure->index, table->index, index_bytes); + } return pure; } @@ -6084,6 +6150,7 @@ total_bytes_of_live_objects (void) tot += object_bytes (gcstat.total_floats, sizeof (struct Lisp_Float)); tot += object_bytes (gcstat.total_intervals, sizeof (struct interval)); tot += object_bytes (gcstat.total_strings, sizeof (struct Lisp_String)); + tot += gcstat.total_hash_table_bytes; return tot; } @@ -7227,23 +7294,20 @@ process_mark_stack (ptrdiff_t base_sp) case PVEC_HASH_TABLE: { struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *)ptr; - ptrdiff_t size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; set_vector_marked (ptr); - mark_stack_push_values (ptr->contents, size); mark_stack_push_value (h->test.name); mark_stack_push_value (h->test.user_hash_function); mark_stack_push_value (h->test.user_cmp_function); if (h->weakness == Weak_None) - mark_stack_push_value (h->key_and_value); + mark_stack_push_values (h->key_and_value, + 2 * h->table_size); else { - /* For weak tables, mark only the vector and not its + /* For weak tables, don't mark the contents --- that's what makes it weak. */ eassert (h->next_weak == NULL); h->next_weak = weak_hash_tables; weak_hash_tables = h; - if (!PURE_P (h->key_and_value)) - set_vector_marked (XVECTOR (h->key_and_value)); } break; } diff --git a/src/fns.c b/src/fns.c index a1659884b5e..3aca588a8a5 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4275,17 +4275,20 @@ CHECK_HASH_TABLE (Lisp_Object x) static void set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - gc_aset (h->next, idx, make_fixnum (val)); + eassert (idx >= 0 && idx < h->table_size); + h->next[idx] = val; } static void set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { - gc_aset (h->hash, idx, val); + eassert (idx >= 0 && idx < h->table_size); + h->hash[idx] = val; } static void set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - gc_aset (h->index, idx, make_fixnum (val)); + eassert (idx >= 0 && idx < h->index_size); + h->index[idx] = val; } /* If OBJ is a Lisp hash table, return a pointer to its struct @@ -4375,7 +4378,8 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) static ptrdiff_t HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return XFIXNUM (AREF (h->next, idx)); + eassert (idx >= 0 && idx < h->table_size); + return h->next[idx]; } /* Return the index of the element in hash table H that is the start @@ -4384,7 +4388,8 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) static ptrdiff_t HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return XFIXNUM (AREF (h->index, idx)); + eassert (idx >= 0 && idx < h->index_size); + return h->index[idx]; } /* Restore a hash table's mutability after the critical section exits. */ @@ -4495,8 +4500,7 @@ struct hash_table_test const static struct Lisp_Hash_Table * allocate_hash_table (void) { - return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, - index, PVEC_HASH_TABLE); + return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE); } /* An upper bound on the size of a hash table index. It must fit in @@ -4528,6 +4532,10 @@ hash_index_size (ptrdiff_t size) return index_size; } +/* Constant hash index vector used when the table size is zero. + This avoids allocating it from the heap. */ +static const ptrdiff_t empty_hash_index_vector[] = {-1}; + /* Create and initialize a new hash table. TEST specifies the test the hash table will use to compare keys. @@ -4547,36 +4555,54 @@ Lisp_Object make_hash_table (struct hash_table_test test, EMACS_INT size, hash_table_weakness_t weak, bool purecopy) { - struct Lisp_Hash_Table *h; - Lisp_Object table; - ptrdiff_t i; - - /* Preconditions. */ eassert (SYMBOLP (test.name)); - eassert (0 <= size && size <= MOST_POSITIVE_FIXNUM); + eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX)); - /* Allocate a table and initialize it. */ - h = allocate_hash_table (); + struct Lisp_Hash_Table *h = allocate_hash_table (); - /* Initialize hash table slots. */ h->test = test; h->weakness = weak; h->count = 0; - h->key_and_value = make_vector (2 * size, HASH_UNUSED_ENTRY_KEY); - h->hash = make_nil_vector (size); - h->next = make_vector (size, make_fixnum (-1)); - h->index = make_vector (hash_index_size (size), make_fixnum (-1)); + h->table_size = size; + int index_size = hash_index_size (size); + h->index_size = index_size; + + if (size == 0) + { + h->key_and_value = NULL; + h->hash = NULL; + h->next = NULL; + eassert (index_size == 1); + h->index = (ptrdiff_t *)empty_hash_index_vector; + h->next_free = -1; + } + else + { + h->key_and_value = hash_table_alloc_bytes (2 * size + * sizeof *h->key_and_value); + for (ptrdiff_t i = 0; i < 2 * size; i++) + h->key_and_value[i] = HASH_UNUSED_ENTRY_KEY; + + h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); + memclear (h->hash, size * sizeof *h->hash); + + h->next = hash_table_alloc_bytes (size * sizeof *h->next); + for (ptrdiff_t i = 0; i < size - 1; i++) + h->next[i] = i + 1; + h->next[size - 1] = -1; + + h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + h->index[i] = -1; + + h->next_free = 0; + } + h->next_weak = NULL; h->purecopy = purecopy; h->mutable = true; - /* Set up the free list. */ - for (i = 0; i < size - 1; ++i) - set_hash_next_slot (h, i, i + 1); - if (size > 0) - set_hash_next_slot (h, size - 1, -1); - h->next_free = size > 0 ? 0 : -1; - + Lisp_Object table; XSET_HASH_TABLE (table, h); eassert (HASH_TABLE_P (table)); eassert (XHASH_TABLE (table) == h); @@ -4597,35 +4623,37 @@ copy_hash_table (struct Lisp_Hash_Table *h1) h2 = allocate_hash_table (); *h2 = *h1; h2->mutable = true; - h2->key_and_value = Fcopy_sequence (h1->key_and_value); - h2->hash = Fcopy_sequence (h1->hash); - h2->next = Fcopy_sequence (h1->next); - h2->index = Fcopy_sequence (h1->index); + + if (h1->table_size > 0) + { + ptrdiff_t kv_bytes = 2 * h1->table_size * sizeof *h1->key_and_value; + h2->key_and_value = hash_table_alloc_bytes (kv_bytes); + memcpy (h2->key_and_value, h1->key_and_value, kv_bytes); + + ptrdiff_t hash_bytes = h1->table_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; + h2->next = hash_table_alloc_bytes (next_bytes); + memcpy (h2->next, h1->next, next_bytes); + + ptrdiff_t index_bytes = h1->index_size * sizeof *h1->index; + h2->index = hash_table_alloc_bytes (index_bytes); + memcpy (h2->index, h1->index, index_bytes); + } XSET_HASH_TABLE (table, h2); return table; } -/* Allocate a Lisp vector of NEW_SIZE elements. - Copy elements from VEC and leave the rest undefined. */ -static Lisp_Object -alloc_larger_vector (Lisp_Object vec, ptrdiff_t new_size) -{ - eassert (VECTORP (vec)); - ptrdiff_t old_size = ASIZE (vec); - eassert (new_size >= old_size); - struct Lisp_Vector *v = allocate_vector (new_size); - memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents); - XSETVECTOR (vec, v); - return vec; -} - /* Compute index into the index vector from a hash value. */ static inline ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h, Lisp_Object hash_code) { - return XUFIXNUM (hash_code) % ASIZE (h->index); + eassert (h->index_size > 0); + return XUFIXNUM (hash_code) % h->index_size; } /* Resize hash table H if it's too full. If H cannot be resized @@ -4650,37 +4678,56 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) /* Allocate all the new vectors before updating *H, to avoid problems if memory is exhausted. */ - Lisp_Object next = alloc_larger_vector (h->next, new_size); + ptrdiff_t *next = hash_table_alloc_bytes (new_size * sizeof *next); for (ptrdiff_t i = old_size; i < new_size - 1; i++) - ASET (next, i, make_fixnum (i + 1)); - ASET (next, new_size - 1, make_fixnum (-1)); + next[i] = i + 1; + next[new_size - 1] = -1; - /* Build the new&larger key_and_value vector, making sure the new - fields are initialized to `unbound`. */ - Lisp_Object key_and_value - = alloc_larger_vector (h->key_and_value, 2 * new_size); + Lisp_Object *key_and_value + = hash_table_alloc_bytes (2 * new_size * sizeof *key_and_value); + memcpy (key_and_value, h->key_and_value, + 2 * old_size * sizeof *key_and_value); for (ptrdiff_t i = 2 * old_size; i < 2 * new_size; i++) - ASET (key_and_value, i, HASH_UNUSED_ENTRY_KEY); + key_and_value[i] = HASH_UNUSED_ENTRY_KEY; - Lisp_Object hash = alloc_larger_vector (h->hash, new_size); - memclear (XVECTOR (hash)->contents + old_size, - (new_size - old_size) * word_size); + Lisp_Object *hash = hash_table_alloc_bytes (new_size * sizeof *hash); + memcpy (hash, h->hash, old_size * sizeof *hash); + memclear (hash + old_size, (new_size - old_size) * word_size); + + ptrdiff_t old_index_size = h->index_size; ptrdiff_t index_size = hash_index_size (new_size); - h->index = make_vector (index_size, make_fixnum (-1)); + ptrdiff_t *index = hash_table_alloc_bytes (index_size * sizeof *index); + for (ptrdiff_t i = 0; i < index_size; i++) + index[i] = -1; + + h->index_size = index_size; + h->table_size = new_size; + h->next_free = old_size; + + if (old_index_size > 1) + hash_table_free_bytes (h->index, old_index_size * sizeof *h->index); + h->index = index; + + hash_table_free_bytes (h->key_and_value, + 2 * old_size * sizeof *h->key_and_value); h->key_and_value = key_and_value; + + hash_table_free_bytes (h->hash, old_size * sizeof *h->hash); h->hash = hash; + + hash_table_free_bytes (h->next, old_size * sizeof *h->next); h->next = next; - h->next_free = old_size; - /* Rehash. */ + h->key_and_value = key_and_value; + + /* Rehash: all data occupy entries 0..old_size-1. */ for (ptrdiff_t i = 0; i < old_size; i++) - if (!NILP (HASH_HASH (h, i))) - { - Lisp_Object hash_code = HASH_HASH (h, i); - ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); - set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); - set_hash_index_slot (h, start_of_bucket, i); - } + { + Lisp_Object hash_code = HASH_HASH (h, i); + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); + set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); + set_hash_index_slot (h, start_of_bucket, i); + } #ifdef ENABLE_CHECKING if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) @@ -4710,14 +4757,22 @@ hash_table_thaw (Lisp_Object hash_table) /* Freezing discarded most non-essential information; recompute it. The allocation is minimal with no room for growth. */ h->test = *hash_table_test_from_std (h->frozen_test); - ptrdiff_t size = ASIZE (h->key_and_value) / 2; - h->count = size; + ptrdiff_t size = h->count; + h->table_size = size; ptrdiff_t index_size = hash_index_size (size); + h->index_size = index_size; h->next_free = -1; - h->hash = make_nil_vector (size); - h->next = make_vector (size, make_fixnum (-1)); - h->index = make_vector (index_size, make_fixnum (-1)); + h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); + memclear (h->hash, size * sizeof *h->hash); + + h->next = hash_table_alloc_bytes (size * sizeof *h->next); + for (ptrdiff_t i = 0; i < size; i++) + h->next[i] = -1; + + h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + h->index[i] = -1; /* Recompute the actual hash codes for each entry in the table. Order is still invalid. */ @@ -4843,7 +4898,7 @@ hash_clear (struct Lisp_Hash_Table *h) if (h->count > 0) { ptrdiff_t size = HASH_TABLE_SIZE (h); - memclear (xvector_contents (h->hash), size * word_size); + memclear (h->hash, size * word_size); for (ptrdiff_t i = 0; i < size; i++) { set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); @@ -4851,8 +4906,8 @@ hash_clear (struct Lisp_Hash_Table *h) set_hash_value_slot (h, i, Qnil); } - for (ptrdiff_t i = 0; i < ASIZE (h->index); i++) - ASET (h->index, i, make_fixnum (-1)); + for (ptrdiff_t i = 0; i < h->index_size; i++) + h->index[i] = -1; h->next_free = 0; h->count = 0; @@ -4890,7 +4945,7 @@ keep_entry_p (hash_table_weakness_t weakness, bool sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) { - ptrdiff_t n = gc_asize (h->index); + ptrdiff_t n = h->index_size; bool marked = false; for (ptrdiff_t bucket = 0; bucket < n; ++bucket) @@ -4928,8 +4983,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) /* Clear key, value, and hash. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - if (!NILP (h->hash)) - set_hash_hash_slot (h, i, Qnil); + set_hash_hash_slot (h, i, Qnil); eassert (h->count != 0); h->count--; @@ -5563,7 +5617,7 @@ DEFUN ("internal--hash-table-histogram", struct Lisp_Hash_Table *h = check_hash_table (hash_table); ptrdiff_t size = HASH_TABLE_SIZE (h); ptrdiff_t *freq = xzalloc (size * sizeof *freq); - ptrdiff_t index_size = ASIZE (h->index); + ptrdiff_t index_size = h->index_size; for (ptrdiff_t i = 0; i < index_size; i++) { ptrdiff_t n = 0; @@ -5591,7 +5645,7 @@ Internal use only. */) { struct Lisp_Hash_Table *h = check_hash_table (hash_table); Lisp_Object ret = Qnil; - ptrdiff_t index_size = ASIZE (h->index); + ptrdiff_t index_size = h->index_size; for (ptrdiff_t i = 0; i < index_size; i++) { Lisp_Object bucket = Qnil; @@ -5612,8 +5666,7 @@ DEFUN ("internal--hash-table-index-size", (Lisp_Object hash_table) { struct Lisp_Hash_Table *h = check_hash_table (hash_table); - ptrdiff_t index_size = ASIZE (h->index); - return make_int (index_size); + return make_int (h->index_size); } diff --git a/src/lisp.h b/src/lisp.h index f863df6bca0..dd457392cca 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2450,25 +2450,28 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ - /* Vector of hash codes, or nil if the table needs rehashing. - If the I-th entry is unused, then hash[I] should be nil. */ - Lisp_Object hash; + /* Bucket vector. An entry of -1 indicates no item is present, + and a nonnegative entry is the index of the first item in + a collision chain. + This vector is index_size entries long. + If index_size is 1 (and table_size is 0), then this is the + constant read-only vector {-1}, shared between all instances. + Otherwise it is heap-allocated. */ + ptrdiff_t *index; + ptrdiff_t index_size; /* Size of the index vector. */ + + ptrdiff_t table_size; /* Size of the next and hash vectors. */ + + /* Vector of hash codes. Each entry is either a fixnum, or nil if unused. + This vector is table_size entries long. */ + Lisp_Object *hash; /* Vector used to chain entries. If entry I is free, next[I] is the entry number of the next free item. If entry I is non-free, next[I] is the index of the next entry in the collision chain, - or -1 if there is such entry. */ - Lisp_Object next; - - /* Bucket vector. An entry of -1 indicates no item is present, - and a nonnegative entry is the index of the first item in - a collision chain. This vector's size can be larger than the - hash table size to reduce collisions. */ - Lisp_Object index; - - /* Only the fields above are traced normally by the GC. The ones after - 'index' are special and are either ignored by the GC or traced in - a special way (e.g. because of weakness). */ + or -1 if there is no such entry. + This vector is table_size entries long. */ + ptrdiff_t *next; /* Number of key/value entries in the table. */ ptrdiff_t count; @@ -2494,8 +2497,9 @@ struct Lisp_Hash_Table /* Vector of keys and values. The key of item I is found at index 2 * I, the value is found at index 2 * I + 1. If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. - This is gc_marked specially if the table is weak. */ - Lisp_Object key_and_value; + This is gc_marked specially if the table is weak. + This vector is 2 * table_size entries long. */ + Lisp_Object *key_and_value; /* The comparison and hash functions. */ struct hash_table_test test; @@ -2506,9 +2510,6 @@ struct Lisp_Hash_Table struct Lisp_Hash_Table *next_weak; } GCALIGNED_STRUCT; -/* Sanity-check pseudovector layout. */ -verify (offsetof (struct Lisp_Hash_Table, hash) == header_size); - /* Key value that marks an unused hash table entry. */ #define HASH_UNUSED_ENTRY_KEY Qunbound @@ -2539,28 +2540,31 @@ XHASH_TABLE (Lisp_Object a) INLINE Lisp_Object HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return AREF (h->key_and_value, 2 * idx); + eassert (idx >= 0 && idx < h->table_size); + return h->key_and_value[2 * idx]; } /* 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) { - return AREF (h->key_and_value, 2 * idx + 1); + eassert (idx >= 0 && idx < h->table_size); + return h->key_and_value[2 * idx + 1]; } /* Value is the hash code computed for entry IDX in hash table H. */ INLINE Lisp_Object HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return AREF (h->hash, idx); + eassert (idx >= 0 && idx < h->table_size); + return h->hash[idx]; } /* Value is the size of hash table H. */ INLINE ptrdiff_t HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) { - return ASIZE (h->next); + return h->table_size; } /* Compute hash value for KEY in hash table H. */ @@ -3781,13 +3785,15 @@ vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object const *args, INLINE void set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { - gc_aset (h->key_and_value, 2 * idx, val); + eassert (idx >= 0 && idx < h->table_size); + h->key_and_value[2 * idx] = val; } INLINE void set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { - gc_aset (h->key_and_value, 2 * idx + 1, val); + eassert (idx >= 0 && idx < h->table_size); + h->key_and_value[2 * idx + 1] = val;; } /* Use these functions to set Lisp_Object @@ -4458,6 +4464,9 @@ extern void syms_of_alloc (void); extern struct buffer *allocate_buffer (void) ATTRIBUTE_RETURNS_NONNULL; extern int valid_lisp_object_p (Lisp_Object); +void *hash_table_alloc_bytes (ptrdiff_t nbytes); +void hash_table_free_bytes (void *p, ptrdiff_t nbytes); + /* Defined in gmalloc.c. */ #if !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC && !defined SYSTEM_MALLOC extern size_t __malloc_extra_blocks; diff --git a/src/pdumper.c b/src/pdumper.c index e4349f0cb17..8a93c45e07b 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2648,12 +2648,13 @@ 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 Lisp_Object +static Lisp_Object * hash_table_contents (struct Lisp_Hash_Table *h) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); ptrdiff_t size = h->count; - Lisp_Object key_and_value = make_uninit_vector (2 * size); + Lisp_Object *key_and_value = hash_table_alloc_bytes (2 * size + * sizeof *key_and_value); ptrdiff_t n = 0; /* Make sure key_and_value ends up in the same order; charset.c @@ -2662,8 +2663,8 @@ hash_table_contents (struct Lisp_Hash_Table *h) for (ptrdiff_t i = 0; i < old_size; i++) if (!NILP (HASH_HASH (h, i))) { - ASET (key_and_value, n++, HASH_KEY (h, i)); - ASET (key_and_value, n++, HASH_VALUE (h, i)); + key_and_value[n++] = HASH_KEY (h, i); + key_and_value[n++] = HASH_VALUE (h, i); } return key_and_value; @@ -2698,14 +2699,37 @@ static void hash_table_freeze (struct Lisp_Hash_Table *h) { h->key_and_value = hash_table_contents (h); - eassert (ASIZE (h->key_and_value) == h->count * 2); - h->next = Qnil; - h->hash = Qnil; - h->index = Qnil; - h->count = 0; + h->next = NULL; + h->hash = NULL; + h->index = NULL; + h->table_size = 0; + h->index_size = 0; h->frozen_test = hash_table_std_test (&h->test); } +static dump_off +dump_hash_table_contents (struct dump_context *ctx, struct Lisp_Hash_Table *h) +{ + dump_align_output (ctx, DUMP_ALIGNMENT); + dump_off start_offset = ctx->offset; + ptrdiff_t n = 2 * h->count; + + struct dump_flags old_flags = ctx->flags; + ctx->flags.pack_objects = true; + + for (ptrdiff_t i = 0; i < n; i++) + { + Lisp_Object out; + const Lisp_Object *slot = &h->key_and_value[i]; + dump_object_start (ctx, &out, sizeof out); + dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG); + dump_object_finish (ctx, &out, sizeof out); + } + + ctx->flags = old_flags; + return start_offset; +} + static dump_off dump_hash_table (struct dump_context *ctx, Lisp_Object object) { @@ -2721,15 +2745,21 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) START_DUMP_PVEC (ctx, &hash->header, struct Lisp_Hash_Table, out); dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header); - /* TODO: dump the hash bucket vectors synchronously here to keep - them as close to the hash table as possible. */ + DUMP_FIELD_COPY (out, hash, count); DUMP_FIELD_COPY (out, hash, weakness); DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); DUMP_FIELD_COPY (out, hash, frozen_test); - dump_field_lv (ctx, out, hash, &hash->key_and_value, WEIGHT_STRONG); + if (hash->key_and_value) + dump_field_fixup_later (ctx, out, hash, &hash->key_and_value); eassert (hash->next_weak == NULL); - return finish_dump_pvec (ctx, &out->header); + dump_off offset = finish_dump_pvec (ctx, &out->header); + if (hash->key_and_value) + dump_remember_fixup_ptr_raw + (ctx, + offset + dump_offsetof (struct Lisp_Hash_Table, key_and_value), + dump_hash_table_contents (ctx, hash)); + return offset; } static dump_off diff --git a/src/print.c b/src/print.c index cc8df639f4f..c27c66ae40a 100644 --- a/src/print.c +++ b/src/print.c @@ -1455,8 +1455,8 @@ print_preprocess (Lisp_Object obj) if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); - obj = h->key_and_value; - continue; + pp_stack_push_values (h->key_and_value, + 2 * h->table_size); } break; }