Re: MPS: weak hash tables

[Pip Cet <pipcet@protonmail.com>]

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

On Wednesday, July 3rd, 2024 at 08:26, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
> The PVEC_FREE lead to an abort, which I think I fixed. Please pull.

Thanks, sorry for missing that!

So I've implemented Helmut's idea, but it's turned out uglier than I thought it would...

And of course the same needs to be done for the marker vector, right?

Just thinking about a different idea, but it's not quite there yet...

Pip

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Use-two-words-for-each-entry-in-a-weak-hash-table.patch --]
[-- Type: text/x-patch; name=0001-Use-two-words-for-each-entry-in-a-weak-hash-table.patch, Size: 15861 bytes --]

From 0e2b417953fc578c819f31ee9e5b911cf827ffbf Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@protonmail.com>
Date: Wed, 3 Jul 2024 09:22:03 +0000
Subject: [PATCH] Use two words for each entry in a weak hash table

---
 src/fns.c   |  36 ++++++++++--------
 src/igc.c   | 106 ++++++++++++++++++++++++++++++++++++++++++++++++----
 src/lisp.h  |  41 ++++++++++----------
 src/print.c |   2 +
 4 files changed, 142 insertions(+), 43 deletions(-)

diff --git a/src/fns.c b/src/fns.c
index 250cf6c3a7e..ad111dd6708 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5415,19 +5415,19 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
 set_weak_hash_next_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
 {
   eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
-  h->strong->next[idx].lisp_object = make_fixnum (val);
+  h->strong->next[idx] = make_weak_hash_table_entry (make_fixnum (val));
 }
 static void
 set_weak_hash_hash_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, hash_hash_t val)
 {
   eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
-  h->strong->hash[idx].lisp_object = make_fixnum (val);
+  h->strong->hash[idx] = make_weak_hash_table_entry (make_fixnum (val));
 }
 static void
 set_weak_hash_index_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
 {
   eassert (idx >= 0 && idx < weak_hash_table_index_size (h));
-  h->strong->index[idx].lisp_object = make_fixnum (val);
+  h->strong->index[idx] = make_weak_hash_table_entry (make_fixnum (val));
 }
 
 static struct Lisp_Weak_Hash_Table *
