bug#36597: 27.0.50; rehash hash tables eagerly in pdumper

[Pip Cet <pipcet@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 493 bytes --]

On Fri, Jul 19, 2019 at 7:46 AM Eli Zaretskii <eliz@gnu.org> wrote:

> > +static void thaw_hash_tables (void)
> > +{
>
> This is not our style of defining a function.  The name should begin
> on a new line.

Thanks for pointing that out, revised patch attached.

I'm currently playing around with redefining hash tables not to have
internal freelists. That makes the hash table code a lot simpler
overall, but some of that simplicity would be lost trying to support
lazy hash table rehashing.

[-- Attachment #2: 0001-Rehash-hash-tables-eagerly-after-loading-a-dump.patch --]
[-- Type: text/x-patch, Size: 18045 bytes --]

From dd7743b50c58a5c9bb25b3ed05245a19b0dd19d7 Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@gmail.com>
Date: Fri, 19 Jul 2019 07:12:42 +0000
Subject: [PATCH] Rehash hash tables eagerly after loading a dump.

* src/lisp.h (hash_rehash_needed_p): Remove.  All uses removed.
(hash_rehash_if_needed): Remove.  All uses removed.
(struct Lisp_Hash_Table): Remove comment about rehashing hash tables.
* src/pdumper.c (thaw_hash_tables): New function.
(hash_table_thaw): New function.
(hash_table_freeze): New function.
(dump_hash_table): Simplify.
(dump_hash_table_list): New function.
(hash_table_contents): New function.
(Fdump_emacs_portable): Handle hash tables by eager rehashing.
(pdumper_load): Restore hash tables.
(init_pdumper_once): New function.
---
 src/bytecode.c  |   1 -
 src/composite.c |   1 -
 src/emacs.c     |   1 +
 src/fns.c       |  65 +++++------------
 src/lisp.h      |  19 +----
 src/minibuf.c   |   3 -
 src/pdumper.c   | 183 ++++++++++++++++++++++--------------------------
 src/pdumper.h   |   1 +
 8 files changed, 104 insertions(+), 170 deletions(-)

diff --git a/src/bytecode.c b/src/bytecode.c
index 29dff44f00..9c72429e0c 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1402,7 +1402,6 @@ #define DEFINE(name, value) LABEL (name) ,
             Lisp_Object v1 = POP;
             ptrdiff_t i;
             struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table);
-            hash_rehash_if_needed (h);
 
             /* h->count is a faster approximation for HASH_TABLE_SIZE (h)
                here. */
diff --git a/src/composite.c b/src/composite.c
index 183062de46..49a285cff0 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -654,7 +654,6 @@ gstring_lookup_cache (Lisp_Object header)
 composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
 {
   struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
-  hash_rehash_if_needed (h);
   Lisp_Object header = LGSTRING_HEADER (gstring);
   EMACS_UINT hash = h->test.hashfn (&h->test, header);
   if (len < 0)
diff --git a/src/emacs.c b/src/emacs.c
index ad661a081b..855b2c6715 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1560,6 +1560,7 @@ main (int argc, char **argv)
   if (!initialized)
     {
       init_alloc_once ();
+      init_pdumper_once ();
       init_obarray_once ();
       init_eval_once ();
       init_charset_once ();
diff --git a/src/fns.c b/src/fns.c
index 0497588689..6f86d7f314 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4233,51 +4233,27 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
 
 /* Recompute the hashes (and hence also the "next" pointers).
    Normally there's never a need to recompute hashes.
-   This is done only on first-access to a hash-table loaded from
-   the "pdump", because the object's addresses may have changed, thus
+   This is done only on first access to a hash-table loaded from
+   the "pdump", because the objects' addresses may have changed, thus
    affecting their hash.  */
 void
 hash_table_rehash (struct Lisp_Hash_Table *h)
 {
-  ptrdiff_t size = HASH_TABLE_SIZE (h);
-
-  /* These structures may have been purecopied and shared
-     (bug#36447).  */
-  h->next = Fcopy_sequence (h->next);
-  h->index = Fcopy_sequence (h->index);
-  h->hash = Fcopy_sequence (h->hash);
-
   /* Recompute the actual hash codes for each entry in the table.
      Order is still invalid.  */
-  for (ptrdiff_t i = 0; i < size; ++i)
-    if (!NILP (HASH_HASH (h, i)))
-      {
-        Lisp_Object key = HASH_KEY (h, i);
-        EMACS_UINT hash_code = h->test.hashfn (&h->test, key);
-        set_hash_hash_slot (h, i, make_fixnum (hash_code));
-      }
-
-  /* Reset the index so that any slot we don't fill below is marked
-     invalid.  */
-  Ffillarray (h->index, make_fixnum (-1));
-
-  /* Rebuild the collision chains.  */
-  for (ptrdiff_t i = 0; i < size; ++i)
-    if (!NILP (HASH_HASH (h, i)))
-      {
-        EMACS_UINT hash_code = XUFIXNUM (HASH_HASH (h, i));
-        ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
-        set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
-        set_hash_index_slot (h, start_of_bucket, i);
-        eassert (HASH_NEXT (h, i) != i); /* Stop loops.  */
-      }
+  for (ptrdiff_t i = 0; i < h->count; ++i)
+    {
+      Lisp_Object key = HASH_KEY (h, i);
+      EMACS_UINT hash_code = h->test.hashfn (&h->test, key);
+      ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
+      set_hash_hash_slot (h, i, make_fixnum (hash_code));
+      set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
+      set_hash_index_slot (h, start_of_bucket, i);
+      eassert (HASH_NEXT (h, i) != i); /* Stop loops.  */
+    }
 
-  /* Finally, mark the hash table as having a valid hash order.
-     Do this last so that if we're interrupted, we retry on next
-     access. */
-  eassert (h->count < 0);
-  h->count = -h->count;
-  eassert (!hash_rehash_needed_p (h));
+  for (ptrdiff_t i = h->count; i < ASIZE (h->next) - 1; i++)
+    set_hash_next_slot (h, i, i + 1);
 }
 
 /* Lookup KEY in hash table H.  If HASH is non-null, return in *HASH
@@ -4290,8 +4266,6 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash)
   EMACS_UINT hash_code;
   ptrdiff_t start_of_bucket, i;
 
-  hash_rehash_if_needed (h);
-
   hash_code = h->test.hashfn (&h->test, key);
   eassert ((hash_code & ~INTMASK) == 0);
   if (hash)
@@ -4320,8 +4294,6 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
 {
   ptrdiff_t start_of_bucket, i;
 
-  hash_rehash_if_needed (h);
-
   eassert ((hash & ~INTMASK) == 0);
 
   /* Increment count after resizing because resizing may fail.  */
@@ -4355,8 +4327,6 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
   ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
   ptrdiff_t prev = -1;
 
-  hash_rehash_if_needed (h);
-
   for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket);
        0 <= i;
        i = HASH_NEXT (h, i))
@@ -4434,9 +4404,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
   for (ptrdiff_t bucket = 0; bucket < n; ++bucket)
     {
       /* Follow collision chain, removing entries that don't survive
-         this garbage collection.  It's okay if hash_rehash_needed_p
-         (h) is true, since we're operating entirely on the cached
-         hash values. */
+         this garbage collection.  */
       ptrdiff_t prev = -1;
       ptrdiff_t next;
       for (ptrdiff_t i = HASH_INDEX (h, bucket); 0 <= i; i = next)
@@ -4478,7 +4446,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
                   set_hash_hash_slot (h, i, Qnil);
 
                   eassert (h->count != 0);
-                  h->count += h->count > 0 ? -1 : 1;
+                  h->count--;
                 }
 	      else
 		{
@@ -4881,7 +4849,6 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
   (Lisp_Object table)
 {
   struct Lisp_Hash_Table *h = check_hash_table (table);
-  hash_rehash_if_needed (h);
   return make_fixnum (h->count);
 }
 
diff --git a/src/lisp.h b/src/lisp.h
index 13014c82dc..d0e5c43c41 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2245,11 +2245,7 @@ #define DEFSYM(sym, name) /* empty */
 
 struct Lisp_Hash_Table
 {
-  /* Change pdumper.c if you change the fields here.
-
-     IMPORTANT!!!!!!!
-
-     Call hash_rehash_if_needed() before accessing.  */
+  /* Change pdumper.c if you change the fields here.  */
 
   /* This is for Lisp; the hash table code does not refer to it.  */
   union vectorlike_header header;
@@ -2363,19 +2359,6 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
 
 void hash_table_rehash (struct Lisp_Hash_Table *h);
 
-INLINE bool
-hash_rehash_needed_p (const struct Lisp_Hash_Table *h)
-{
-  return h->count < 0;
-}
-
-INLINE void
-hash_rehash_if_needed (struct Lisp_Hash_Table *h)
-{
-  if (hash_rehash_needed_p (h))
-    hash_table_rehash (h);
-}
-
 /* Default size for hash tables if not specified.  */
 
 enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 };
diff --git a/src/minibuf.c b/src/minibuf.c
index d9a6e15b05..e923ce2a43 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1203,9 +1203,6 @@ DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
       bucket = AREF (collection, idx);
     }
 
-  if (HASH_TABLE_P (collection))
-    hash_rehash_if_needed (XHASH_TABLE (collection));
-
   while (1)
     {
       /* Get the next element of the alist, obarray, or hash-table.  */
diff --git a/src/pdumper.c b/src/pdumper.c
index 03c00bf27b..697ff9767a 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -107,17 +107,6 @@ #define VM_MS_WINDOWS 2
 
 #define DANGEROUS 0
 
-/* PDUMPER_CHECK_REHASHING being true causes the portable dumper to
-   check, for each hash table it dumps, that the hash table means the
-   same thing after rehashing.  */
-#ifndef PDUMPER_CHECK_REHASHING
-# if ENABLE_CHECKING
-#  define PDUMPER_CHECK_REHASHING 1
-# else
-#  define PDUMPER_CHECK_REHASHING 0
-# endif
-#endif
-
 /* We require an architecture in which all pointers are the same size
    and have the same layout, where pointers are either 32 or 64 bits
    long, and where bytes have eight bits --- that is, a
@@ -393,6 +382,8 @@ dump_fingerprint (char const *label,
      The start of the cold region is always aligned on a page
      boundary.  */
   dump_off cold_start;
+
+  dump_off hash_list;
 };
 
 /* Double-ended singly linked list.  */
@@ -550,6 +541,8 @@ dump_fingerprint (char const *label,
      heap objects.  */
   Lisp_Object bignum_data;
 
+  Lisp_Object hash_tables;
+
   unsigned number_hot_relocations;
   unsigned number_discardable_relocations;
 };
@@ -2622,68 +2615,58 @@ dump_vectorlike_generic (struct dump_context *ctx,
   return offset;
 }
 
-/* Determine whether the hash table's hash order is stable
-   across dump and load.  If it is, we don't have to trigger
-   a rehash on access.  */
-static bool
-dump_hash_table_stable_p (const struct Lisp_Hash_Table *hash)
+/* Return a vector of KEY, VALUE pairs in the given hash table H.  The
+   first H->count pairs are valid, the rest is left as nil.  */
+static Lisp_Object
+hash_table_contents (struct Lisp_Hash_Table *h)
 {
-  bool is_eql = hash->test.hashfn == hashfn_eql;
-  bool is_equal = hash->test.hashfn == hashfn_equal;
-  ptrdiff_t size = HASH_TABLE_SIZE (hash);
-  for (ptrdiff_t i = 0; i < size; ++i)
-    if (!NILP (HASH_HASH (hash, i)))
+  Lisp_Object contents = Qnil;
+  /* Make sure key_and_value ends up in the same order, charset.c
+     relies on it by expecting hash table indices to stay constant
+     across the dump.  */
+  for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h) - h->count; i++)
+    {
+      dump_push (&contents, Qnil);
+      dump_push (&contents, Qnil);
+    }
+
+  for (ptrdiff_t i = HASH_TABLE_SIZE (h) - 1; i >= 0; --i)
+    if (!NILP (HASH_HASH (h, i)))
       {
-        Lisp_Object key =  HASH_KEY (hash, i);
-	bool key_stable = (dump_builtin_symbol_p (key)
-			   || FIXNUMP (key)
-			   || (is_equal && STRINGP (key))
-			   || ((is_equal || is_eql) && FLOATP (key)));
-        if (!key_stable)
-          return false;
+	dump_push (&contents, HASH_VALUE (h, i));
+	dump_push (&contents, HASH_KEY (h, i));
       }
 
