scratch/igc ca48b31e014: Fix handling of finalized PVECs in weak hash tables

[Pip Cet]

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

    Fix handling of finalized PVECs in weak hash tables
    
    * src/fns.c (make_weak_hash_table)
    (maybe_resize_weak_hash_table)
    (weak_hash_put)
    (weak_hash_splat_from_table)
    (weak_hash_clear)
    (Fhash_table_count): Remove `count' element for weak hash tables.
    * src/igc.c (SPLAT_PVEC): New macro.
    (finalize_vector): Mark finalized PVECs as PVEC_FREE.
    (process_one_message): Add comment about the need to suspend other
    threads.
    * src/lisp.h (DOHASH_WEAK): Ignore PVEC_FREE when iterating.
    * src/print.c (print_object): Strengthen weak hash tables before
    printing them.
---
 src/fns.c   | 31 +++++++++++--------------------
 src/igc.c   |  7 +++++++
 src/lisp.h  |  3 ++-
 src/print.c | 32 ++++++--------------------------
 4 files changed, 26 insertions(+), 47 deletions(-)

diff --git a/src/fns.c b/src/fns.c
index b9c43f61938..250cf6c3a7e 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5537,7 +5537,6 @@ make_weak_hash_table (const struct hash_table_test *test, 
EMACS_INT size,
 
   h->strong->test = test;
   h->strong->weakness = weak;
-  h->strong->count = make_fixnum (0);
   h->strong->table_size = make_fixnum (size);
 
   if (size == 0)
@@ -5625,7 +5624,6 @@ maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table 
*h)
        default:
          emacs_abort ();
        }
-      strong->count = make_fixnum (0);
 
       for (ptrdiff_t i = 0; i < new_size - 1; i++)
        strong->next[i].lisp_object = make_fixnum (i + 1);
@@ -5698,7 +5696,6 @@ weak_hash_put (struct Lisp_Weak_Hash_Table *h, 
Lisp_Object key, Lisp_Object valu
   //eassert (!hash_unused_entry_key_p (key));
   /* Increment count after resizing because resizing may fail.  */
   maybe_resize_weak_hash_table (h);
-  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) + 1);
 
   /* Store key/value in the key_and_value vector.  */
   ptrdiff_t i = XFIXNUM (h->strong->next_free);
@@ -5747,7 +5744,6 @@ weak_hash_remove_from_table (struct Lisp_Weak_Hash_Table 
*h, Lisp_Object key)
          set_weak_hash_value_slot (h, i, Qnil);
          set_weak_hash_next_slot (h, i, XFIXNUM (h->strong->next_free));
          h->strong->next_free = make_fixnum (i);
-         h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1);
          break;
        }
 
@@ -5783,7 +5779,6 @@ weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table 
*h, ptrdiff_t i0)
          set_weak_hash_value_slot (h, i, Qnil);
          set_weak_hash_next_slot (h, i, XFIXNUM (h->strong->next_free));
          h->strong->next_free = make_fixnum (i);
-         h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1);
          break;
        }
 
@@ -5796,23 +5791,19 @@ weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table 
*h, ptrdiff_t i0)
 static void
 weak_hash_clear (struct Lisp_Weak_Hash_Table *h)
 {
-  if (XFIXNUM (h->strong->count) > 0)
+  ptrdiff_t size = WEAK_HASH_TABLE_SIZE (h);
+  for (ptrdiff_t i = 0; i < size; i++)
     {
-      ptrdiff_t size = WEAK_HASH_TABLE_SIZE (h);
-      for (ptrdiff_t i = 0; i < size; i++)
-       {
-         set_weak_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
-         set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
-         set_weak_hash_value_slot (h, i, Qnil);
-       }
+      set_weak_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
+      set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
+      set_weak_hash_value_slot (h, i, Qnil);
+    }
 
-      ptrdiff_t index_size = weak_hash_table_index_size (h);
-      for (ptrdiff_t i = 0; i < index_size; i++)
-       h->strong->index[i].lisp_object = make_fixnum (-1);
+  ptrdiff_t index_size = weak_hash_table_index_size (h);
+  for (ptrdiff_t i = 0; i < index_size; i++)
+    h->strong->index[i].lisp_object = make_fixnum (-1);
 
-      h->strong->next_free = make_fixnum (0);
-      h->strong->count = make_fixnum (0);
-    }
+  h->strong->next_free = make_fixnum (0);
 }
 #endif
 
@@ -6341,7 +6332,7 @@ DEFUN ("hash-table-count", Fhash_table_count, 
Shash_table_count, 1, 1, 0,
   struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
   if (wh)
     {
-      return wh->strong->count;
+      table = strengthen_hash_table (table);
     }
 #endif
   struct Lisp_Hash_Table *h = check_hash_table (table);
diff --git a/src/igc.c b/src/igc.c
index fe4556fab7b..38a69ad3369 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -2985,9 +2985,14 @@ finalize_finalizer (struct Lisp_Finalizer *f)
     }
 }
 
+/* Turn an existing pseudovector into a PVEC_FREE, keeping its size. */
+#define SPLAT_PVEC(v)                           \
+  (((v)->header.size &= ~PVEC_TYPE_MASK), XSETPVECTYPE(v, PVEC_FREE))
+
 static void
 finalize_vector (mps_addr_t v)
 {
+  struct Lisp_Vector *vec = v;
   switch (pseudo_vector_type (v))
     {
     case PVEC_FREE:
@@ -3084,6 +3089,7 @@ finalize_vector (mps_addr_t v)
       igc_assert (!"finalization not implemented");
       break;
     }
+  SPLAT_PVEC (vec);
 }
 
 static void
@@ -3228,6 +3234,7 @@ process_one_message (struct igc *gc)
     {
       mps_addr_t base_addr;
       mps_message_finalization_ref (&base_addr, gc->arena, msg);
+      /* FIXME/igc: other threads should be suspended while finalizing 
objects. */
       finalize (gc, base_addr);
     }
   else if (mps_message_get (&msg, gc->arena, mps_message_type_gc_start ()))
diff --git a/src/lisp.h b/src/lisp.h
index 0f5a5410081..933441d3a7e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2619,7 +2619,6 @@ union Lisp_Weak_Hash_Table_Entry
 struct Lisp_Weak_Hash_Table_Strong_Part
 {
   Lisp_Object index_bits;
-  Lisp_Object count;
   Lisp_Object next_free;
   Lisp_Object table_size;
   struct Lisp_Weak_Hash_Table_Weak_Part *weak;
@@ -2942,6 +2941,8 @@ weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, 
Lisp_Object key)
         ++dohash_##k##_##v##_k, ++dohash_##k##_##v##_v)                \
     if (hash_unused_entry_key_p (k))                                   \
       ;                                                                        
\
+    else if (PSEUDOVECTORP (k, PVEC_FREE) || PSEUDOVECTORP (v, PVEC_FREE)) \
+      ;                                                                        
\
     else
 
 /* Iterate I as index of valid entries in hash table H.
diff --git a/src/print.c b/src/print.c
index 392e865a601..770124c73e3 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2762,6 +2762,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, 
bool escapeflag)
            if (h->purecopy)
              print_c_string (" purecopy t", printcharfun);
 
+         hash_table_data:
            ptrdiff_t size = h->count;
            if (size > 0)
              {
@@ -2787,6 +2788,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, 
bool escapeflag)
                --print_depth;   /* Done with this.  */
              }
            goto next_obj;
+         strong_hash_table:
+           h = XHASH_TABLE (obj);
+           goto hash_table_data;
          }
 
 #ifdef HAVE_MPS
@@ -2810,32 +2814,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, 
bool escapeflag)
                              printcharfun, escapeflag);
              }
 
-           /* XXX: strengthen first, then count */
-           ptrdiff_t size = XFIXNUM (h->strong->count);
-           if (size > 0)
-             {
-               print_c_string (" data (", printcharfun);
-
-               /* Don't print more elements than the specified maximum.  */
-               if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
-                 size = XFIXNAT (Vprint_length);
-
-               print_stack_push ((struct print_stack_entry){
-                   .type = PE_hash,
-                   .u.hash.obj = strengthen_hash_table (obj),
-                   .u.hash.nobjs = size * 2,
-                   .u.hash.idx = 0,
-                   .u.hash.printed = 0,
-                   .u.hash.truncated = (size < XFIXNUM (h->strong->count)),
-                 });
-             }
-           else
-             {
-               /* Empty table: we can omit the data entirely.  */
-               printchar (')', printcharfun);
-               --print_depth;   /* Done with this.  */
-             }
-           goto next_obj;
+           obj = strengthen_hash_table (obj);
+           goto strong_hash_table;
          }
 #endif