From 7d93a0147a14e14d6964bf93ba11cf494b9d49fd Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 2 Nov 2023 17:05:26 +0100 Subject: [PATCH] Share hash table test structs This saves several words in the hash table object at the cost of an indirection at runtime. This seems to be a gain in overall performance. FIXME: We cache hash test objects in a rather clumsy way. A better solution is sought. * src/lisp.h (struct Lisp_Hash_Table): Use a pointer to the test struct. All references adapted. * src/alloc.c (garbage_collect): * src/fns.c (struct hash_table_user_test, hash_table_user_tests) (mark_fns, get_hash_table_user_test): New state for caching test structs, and functions managing it. --- src/alloc.c | 8 +--- src/bytecode.c | 2 +- src/category.c | 2 +- src/emacs-module.c | 2 +- src/fns.c | 92 +++++++++++++++++++++++++++++++++------------- src/frame.c | 2 +- src/image.c | 2 +- src/lisp.h | 8 ++-- src/lread.c | 8 ++-- src/pdumper.c | 3 +- src/pgtkterm.c | 2 +- src/print.c | 4 +- src/profiler.c | 2 +- src/xfaces.c | 2 +- src/xterm.c | 2 +- 15 files changed, 90 insertions(+), 51 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 7432163db25..16aaa32e15f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5942,10 +5942,6 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) *pure = *table; pure->mutable = false; - 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); - if (table->table_size > 0) { ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash; @@ -6630,6 +6626,7 @@ garbage_collect (void) #ifdef HAVE_NS mark_nsterm (); #endif + mark_fns (); /* Everything is now marked, except for the data in font caches, undo lists, and finalizers. The first two are compacted by @@ -7295,9 +7292,6 @@ process_mark_stack (ptrdiff_t base_sp) { struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *)ptr; set_vector_marked (ptr); - 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_values (h->key_and_value, 2 * h->table_size); diff --git a/src/bytecode.c b/src/bytecode.c index a0f02d518b7..ed6e2b34e77 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1743,7 +1743,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, /* h->count is a faster approximation for HASH_TABLE_SIZE (h) here. */ - if (h->count <= 5 && !h->test.cmpfn) + if (h->count <= 5 && !h->test->cmpfn) { /* Do a linear search if there are not many cases FIXME: 5 is arbitrarily chosen. */ for (i = h->count; 0 <= --i; ) diff --git a/src/category.c b/src/category.c index 3a406a567a1..498b6a2a1c9 100644 --- a/src/category.c +++ b/src/category.c @@ -51,7 +51,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) if (NILP (XCHAR_TABLE (table)->extras[1])) set_char_table_extras (table, 1, - make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); + make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); hash_hash_t hash; ptrdiff_t i = hash_lookup_get_hash (h, category_set, &hash); diff --git a/src/emacs-module.c b/src/emacs-module.c index e78391b3a71..00ae33dfa2c 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1698,7 +1698,7 @@ syms_of_module (void) { staticpro (&Vmodule_refs_hash); Vmodule_refs_hash - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/src/fns.c b/src/fns.c index c4e7a98a4d3..e491202cf54 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4448,7 +4448,7 @@ static Lisp_Object cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, struct Lisp_Hash_Table *h) { - Lisp_Object args[] = { h->test.user_cmp_function, key1, key2 }; + Lisp_Object args[] = { h->test->user_cmp_function, key1, key2 }; return hash_table_user_defined_call (ARRAYELTS (args), args, h); } @@ -4487,7 +4487,7 @@ hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) static hash_hash_t hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { - Lisp_Object args[] = { h->test.user_hash_function, key }; + Lisp_Object args[] = { h->test->user_hash_function, key }; Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h); return FIXNUMP (hash) ? XUFIXNUM(hash) : sxhash (hash); } @@ -4557,10 +4557,10 @@ static const hash_idx_t empty_hash_index_vector[] = {-1}; changed after purecopy. */ Lisp_Object -make_hash_table (struct hash_table_test test, EMACS_INT size, +make_hash_table (const struct hash_table_test *test, EMACS_INT size, hash_table_weakness_t weak, bool purecopy) { - eassert (SYMBOLP (test.name)); + eassert (SYMBOLP (test->name)); eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX)); struct Lisp_Hash_Table *h = allocate_hash_table (); @@ -4763,7 +4763,7 @@ 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); + h->test = hash_table_test_from_std (h->frozen_test); ptrdiff_t size = h->count; h->table_size = size; ptrdiff_t index_size = hash_index_size (size); @@ -4805,9 +4805,9 @@ hash_lookup_with_hash (struct Lisp_Hash_Table *h, for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) if (EQ (key, HASH_KEY (h, i)) - || (h->test.cmpfn + || (h->test->cmpfn && hash == HASH_HASH (h, i) - && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) + && !NILP (h->test->cmpfn (key, HASH_KEY (h, i), h)))) return i; return -1; @@ -4884,9 +4884,9 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) i = HASH_NEXT (h, i)) { if (EQ (key, HASH_KEY (h, i)) - || (h->test.cmpfn + || (h->test->cmpfn && hashval == HASH_HASH (h, i) - && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) + && !NILP (h->test->cmpfn (key, HASH_KEY (h, i), h)))) { /* Take entry out of collision chain. */ if (prev < 0) @@ -5339,6 +5339,58 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) return make_ufixnum (hashfn_equal (obj, NULL)); } + +/* This is a cache of hash_table_test structures so that they can be + shared between hash tables using the same test. + FIXME: This way of storing and looking up hash_table_test structs + isn't wonderful. Find a better solution. */ +struct hash_table_user_test +{ + struct hash_table_test test; + struct hash_table_user_test *next; +}; + +static struct hash_table_user_test *hash_table_user_tests = NULL; + +void +mark_fns (void) +{ + for (struct hash_table_user_test *ut = hash_table_user_tests; + ut; ut = ut->next) + { + mark_object (ut->test.name); + mark_object (ut->test.user_cmp_function); + mark_object (ut->test.user_hash_function); + } +} + +static struct hash_table_test * +get_hash_table_user_test (Lisp_Object test) +{ + Lisp_Object prop = Fget (test, Qhash_table_test); + if (!CONSP (prop) || !CONSP (XCDR (prop))) + signal_error ("Invalid hash table test", test); + + Lisp_Object equal_fn = XCAR (prop); + Lisp_Object hash_fn = XCAR (XCDR (prop)); + struct hash_table_user_test *ut = hash_table_user_tests; + while (ut && !(EQ (equal_fn, ut->test.user_cmp_function) + && EQ (hash_fn, ut->test.user_hash_function))) + ut = ut->next; + if (!ut) + { + ut = xmalloc (sizeof *ut); + ut->test.name = test; + ut->test.user_cmp_function = equal_fn; + ut->test.user_hash_function = hash_fn; + ut->test.hashfn = hashfn_user_defined; + ut->test.cmpfn = cmpfn_user_defined; + ut->next = hash_table_user_tests; + hash_table_user_tests = ut; + } + return &ut->test; +} + DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, doc: /* Create and return a new hash table. @@ -5384,25 +5436,15 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) Lisp_Object test = i ? args[i] : Qeql; if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (test)) test = SYMBOL_WITH_POS_SYM (test); - struct hash_table_test testdesc; + const struct hash_table_test *testdesc; if (BASE_EQ (test, Qeq)) - testdesc = hashtest_eq; + testdesc = &hashtest_eq; else if (BASE_EQ (test, Qeql)) - testdesc = hashtest_eql; + testdesc = &hashtest_eql; else if (BASE_EQ (test, Qequal)) - testdesc = hashtest_equal; + testdesc = &hashtest_equal; else - { - /* See if it is a user-defined test. */ - Lisp_Object prop = Fget (test, Qhash_table_test); - if (!CONSP (prop) || !CONSP (XCDR (prop))) - signal_error ("Invalid hash table test", test); - testdesc.name = test; - testdesc.user_cmp_function = XCAR (prop); - testdesc.user_hash_function = XCAR (XCDR (prop)); - testdesc.hashfn = hashfn_user_defined; - testdesc.cmpfn = cmpfn_user_defined; - } + testdesc = get_hash_table_user_test (test); /* See if there's a `:purecopy PURECOPY' argument. */ i = get_key_arg (QCpurecopy, nargs, args, used); @@ -5504,7 +5546,7 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0, doc: /* Return the test TABLE uses. */) (Lisp_Object table) { - return check_hash_table (table)->test.name; + return check_hash_table (table)->test->name; } Lisp_Object diff --git a/src/frame.c b/src/frame.c index 08057736272..abd6ef00901 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1040,7 +1040,7 @@ make_frame (bool mini_p) rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f); fset_face_hash_table - (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false)); + (f, make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false)); if (mini_p) { diff --git a/src/image.c b/src/image.c index 74d4b6c0bfe..66838adbb2a 100644 --- a/src/image.c +++ b/src/image.c @@ -6069,7 +6069,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, { *put_func = xpm_put_color_table_h; *get_func = xpm_get_color_table_h; - return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); + return make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); } static void diff --git a/src/lisp.h b/src/lisp.h index 33c1e345f7a..b11237381d9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2397,6 +2397,7 @@ typedef enum { struct hash_table_test { + /* FIXME: reorder for efficiency */ /* Function used to compare keys; always a bare symbol. */ Lisp_Object name; @@ -2515,7 +2516,7 @@ struct Lisp_Hash_Table Lisp_Object *key_and_value; /* The comparison and hash functions. */ - struct hash_table_test test; + const struct hash_table_test *test; /* Next weak hash table if this is a weak hash table. The head of the list is in weak_hash_tables. Used only during garbage @@ -2584,7 +2585,7 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) INLINE hash_hash_t hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) { - return h->test.hashfn (key, h); + return h->test->hashfn (key, h); } void hash_table_thaw (Lisp_Object hash_table); @@ -4064,7 +4065,7 @@ extern void hexbuf_digest (char *, void const *, int); extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); -Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, +Lisp_Object make_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); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object); @@ -4098,6 +4099,7 @@ extern Lisp_Object plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val); extern Lisp_Object plist_member (Lisp_Object plist, Lisp_Object prop); extern void syms_of_fns (void); +extern void mark_fns (void); /* Defined in sort.c */ extern void tim_sort (Lisp_Object, Lisp_Object *, const ptrdiff_t); diff --git a/src/lread.c b/src/lread.c index b76fde3f266..2c6a444ec56 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2544,11 +2544,11 @@ readevalloop (Lisp_Object readcharfun, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (!NILP (Vpurify_flag) && c == '(') val = read0 (readcharfun, false); else @@ -2792,11 +2792,11 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) diff --git a/src/pdumper.c b/src/pdumper.c index 6b053c5b601..13077526776 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2704,7 +2704,8 @@ hash_table_freeze (struct Lisp_Hash_Table *h) h->index = NULL; h->table_size = 0; h->index_size = 0; - h->frozen_test = hash_table_std_test (&h->test); + h->frozen_test = hash_table_std_test (h->test); + h->test = NULL; } static dump_off diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 57ea82daa5e..b731f52983d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7178,7 +7178,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false); + Vpgtk_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false); window_being_scrolled = Qnil; staticpro (&window_being_scrolled); diff --git a/src/print.c b/src/print.c index c27c66ae40a..58a23b79d5d 100644 --- a/src/print.c +++ b/src/print.c @@ -2577,10 +2577,10 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) #s(hash-table test equal data (k1 v1 k2 v2)) */ print_c_string ("#s(hash-table", printcharfun); - if (!BASE_EQ (h->test.name, Qeql)) + if (!BASE_EQ (h->test->name, Qeql)) { print_c_string (" test ", printcharfun); - print_object (h->test.name, printcharfun, escapeflag); + print_object (h->test->name, printcharfun, escapeflag); } if (h->weakness != Weak_None) diff --git a/src/profiler.c b/src/profiler.c index 06ffecf41e3..5a6a8b48f6b 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -563,7 +563,7 @@ export_log (struct profiler_log *plog) which is more discriminating than the `function-equal' used by the log but close enough, and will never confuse two distinct keys in the log. */ - Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, + Lisp_Object h = make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); for (int i = 0; i < log->size; i++) { diff --git a/src/xfaces.c b/src/xfaces.c index c9dd0f90feb..2ca2c30636c 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7333,7 +7333,7 @@ only for this purpose. */); doc: /* Hash table of global face definitions (for internal use only.) */); Vface_new_frame_defaults = /* 33 entries is enough to fit all basic faces */ - make_hash_table (hashtest_eq, 33, Weak_None, false); + make_hash_table (&hashtest_eq, 33, Weak_None, false); DEFVAR_LISP ("face-default-stipple", Vface_default_stipple, doc: /* Default stipple pattern used on monochrome displays. diff --git a/src/xterm.c b/src/xterm.c index e4139a79a6e..77d6550c8b9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32554,7 +32554,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("x-keysym-table", Vx_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vx_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false); + Vx_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, -- 2.39.2