-  return true;
+  return CALLN (Fapply, Qvector, contents);
 }
 
-/* Return a list of (KEY . VALUE) pairs in the given hash table.  */
-static Lisp_Object
-hash_table_contents (Lisp_Object table)
+static dump_off
+dump_hash_table_list (struct dump_context *ctx)
 {
-  Lisp_Object contents = Qnil;
-  struct Lisp_Hash_Table *h = XHASH_TABLE (table);
-  for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
-    if (!NILP (HASH_HASH (h, i)))
-      dump_push (&contents, Fcons (HASH_KEY (h, i), HASH_VALUE (h, i)));
-  return Fnreverse (contents);
+  if (CONSP (ctx->hash_tables))
+    return dump_object (ctx, CALLN (Fapply, Qvector, ctx->hash_tables));
+  else
+    return 0;
 }
 
-/* Copy the given hash table, rehash it, and make sure that we can
-   look up all the values in the original.  */
 static void
-check_hash_table_rehash (Lisp_Object table_orig)
-{
-  hash_rehash_if_needed (XHASH_TABLE (table_orig));
-  Lisp_Object table_rehashed = Fcopy_hash_table (table_orig);
-  eassert (XHASH_TABLE (table_rehashed)->count >= 0);
-  XHASH_TABLE (table_rehashed)->count *= -1;
-  eassert (XHASH_TABLE (table_rehashed)->count <= 0);
-  hash_rehash_if_needed (XHASH_TABLE (table_rehashed));
-  eassert (XHASH_TABLE (table_rehashed)->count >= 0);
-  Lisp_Object expected_contents = hash_table_contents (table_orig);
-  while (!NILP (expected_contents))
-    {
-      Lisp_Object key_value_pair = dump_pop (&expected_contents);
-      Lisp_Object key = XCAR (key_value_pair);
-      Lisp_Object expected_value = XCDR (key_value_pair);
-      Lisp_Object arbitrary = Qdump_emacs_portable__sort_predicate_copied;
-      Lisp_Object found_value = Fgethash (key, table_rehashed, arbitrary);
-      eassert (EQ (expected_value, found_value));
-      Fremhash (key, table_rehashed);
-    }
+hash_table_freeze (struct Lisp_Hash_Table *h)
+{
+  ptrdiff_t nkeys = XFIXNAT (Flength (h->key_and_value)) / 2;
+  h->key_and_value = hash_table_contents (h);
+  h->next_free = (nkeys == h->count ? -1 : h->count);
+  h->index = Flength (h->index);
+  h->next = h->hash = make_fixnum (nkeys);
+}
+
+static void
+hash_table_thaw (struct Lisp_Hash_Table *h)
+{
+  h->index = Fmake_vector (h->index, make_fixnum (-1));
+  h->hash = Fmake_vector (h->hash, Qnil);
+  h->next = Fmake_vector (h->next, make_fixnum (-1));
 
-  eassert (EQ (Fhash_table_count (table_rehashed),
-               make_fixnum (0)));
+  hash_table_rehash (h);
 }
 
 static dump_off
@@ -2695,45 +2678,11 @@ dump_hash_table (struct dump_context *ctx,
 # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
 #endif
   const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
-  bool is_stable = dump_hash_table_stable_p (hash_in);
-  /* If the hash table is likely to be modified in memory (either
-     because we need to rehash, and thus toggle hash->count, or
-     because we need to assemble a list of weak tables) punt the hash
-     table to the end of the dump, where we can lump all such hash
-     tables together.  */
-  if (!(is_stable || !NILP (hash_in->weak))
-      && ctx->flags.defer_hash_tables)
-    {
-      if (offset != DUMP_OBJECT_ON_HASH_TABLE_QUEUE)
-        {
-	  eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
-		   || offset == DUMP_OBJECT_NOT_SEEN);
-          /* We still want to dump the actual keys and values now.  */
-          dump_enqueue_object (ctx, hash_in->key_and_value, WEIGHT_NONE);
-          /* We'll get to the rest later.  */
-          offset = DUMP_OBJECT_ON_HASH_TABLE_QUEUE;
-          dump_remember_object (ctx, object, offset);
-          dump_push (&ctx->deferred_hash_tables, object);
-        }
-      return offset;
-    }
-
-  if (PDUMPER_CHECK_REHASHING)
-    check_hash_table_rehash (make_lisp_ptr ((void *) hash_in, Lisp_Vectorlike));
-
   struct Lisp_Hash_Table hash_munged = *hash_in;
   struct Lisp_Hash_Table *hash = &hash_munged;
 
-  /* Remember to rehash this hash table on first access.  After a
-     dump reload, the hash table values will have changed, so we'll
-     need to rebuild the index.
-
-     TODO: for EQ and EQL hash tables, it should be possible to rehash
-     here using the preferred load address of the dump, eliminating
-     the need to rehash-on-access if we can load the dump where we
-     want.  */
-  if (hash->count > 0 && !is_stable)
-    hash->count = -hash->count;
+  hash_table_freeze (hash);
+  dump_push (&ctx->hash_tables, object);
 
   START_DUMP_PVEC (ctx, &hash->header, struct Lisp_Hash_Table, out);
   dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header);