@@ -5442,14 +5442,14 @@ check_maybe_weak_hash_table (Lisp_Object obj)
 WEAK_HASH_NEXT (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
 {
   eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
-  return XFIXNUM (h->strong->next[idx].lisp_object);
+  return XFIXNUM (weak_hash_table_entry (h->strong->next[idx]));
 }
 
 static ptrdiff_t
 WEAK_HASH_INDEX (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
 {
   eassert (idx >= 0 && idx < weak_hash_table_index_size (h));
-  return XFIXNUM (h->strong->index[idx].lisp_object);
+  return XFIXNUM (weak_hash_table_entry (h->strong->index[idx]));
 }
 
 static struct Lisp_Weak_Hash_Table *
@@ -5547,19 +5547,22 @@ make_weak_hash_table (const struct hash_table_test *test, EMACS_INT size,
     {
       for (ptrdiff_t i = 0; i < size; i++)
 	{
-	  h->strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY;
-	  h->strong->value[i].ptr = 0;
+	  h->strong->key[i] =
+	    make_weak_hash_table_entry (HASH_UNUSED_ENTRY_KEY);
+	  h->strong->value[i] =
+	    make_weak_hash_table_entry (Qnil);
 	}
 
       for (ptrdiff_t i = 0; i < size - 1; i++)
-	h->strong->next[i].lisp_object = make_fixnum(i + 1);
-      h->strong->next[size - 1].lisp_object = make_fixnum(-1);
+	h->strong->next[i] = make_weak_hash_table_entry (make_fixnum(i + 1));
+      h->strong->next[size - 1] =
+	make_weak_hash_table_entry (make_fixnum(-1));
 
       int index_bits = compute_hash_index_bits (size);
       h->strong->index_bits = make_fixnum (index_bits);
       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->index[i] = make_weak_hash_table_entry (make_fixnum (-1));
 
       h->strong->next_free = make_fixnum (0);
     }
@@ -5626,18 +5629,19 @@ maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
 	}
 
       for (ptrdiff_t i = 0; i < new_size - 1; i++)
-	strong->next[i].lisp_object = make_fixnum (i + 1);
-      strong->next[new_size - 1].lisp_object = make_fixnum (-1);
+	strong->next[i] = make_weak_hash_table_entry (make_fixnum (i + 1));
+      strong->next[new_size - 1] =
+	make_weak_hash_table_entry (make_fixnum (-1));
 
       for (ptrdiff_t i = 0; i < new_size; i++)
 	{
-	  strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY;
-	  strong->value[i].lisp_object = Qnil;
+	  strong->key[i] = make_weak_hash_table_entry (HASH_UNUSED_ENTRY_KEY);
+	  strong->value[i] = make_weak_hash_table_entry (Qnil);
 	}
 
       ptrdiff_t index_size = (ptrdiff_t)1 << index_bits;
       for (ptrdiff_t i = 0; i < index_size; i++)
-	strong->index[i].lisp_object = make_fixnum (-1);
+	strong->index[i] = make_weak_hash_table_entry (make_fixnum (-1));
 
       strong->index_bits = make_fixnum (index_bits);
       strong->table_size = make_fixnum (new_size);
@@ -5801,7 +5805,7 @@ weak_hash_clear (struct Lisp_Weak_Hash_Table *h)
 
   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->index[i] = make_weak_hash_table_entry (make_fixnum (-1));
 
   h->strong->next_free = make_fixnum (0);
 }
diff --git a/src/igc.c b/src/igc.c
index 1b1e69ede5d..efb8106d139 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -281,6 +281,8 @@ is_builtin_subr (enum igc_obj_type type, void *client)
 static bool
 has_header (void *client, bool is_vector)
 {
+  if (client == NULL)
+    return false;
   if (is_vector && is_builtin_subr (IGC_OBJ_VECTOR, client))
     return false;
   if (c_symbol_p (client))
@@ -912,6 +914,28 @@ fix_raw (mps_ss_t ss, mps_addr_t *p)
   return MPS_RES_OK;
 }
 
+static mps_res_t
+fix_base (mps_ss_t ss, mps_addr_t *p)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    mps_addr_t base = *p;
+    if (base == NULL)
+      return MPS_RES_OK;
+    if (is_aligned (base))
+      {
+	if (MPS_FIX1 (ss, base))
+	  {
+	    mps_res_t res = MPS_FIX2 (ss, p);
+	    if (res != MPS_RES_OK)
+	      return res;
+	  }
+      }
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
 #define IGC_FIX12_OBJ(ss, p)                           \
   do                                                   \
     {                                                  \
@@ -932,6 +956,16 @@ #define IGC_FIX12_RAW(ss, p)                                     \
     }                                                            \
   while (0)
 
+#define IGC_FIX12_BASE(ss, p)						\
+  do									\
+    {									\
+      mps_res_t res;							\
+      MPS_FIX_CALL (ss, res = fix_base (ss, (mps_addr_t *) (p)));	\
+      if (res != MPS_RES_OK)						\
+	return res;							\
+    }									\
+  while (0)
+
 #define IGC_FIX12_NOBJS(ss, a, n)                            \
   do                                                         \
     {                                                        \
@@ -1917,7 +1951,7 @@ fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong
 	  }
 	for (ssize_t i = 2 * XFIXNUM (t->table_size); i < limit; i++)
 	  {
-	    IGC_FIX12_OBJ (ss, &t->entries[i].lisp_object);
+	    IGC_FIX12_BASE (ss, &t->entries[i].intptr);
 	  }
       }
   }
