From 7d93a0147a14e14d6964bf93ba11cf494b9d49fd Mon Sep 17 00:00:00 2001
From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
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