@@ -4140,6 +4089,19 @@ DEFUN ("dump-emacs-portable",
 	 || !NILP (ctx->deferred_hash_tables)
 	 || !NILP (ctx->deferred_symbols));
 
+  ctx->header.hash_list = ctx->offset;
+  dump_hash_table_list (ctx);
+
+  do
+    {
+      dump_drain_deferred_hash_tables (ctx);
+      dump_drain_deferred_symbols (ctx);
+      dump_drain_normal_queue (ctx);
+    }
+  while (!dump_queue_empty_p (&ctx->dump_queue)
+	 || !NILP (ctx->deferred_hash_tables)
+	 || !NILP (ctx->deferred_symbols));
+
   dump_sort_copied_objects (ctx);
 
   /* While we copy built-in symbols into the Emacs image, these
@@ -5290,6 +5252,9 @@ dump_do_all_emacs_relocations (const struct dump_header *const header,
    NUMBER_DUMP_SECTIONS,
   };
 
+/* Pointer to a stack variable to avoid having to staticpro it.  */
+static Lisp_Object *pdumper_hashes = &zero_vector;
+
 /* Load a dump from DUMP_FILENAME.  Return an error code.
 
    N.B. We run very early in initialization, so we can't use lisp,
@@ -5431,6 +5396,15 @@ pdumper_load (const char *dump_filename)
   for (int i = 0; i < ARRAYELTS (sections); ++i)
     dump_mmap_reset (&sections[i]);
 
+  Lisp_Object hashes = zero_vector;
+  if (header->hash_list)
+    {
+      struct Lisp_Vector *hash_tables =
+	((struct Lisp_Vector *)(dump_base + header->hash_list));
+      XSETVECTOR (hashes, hash_tables);
+    }
+
+  pdumper_hashes = &hashes;
   /* Run the functions Emacs registered for doing post-dump-load
      initialization.  */
   for (int i = 0; i < nr_dump_hooks; ++i)
@@ -5501,6 +5475,19 @@ DEFUN ("pdumper-stats", Fpdumper_stats, Spdumper_stats, 0, 0, 0,
 #endif /* HAVE_PDUMPER */
 
 \f
+static void
+thaw_hash_tables (void)
+{
+  Lisp_Object hash_tables = *pdumper_hashes;
+  for (ptrdiff_t i = 0; i < ASIZE (hash_tables); i++)
+    hash_table_thaw (XHASH_TABLE (AREF (hash_tables, i)));
+}
+
+void
+init_pdumper_once (void)
+{
+  pdumper_do_now_and_after_load (thaw_hash_tables);
+}
 
 void
 syms_of_pdumper (void)
diff --git a/src/pdumper.h b/src/pdumper.h
index ab2f426c1e..cfea06d33d 100644
--- a/src/pdumper.h
+++ b/src/pdumper.h
@@ -248,6 +248,7 @@ pdumper_clear_marks (void)
    file was loaded.  */
 extern void pdumper_record_wd (const char *);
 
+void init_pdumper_once (void);
 void syms_of_pdumper (void);
 
 INLINE_HEADER_END
-- 
2.22.0