@@ -1953,9 +1987,9 @@ fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Par
 
 	for (ssize_t i = 0; i < limit; i++)
 	  {
-	    bool was_nil = NILP (w->entries[i].lisp_object);
-	    IGC_FIX12_OBJ (ss, &w->entries[i].lisp_object);
-	    bool is_now_nil = NILP (w->entries[i].lisp_object);
+	    bool was_nil = w->entries[i].intptr == 0;
+	    IGC_FIX12_BASE (ss, &w->entries[i].intptr);
+	    bool is_now_nil = w->entries[i].intptr == 0;
 
 	    if (is_now_nil && !was_nil)
 	      {
@@ -3813,8 +3847,63 @@ igc_make_hash_table_vec (size_t n)
   return alloc (n * sizeof (Lisp_Object), IGC_OBJ_HASH_VEC);
 }
 
+Lisp_Object
+weak_hash_table_entry (struct Lisp_Weak_Hash_Table_Entry entry)
+{
+  intptr_t alignment = entry.intptr & 1;
+  mps_addr_t client;
+
+  if (alignment == 0)
+    {
+      client = base_to_client ((mps_addr_t)entry.intptr);
+    }
+  else
+    {
+      intptr_t real_ptr = entry.intptr ^ alignment;
+      client = (mps_addr_t)real_ptr;
+    }
+
+  switch (XFIXNUM (entry.fixnum))
+    {
+    case Lisp_Symbol:
+      return make_lisp_symbol (client);
+    case_Lisp_Int:
+      return make_fixnum (entry.intptr >> 1);
+    default:
+      return make_lisp_ptr (client, XFIXNUM (entry.fixnum));
+    }
+}
+
+struct Lisp_Weak_Hash_Table_Entry
+make_weak_hash_table_entry (Lisp_Object obj)
+{
+  struct Lisp_Weak_Hash_Table_Entry entry = { 0, };
+  mps_addr_t client;
+  entry.fixnum = make_fixnum (XTYPE (obj));
+
+  if (FIXNUMP (obj))
+    {
+      entry.intptr = (XFIXNUM (obj) << 1) + 1;
+      return entry;
+    }
+  else if (BARE_SYMBOL_P (obj))
+    client = XBARE_SYMBOL (obj);
+  else
+    client = XUNTAG (obj, XTYPE (obj), void);
+
+  if (has_header (client, VECTORLIKEP (obj)))
+    entry.intptr = (intptr_t)client_to_base (client);
+  else
+    {
+      entry.intptr = (intptr_t)client + 1;
+      eassert (entry.intptr & 1);
+    }
+  return entry;
+}
+
 struct Lisp_Weak_Hash_Table_Strong_Part *
-igc_alloc_weak_hash_table_strong_part (hash_table_weakness_t weak, size_t size, size_t index_bits)
+igc_alloc_weak_hash_table_strong_part (hash_table_weakness_t weak,
+				       size_t size, size_t index_bits)
 {
   size_t total_size;
   switch (weak)
@@ -3832,12 +3921,13 @@ igc_alloc_weak_hash_table_strong_part (hash_table_weakness_t weak, size_t size,
       emacs_abort ();
     }
   return alloc (sizeof (struct Lisp_Weak_Hash_Table_Strong_Part) +
-		total_size * sizeof (union Lisp_Weak_Hash_Table_Entry),
+		total_size * sizeof (struct Lisp_Weak_Hash_Table_Entry),
 		IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART);
 }
 
 struct Lisp_Weak_Hash_Table_Weak_Part *
-igc_alloc_weak_hash_table_weak_part (hash_table_weakness_t weak, size_t size, size_t index_bits)
+igc_alloc_weak_hash_table_weak_part (hash_table_weakness_t weak,
+				     size_t size, size_t index_bits)
 {
   size_t total_size;
   switch (weak)
@@ -3855,7 +3945,7 @@ igc_alloc_weak_hash_table_weak_part (hash_table_weakness_t weak, size_t size, si
       emacs_abort ();
     }
   return alloc (sizeof (struct Lisp_Weak_Hash_Table_Weak_Part) +
-		total_size * sizeof (union Lisp_Weak_Hash_Table_Entry),
+		total_size * sizeof (struct Lisp_Weak_Hash_Table_Entry),
 		IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART);
 }
 
diff --git a/src/lisp.h b/src/lisp.h
index 933441d3a7e..3fc55982d24 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2609,13 +2609,16 @@ #define DOOBARRAY(oa, it)					\
    (hash) indices.  It's signed and a subtype of ptrdiff_t.  */
 typedef int32_t hash_idx_t;
 
-/* The reason for this unusual union is an MPS peculiarity on 32-bit x86 systems. */
-union Lisp_Weak_Hash_Table_Entry
+/* The reason for this unusual structure is an MPS peculiarity on 32-bit x86 systems. */
+struct Lisp_Weak_Hash_Table_Entry
 {
-  void *ptr;
-  Lisp_Object lisp_object; /* must be a fixnum or HASH_UNUSED_ENTRY_KEY! */
+  intptr_t intptr; /* must be an MPS base pointer */
+  Lisp_Object fixnum; /* a fixnum indicating the tag, or just a fixnum */
 };
 
+extern Lisp_Object weak_hash_table_entry (struct Lisp_Weak_Hash_Table_Entry entry);
+extern struct Lisp_Weak_Hash_Table_Entry make_weak_hash_table_entry (Lisp_Object);
+
 struct Lisp_Weak_Hash_Table_Strong_Part
 {
   Lisp_Object index_bits;
@@ -2623,11 +2626,11 @@ #define DOOBARRAY(oa, it)					\
   Lisp_Object table_size;
   struct Lisp_Weak_Hash_Table_Weak_Part *weak;
   const struct hash_table_test *test;
-  union Lisp_Weak_Hash_Table_Entry *index; /* internal pointer */
-  union Lisp_Weak_Hash_Table_Entry *hash; /* either internal pointer or pointer to dependent object */
-  union Lisp_Weak_Hash_Table_Entry *key; /* either internal pointer or pointer to dependent object */
-  union Lisp_Weak_Hash_Table_Entry *value; /* either internal pointer or pointer to dependent object */
-  union Lisp_Weak_Hash_Table_Entry *next; /* internal pointer */
+  struct Lisp_Weak_Hash_Table_Entry *index; /* internal pointer to an all-fixnum array */
+  struct Lisp_Weak_Hash_Table_Entry *hash; /* internal pointer to an all-fixnum array */
+  struct Lisp_Weak_Hash_Table_Entry *next; /* internal pointer to an all-fixnum array */
+  struct Lisp_Weak_Hash_Table_Entry *key; /* either internal pointer or pointer to dependent object */
+  struct Lisp_Weak_Hash_Table_Entry *value; /* either internal pointer or pointer to dependent object */
   hash_table_weakness_t weakness : 3;
   hash_table_std_test_t frozen_test : 2;
 
@@ -2639,13 +2642,13 @@ #define DOOBARRAY(oa, it)					\
      pure tables are not, and while a table is being mutated it is
      immutable for recursive attempts to mutate it.  */
   bool_bf mutable : 1;
-  union Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER];
+  struct Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER];
 };
 
 struct Lisp_Weak_Hash_Table_Weak_Part
 {
   struct Lisp_Weak_Hash_Table_Strong_Part *strong;
-  union Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER];
+  struct Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER];
 };
 
 struct Lisp_Weak_Hash_Table
