scratch/igc 2500fd86ceb 2/2: Weak hash tables: continue implementation

[Pip Cet]

branch: scratch/igc
commit 2500fd86ceba5753766e623258732f83c089c21a
Author: Pip Cet <pipcet@protonmail.com>
Commit: Pip Cet <pipcet@protonmail.com>

    Weak hash tables: continue implementation
    
    * src/fns.c (weak_hash_table_thaw): New function.
    (strengthen_hash_table_for_dump): Copy `weakness' to dumped hash
    table.
    (Fcopy_hash_table)
    (Fhash_table_rehash_size)
    (Fhash_table_rehash_threshold)
    (Fhash_table_size)
    (Fhash_table_test)
    (Fhash_table_weakness)
    (Finternal__hash_table_histogram)
    (Finternal__hash_table_buckets)
    (Finternal__hash_table_index_size): Implement for weak hash tables.
    (Fmaphash): Use snapshot of weak hash table.
    * src/pdumper.c (struct dump_context): Add list of weak hash tables.
    (dump_enqueue_object)
    (dump_vectorlike)
    (decode_emacs_reloc)
    (dump_field_lv_or_rawptr): Drop weak hash table special case.
    (dump_hash_table_list): Dump weak as well as strong hash tables.
    (dump_weak_hash_table): New function.
    (thaw_hash_tables): Handle weak as well as strong hash tables.
---
 src/fns.c     | 86 ++++++++++++++++++++++++++++++++++++++++++++++++++++-------
 src/lisp.h    |  2 ++
 src/pdumper.c | 68 +++++++++++++++++++++++++---------------------
 3 files changed, 117 insertions(+), 39 deletions(-)

diff --git a/src/fns.c b/src/fns.c
index bd5e830e918..221e239c639 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4841,8 +4841,12 @@ compute_hash_index_bits (hash_idx_t size)
 static const hash_idx_t empty_hash_index_vector[] = {-1};
 
 #ifdef HAVE_MPS
-static Lisp_Object make_weak_hash_table (const struct hash_table_test *test, 
EMACS_INT size,
-                                        hash_table_weakness_t weak, bool 
purecopy);
+static struct Lisp_Weak_Hash_Table *allocate_weak_hash_table
+(hash_table_weakness_t weak, ssize_t size, ssize_t index_bits);
+
+static Lisp_Object make_weak_hash_table
+(const struct hash_table_test *test, EMACS_INT size,
+ hash_table_weakness_t weak, bool purecopy);
 #endif
 
 /* Create and initialize a new hash table.
@@ -5119,6 +5123,29 @@ hash_table_thaw (Lisp_Object hash_table)
     }
 }
 
+#ifdef HAVE_MPS
+void
+weak_hash_table_thaw (Lisp_Object weak_hash_table)
+{
+  struct Lisp_Hash_Table *strong_hash_table =
+    XHASH_TABLE (XWEAK_HASH_TABLE (weak_hash_table)->dump_replacement);
+
+  struct Lisp_Weak_Hash_Table *new_table =
+    XWEAK_HASH_TABLE (make_weak_hash_table
+                     (strong_hash_table->test,
+                      HASH_TABLE_SIZE (strong_hash_table),
+                      strong_hash_table->weakness,
+                      false));
+
+  XWEAK_HASH_TABLE (weak_hash_table)->strong = new_table->strong;
+  XWEAK_HASH_TABLE (weak_hash_table)->weak = new_table->weak;
+  XWEAK_HASH_TABLE (weak_hash_table)->dump_replacement = Qnil;
+
+  DOHASH (strong_hash_table, k, v)
+    Fputhash (k, v, weak_hash_table);
+}
+#endif
+
 void
 hash_table_rehash (struct Lisp_Hash_Table *h)
 {
@@ -5491,6 +5518,9 @@ allocate_weak_hash_table (hash_table_weakness_t weak, 
ssize_t size, ssize_t inde
   return ret;
 }
 
+/* Return a hash table containing a snapshot of the entries of weak hash
+   table WEAK. */
+
 Lisp_Object
 strengthen_hash_table (Lisp_Object weak)
 {
@@ -5505,12 +5535,16 @@ strengthen_hash_table (Lisp_Object weak)
   return ret;
 }
 
+/* Return a hash table, new or existing, suitable for dumping and
+   restoring weak hash table WEAK. */
+
 Lisp_Object
 strengthen_hash_table_for_dump (struct Lisp_Weak_Hash_Table *weak)
 {
   if (!NILP (weak->dump_replacement))
     return weak->dump_replacement;
   Lisp_Object ret = strengthen_hash_table (make_lisp_weak_hash_table (weak));
+  XHASH_TABLE (ret)->weakness = weak->strong->weakness;
   weak->dump_replacement = ret;
 
   return ret;
@@ -6331,6 +6365,13 @@ DEFUN ("copy-hash-table", Fcopy_hash_table, 
Scopy_hash_table, 1, 1, 0,
        doc: /* Return a copy of hash table TABLE.  */)
   (Lisp_Object table)
 {
+#ifdef HAVE_MPS
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      return copy_hash_table (XHASH_TABLE (strengthen_hash_table (table)));
+    }
+#endif
   return copy_hash_table (check_hash_table (table));
 }
 
@@ -6358,6 +6399,10 @@ This function is for compatibility only; it returns a 
nominal value
 without current significance.  */)
   (Lisp_Object table)
 {
+#ifdef HAVE_MPS
+  if (WEAK_HASH_TABLE_P (table))
+    table = strengthen_hash_table (table);
+#endif
   CHECK_HASH_TABLE (table);
   return make_float (1.5);  /* The old default rehash-size value.  */
 }
@@ -6370,6 +6415,10 @@ This function is for compatibility only; it returns a 
nominal value
 without current significance.  */)
   (Lisp_Object table)
 {
+#ifdef HAVE_MPS
+  if (WEAK_HASH_TABLE_P (table))
+    table = strengthen_hash_table (table);
+#endif
   CHECK_HASH_TABLE (table);
   return make_float (0.8125);  /* The old default rehash-threshold value.  */
 }
@@ -6386,6 +6435,10 @@ hold without growing, but since hash tables grow 
automatically, this
 number is rarely of interest.  */)
   (Lisp_Object table)
 {
+#ifdef HAVE_MPS
+  if (WEAK_HASH_TABLE_P (table))
+    table = strengthen_hash_table (table);
+#endif
   struct Lisp_Hash_Table *h = check_hash_table (table);
   return make_fixnum (HASH_TABLE_SIZE (h));
 }
@@ -6395,6 +6448,10 @@ DEFUN ("hash-table-test", Fhash_table_test, 
Shash_table_test, 1, 1, 0,
        doc: /* Return the test TABLE uses.  */)
   (Lisp_Object table)
 {
+#ifdef HAVE_MPS
+  if (WEAK_HASH_TABLE_P (table))
+    table = strengthen_hash_table (table);
+#endif
   return check_hash_table (table)->test->name;
 }
 
@@ -6417,6 +6474,10 @@ DEFUN ("hash-table-weakness", Fhash_table_weakness, 
Shash_table_weakness,
        doc: /* Return the weakness of TABLE.  */)
   (Lisp_Object table)
 {
+#ifdef HAVE_MPS
+  if (WEAK_HASH_TABLE_P (table))
+    table = strengthen_hash_table (table);
+#endif
   return hash_table_weakness_symbol (check_hash_table (table)->weakness);
 }
 
@@ -6533,13 +6594,8 @@ set a new value for KEY, or `remhash' to remove KEY.
   (Lisp_Object function, Lisp_Object table)
 {
 #ifdef HAVE_MPS
-  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
-  if (wh)
-    {
-      DOHASH_WEAK_SAFE (wh, i)
-       call2 (function, WEAK_HASH_KEY (wh, i), WEAK_HASH_VALUE (wh, i));
-      return Qnil;
-    }
+  if (WEAK_HASH_TABLE_P (table))
+    table = strengthen_hash_table (table);
 #endif
   struct Lisp_Hash_Table *h = check_hash_table (table);
   /* We can't use DOHASH here since FUNCTION may violate the rules and
@@ -6575,6 +6631,10 @@ DEFUN ("internal--hash-table-histogram",
        doc: /* Bucket size histogram of HASH-TABLE.  Internal use only. */)
   (Lisp_Object hash_table)
 {
+#ifdef HAVE_MPS
+  if (WEAK_HASH_TABLE_P (hash_table))
+    hash_table = strengthen_hash_table (hash_table);
+#endif
   struct Lisp_Hash_Table *h = check_hash_table (hash_table);
   ptrdiff_t size = HASH_TABLE_SIZE (h);
   ptrdiff_t *freq = xzalloc (size * sizeof *freq);
@@ -6604,6 +6664,10 @@ DEFUN ("internal--hash-table-buckets",
 Internal use only. */)
   (Lisp_Object hash_table)
 {
+#ifdef HAVE_MPS
+  if (WEAK_HASH_TABLE_P (hash_table))
+    hash_table = strengthen_hash_table (hash_table);
+#endif
   struct Lisp_Hash_Table *h = check_hash_table (hash_table);
   Lisp_Object ret = Qnil;
   ptrdiff_t index_size = hash_table_index_size (h);
@@ -6626,6 +6690,10 @@ DEFUN ("internal--hash-table-index-size",
        doc: /* Index size of HASH-TABLE.  Internal use only. */)
   (Lisp_Object hash_table)
 {
+#ifdef HAVE_MPS
+  if (WEAK_HASH_TABLE_P (hash_table))
+    hash_table = strengthen_hash_table (hash_table);
+#endif
   struct Lisp_Hash_Table *h = check_hash_table (hash_table);
   return make_int (hash_table_index_size (h));
 }
diff --git a/src/lisp.h b/src/lisp.h
index 4e38a445d48..34bf483b511 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4250,6 +4250,8 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t 
idx, Lisp_Object val)
 }
 
 #ifdef HAVE_MPS
