scratch/hash-table-perf ad3d2f8ed88 25/37: Share hash table test structs

[Mattias Engdegård]

branch: scratch/hash-table-perf
commit ad3d2f8ed883d580d9b4d15a59b3cd3ae23366ae
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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 d95be3c3282..ba4ef5c9fdc 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5951,10 +5951,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);
-
   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);
@@ -6635,6 +6631,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
@@ -7300,9 +7297,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 38b70fed43f..d05e8472e1b 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 be94b6b1417..b47865e1853 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 59980e364b1..9f0eeeaf072 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 b2a0d5b3be4..6b797b18e5e 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);
 }
@@ -4553,10 +4553,10 @@ hash_index_size (ptrdiff_t size)
    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 ();
@@ -4746,7 +4746,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);
@@ -4788,9 +4788,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;
@@ -4867,9 +4867,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)
@@ -5322,6 +5322,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.
 
@@ -5367,25 +5419,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);
@@ -5487,7 +5529,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 2604505ee2a..ad96232e725 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 5a1dd92a87a..68b7e4f5c64 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 92e36b71392..1cee9b5d427 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;
 
@@ -2490,7 +2491,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
@@ -2559,7 +2560,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);
@@ -4006,7 +4007,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);
@@ -4040,6 +4041,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 6f5a237b714..3cb8d6935e4 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 5d88f1706eb..bc7d8fac5fe 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 3ce34ce2d37..eecebf4074d 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -7180,7 +7180,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 6efc1c31490..92a6b45543c 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 cdccc4fe6d1..cf3a0904307 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -565,7 +565,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 2cd7870024e..0cebf0e01d8 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 6e73cf82d8f..5d83865c478 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -32555,7 +32555,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,