@@ -2860,13 +2863,13 @@ make_lisp_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
 WEAK_HASH_KEY (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
 {
   eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
-  return h->strong->key[idx].lisp_object;
+  return weak_hash_table_entry (h->strong->key[idx]);
 }
 
 INLINE Lisp_Object
 WEAK_HASH_VALUE (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
 {
-  return h->strong->value[idx].lisp_object;
+  return weak_hash_table_entry (h->strong->value[idx]);
 }
 
 /* Value is the hash code computed for entry IDX in hash table H.  */
@@ -2874,7 +2877,7 @@ WEAK_HASH_VALUE (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
 WEAK_HASH_HASH (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
 {
   eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
-  return XFIXNUM (h->strong->hash[idx].lisp_object);
+  return XFIXNUM (weak_hash_table_entry (h->strong->hash[idx]));
 }
 
 /* Value is the size of hash table H.  */
@@ -2925,14 +2928,14 @@ weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
    The body may remove the current entry or alter its value slot, but not
    mutate TABLE in any other way.  */
 # define DOHASH_WEAK(h, k, v)						\
-  for (union Lisp_Weak_Hash_Table_Entry *dohash_##k##_##v##_k = (h)->strong->key, \
+  for (struct Lisp_Weak_Hash_Table_Entry *dohash_##k##_##v##_k = (h)->strong->key, \
 	 *dohash_##k##_##v##_v = (h)->strong->value,			\
 	 *dohash_##k##_##v##_end = dohash_##k##_##v##_k			\
 	 + WEAK_HASH_TABLE_SIZE (h),					\
 	 *dohash_##k##_##v##_base = dohash_##k##_##v##_k;		\
        dohash_##k##_##v##_k < dohash_##k##_##v##_end			\
-	 && (k = dohash_##k##_##v##_k[0].lisp_object,			\
-	     v = dohash_##k##_##v##_v[0].lisp_object, /*maybe unused*/ (void)v,	\
+	 && (k = weak_hash_table_entry (dohash_##k##_##v##_k[0]),	\
+	     v = weak_hash_table_entry (dohash_##k##_##v##_v[0]),	\
            true);			                                \
        eassert (dohash_##k##_##v##_base == (h)->strong->key		\
 		&& dohash_##k##_##v##_end				\
@@ -4255,14 +4258,14 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
 set_weak_hash_key_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
 {
   eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
-  h->strong->key[idx].lisp_object = val;
+  h->strong->key[idx] = make_weak_hash_table_entry (val);
 }
 
 INLINE void
 set_weak_hash_value_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
 {
   eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size) );
-  h->strong->value[idx].lisp_object = val;
+  h->strong->value[idx] = make_weak_hash_table_entry (val);
 }
 #endif
 
diff --git a/src/print.c b/src/print.c
index fa71de8f2dd..8fd3473e5c2 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2788,9 +2788,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 		--print_depth;   /* Done with this.  */
 	      }
 	    goto next_obj;
+#ifdef HAVE_MPS
 	  strong_hash_table:
 	    h = XHASH_TABLE (obj);
 	    goto hash_table_data;
+#endif
 	  }
 
 #ifdef HAVE_MPS
-- 
2.45.2