+void weak_hash_table_thaw (Lisp_Object hash_table);
+
 INLINE void
 set_weak_hash_key_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, 
Lisp_Object val)
 {
diff --git a/src/pdumper.c b/src/pdumper.c
index c9ca674ba66..73719567f80 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -573,6 +573,10 @@ struct dump_context
 
   /* List of hash tables that have been dumped.  */
   Lisp_Object hash_tables;
+#ifdef HAVE_MPS
+  /* List of weak hash tables that have been dumped.  */
+  Lisp_Object weak_hash_tables;
+#endif
 
   dump_off number_hot_relocations;
   dump_off number_discardable_relocations;
@@ -1441,13 +1445,6 @@ dump_enqueue_object (struct dump_context *ctx,
                      Lisp_Object object,
                      struct link_weight weight)
 {
-#ifdef HAVE_MPS
-  if (WEAK_HASH_TABLE_P (object))
-    {
-      strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (object));
-      object = XWEAK_HASH_TABLE (object)->dump_replacement;
-    }
-#endif
   if (dump_object_needs_dumping_p (object))
     {
       dump_off state = dump_recall_object (ctx, object);
@@ -1947,13 +1944,6 @@ dump_field_lv_or_rawptr (struct dump_context *ctx,
     }
   else
     {
-#ifdef HAVE_MPS
-      if (WEAK_HASH_TABLE_P (value))
-       {
-         strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (value));
-         value = XWEAK_HASH_TABLE (value)->dump_replacement;
-       }
-#endif
       /* We don't know about the target object yet, so add a fixup.
          When we process the fixup, we'll have dumped the target
          object.  */
@@ -2692,8 +2682,13 @@ static dump_off
 dump_hash_table_list (struct dump_context *ctx)
 {
   dump_off offset = ctx->offset;
+#ifdef HAVE_MPS
+  if (!NILP (ctx->hash_tables) || !NILP (ctx->weak_hash_tables))
+    offset = dump_object (ctx, CALLN (Fvconcat, ctx->hash_tables, 
ctx->weak_hash_tables));
+#else
   if (!NILP (ctx->hash_tables))
     offset = dump_object (ctx, CALLN (Fvconcat, ctx->hash_tables));
+#endif
   return offset;
 }
 
@@ -2816,6 +2811,23 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object 
object)
   return offset;
 }
 
+#ifdef HAVE_MPS
+static dump_off
+dump_weak_hash_table (struct dump_context *ctx, Lisp_Object object)
+{
+  struct Lisp_Weak_Hash_Table *wh_in = XWEAK_HASH_TABLE (object);
+  strengthen_hash_table_for_dump (wh_in);
+
+  START_DUMP_PVEC (ctx, &wh_in->header, struct Lisp_Weak_Hash_Table, out);
+  dump_push (&ctx->weak_hash_tables, object);
+
+  dump_field_lv (ctx, out, wh_in, &wh_in->dump_replacement,
+                WEIGHT_NORMAL);
+  dump_off offset = finish_dump_pvec (ctx, &wh_in->header);
+  return offset;
+}
+#endif
+
 static dump_off
 dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o)
 {
@@ -3146,12 +3158,7 @@ dump_vectorlike (struct dump_context *ctx,
       return dump_bool_vector(ctx, v);
 #ifdef HAVE_MPS
     case PVEC_WEAK_HASH_TABLE:
-      if (WEAK_HASH_TABLE_P (lv))
-       {
-         strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (lv));
-         lv = XWEAK_HASH_TABLE (lv)->dump_replacement;
-       }
-      return dump_hash_table (ctx, lv);
+      return dump_weak_hash_table (ctx, lv);
 #endif
     case PVEC_HASH_TABLE:
       return dump_hash_table (ctx, lv);
@@ -4015,15 +4022,6 @@ decode_emacs_reloc (struct dump_context *ctx, 
Lisp_Object lreloc)
           {
            eassume (ctx); /* Pacify GCC 9.2.1 -O3 -Wnull-dereference.  */
             eassert (!dump_object_emacs_ptr (target_value));
-#ifdef HAVE_MPS
-           if (WEAK_HASH_TABLE_P (target_value))
-             {
-               strengthen_hash_table_for_dump
-                 (XWEAK_HASH_TABLE (target_value));
-               target_value =
-                 XWEAK_HASH_TABLE (target_value)->dump_replacement;
-             }
-#endif
             reloc.u.dump_offset = dump_recall_object (ctx, target_value);
             if (reloc.u.dump_offset <= 0)
               {
@@ -6217,7 +6215,17 @@ thaw_hash_tables (void)
 {
   Lisp_Object hash_tables = *pdumper_hashes;
   for (ptrdiff_t i = 0; i < ASIZE (hash_tables); i++)
-    hash_table_thaw (AREF (hash_tables, i));
+    {
+      Lisp_Object table = AREF (hash_tables, i);
+      if (HASH_TABLE_P (table))
+       hash_table_thaw (table);
+#ifdef HAVE_MPS
+      else if (WEAK_HASH_TABLE_P (table))
+       weak_hash_table_thaw (table);
+#endif
+      else
+       emacs_abort ();
+    }
 }
 
 #endif /* HAVE_PDUMPER */