Re: MPS: dangling markers

[Pip Cet <pipcet@protonmail.com>]

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

On Sunday, June 30th, 2024 at 19:22, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
> Thanks! What do youo think about making a patch containing only your
> weak hash tables, and leaving the BUF_MARKERS alone for now?

I think that's the best way forward. Patch attached.

> That way
> igc could support the existing uses of weak hash tables (I remember one
> in the CLOS department somehwere), and they would be somewhat tested.
> Don't remember if we have unit tests for them.

It seems MPS isn't very eager about splatting weak references during ordinary automatic GC, FWIW. What I'm observing with

(while t
  (dotimes (i 10000)
    (puthash (cons 1 2) (cons 3 4) table))
  (message "%S" (hash-table-count table))
  (sit-for 0.1))

is that the hash table starts out at 0, grows quickly, resets to count=0 once, then keeps growing and never splats any references after that. It's quite possible this is a bug in my code, of course.

Pip

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0003-mps-weak-hash-tables.patch --]
[-- Type: text/x-patch; name=0003-mps-weak-hash-tables.patch, Size: 47583 bytes --]

diff --git a/src/alloc.c b/src/alloc.c
index 09b51ba2a08..5d47d3f7851 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6230,6 +6230,16 @@ purecopy (Lisp_Object obj)
 
       obj = make_lisp_hash_table (purecopy_hash_table (table));
     }
+  else if (WEAK_HASH_TABLE_P (obj))
+    {
+      /* Instead, add the hash table to the list of pinned objects,
+	 so that it will be marked during GC.  */
+      struct pinned_object *o = xmalloc (sizeof *o);
+      o->object = obj;
+      o->next = pinned_objects;
+      pinned_objects = o;
+      return obj; /* Don't hash cons it.  */
+    }
   else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj))
     {
       struct Lisp_Vector *objp = XVECTOR (obj);
diff --git a/src/data.c b/src/data.c
index dcf869c1a0e..996f57e2123 100644
--- a/src/data.c
+++ b/src/data.c
@@ -251,6 +251,7 @@ DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0,
         case PVEC_BOOL_VECTOR: return Qbool_vector;
         case PVEC_FRAME: return Qframe;
         case PVEC_HASH_TABLE: return Qhash_table;
+        case PVEC_WEAK_HASH_TABLE: return Qhash_table;
         case PVEC_OBARRAY: return Qobarray;
         case PVEC_FONT:
           if (FONT_SPEC_P (object))
diff --git a/src/fns.c b/src/fns.c
index f7603626454..3049ae37d65 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4583,12 +4583,28 @@ set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
   eassert (idx >= 0 && idx < h->table_size);
   h->next[idx] = val;
 }
+
+static void
+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);
+}
+
 static void
 set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, hash_hash_t val)
 {
   eassert (idx >= 0 && idx < h->table_size);
   h->hash[idx] = 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);
+}
+
 static void
 set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
 {
@@ -4596,6 +4612,13 @@ set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
   h->index[idx] = 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);
+}
+
 /* If OBJ is a Lisp hash table, return a pointer to its struct
    Lisp_Hash_Table.  Otherwise, signal an error.  */
 
@@ -4606,6 +4629,14 @@ check_hash_table (Lisp_Object obj)
   return XHASH_TABLE (obj);
 }
 
+static struct Lisp_Weak_Hash_Table *
+check_maybe_weak_hash_table (Lisp_Object obj)
+{
+  if (WEAK_HASH_TABLE_P (obj))
+    return XWEAK_HASH_TABLE (obj);
+  return NULL;
+}
+
 
 /* Value is the next integer I >= N, N >= 0 which is "almost" a prime
    number.  A number is "almost" a prime number if it is not divisible
@@ -4687,6 +4718,13 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->next[idx];
 }
 
+static ptrdiff_t
+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 the index of the element in hash table H that is the start
    of the collision list at index IDX, or -1 if the list is empty.  */
 
@@ -4697,6 +4735,13 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->index[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);
+}
+
 /* Restore a hash table's mutability after the critical section exits.  */
 
 static void
@@ -4821,6 +4866,48 @@ allocate_hash_table (void)
   return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE);
 }
 
+static struct Lisp_Weak_Hash_Table *
+allocate_weak_hash_table (hash_table_weakness_t weak, ssize_t size, ssize_t index_bits)
+{
+  struct Lisp_Weak_Hash_Table *ret =
+    ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Weak_Hash_Table, PVEC_WEAK_HASH_TABLE);
+  ret->strong = igc_alloc_weak_hash_table_strong_part (weak, size, index_bits);
+  ret->strong->hash = ret->strong->entries + 0;
+  ret->strong->value = ret->strong->entries + 1 * size;
+  ret->strong->next = ret->strong->entries + 2 * size;
+  ret->strong->index = ret->strong->entries + 3 * size;
+  ret->weak = igc_alloc_weak_hash_table_weak_part (weak, size, index_bits);
+  ret->strong->weak = ret->weak;
+  ret->weak->strong = ret->strong;
+  ret->strong->key = ret->weak->entries;
+  return ret;
+}
+
+Lisp_Object
+strengthen_hash_table (Lisp_Object weak)
+{
+  Lisp_Object ret = make_hash_table (XWEAK_HASH_TABLE (weak)->strong->test, 0, Weak_None, 0);
+
+  Lisp_Object k, v;
+  DOHASH_WEAK (XWEAK_HASH_TABLE (weak), k, v)
+    {
+      Fputhash (k, v, ret);
+    }
+
+  return ret;
+}
+
+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));
+  weak->dump_replacement = ret;
+
+  return ret;
+}
+
 /* Compute the size of the index (as log2) from the table capacity.  */
 static int
 compute_hash_index_bits (hash_idx_t size)
@@ -4855,6 +4942,54 @@ compute_hash_index_bits (hash_idx_t size)
    `purecopy' when Emacs is being dumped. Such tables can no longer be
    changed after purecopy.  */
 
+Lisp_Object
+make_weak_hash_table (const struct hash_table_test *test, EMACS_INT size,
+		      hash_table_weakness_t weak, bool purecopy)
+{
+  eassert (!purecopy);
+  eassert (SYMBOLP (test->name));
+  eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
+
+  if (size < 65)
+    size = 65;
+
+  struct Lisp_Weak_Hash_Table *h = allocate_weak_hash_table (weak, size, compute_hash_index_bits (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)
+    {
+      emacs_abort ();
+    }
+  else
+    {
+      for (ptrdiff_t i = 0; i < size; i++)
+	{
+	  h->strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY;
+	  h->strong->value[i].ptr = 0;
+	}
+
+      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);
+
+      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->next_free = make_fixnum (0);
+    }
+
+  h->strong->purecopy = purecopy;
+  h->strong->mutable = true;
+  return make_lisp_weak_hash_table (h);
+}
+
 Lisp_Object
 make_hash_table (const struct hash_table_test *test, EMACS_INT size,
 		 hash_table_weakness_t weak, bool purecopy)
@@ -4862,6 +4997,10 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size,
   eassert (SYMBOLP (test->name));
   eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
 
+  if (weak != Weak_None)
+    {
+      return make_weak_hash_table (test, size, weak, purecopy);
+    }
   struct Lisp_Hash_Table *h = allocate_hash_table ();
 
   h->test = test;
@@ -4961,6 +5100,13 @@ hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash)
   return knuth_hash (hash, h->index_bits);
 }
 
+/* Compute index into the index vector from a hash value.  */
+static inline ptrdiff_t
+weak_hash_index_index (struct Lisp_Weak_Hash_Table *h, hash_hash_t hash)
+{
+  return knuth_hash (hash, XFIXNUM (h->strong->index_bits));
+}
+
 /* Resize hash table H if it's too full.  If H cannot be resized
    because it's already too large, throw an error.  */
 
@@ -5042,6 +5188,71 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
     }
 }
 
+static void
+maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
+{
+  if (XFIXNUM (h->strong->next_free) < 0)
+    {
+      ptrdiff_t old_size = WEAK_HASH_TABLE_SIZE (h);
+      ptrdiff_t min_size = 6;
+      ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2);
+      /* Grow aggressively at small sizes, then just double.  */
+      ptrdiff_t new_size =
+	old_size == 0
+	? min_size
+	: (base_size <= 64 ? base_size * 4 : base_size * 2);
+
+      ptrdiff_t index_bits = compute_hash_index_bits (new_size);
+
+      struct Lisp_Weak_Hash_Table_Strong_Part *strong =
+	igc_alloc_weak_hash_table_strong_part (h->strong->weakness, new_size, index_bits);
+      struct Lisp_Weak_Hash_Table_Weak_Part *weak =
+	igc_alloc_weak_hash_table_weak_part (h->strong->weakness, new_size, index_bits);
+
+      memcpy (strong, h->strong, sizeof *strong);
+
+      strong->hash = strong->entries + 0;
+      strong->value = strong->entries + 1 * new_size;
+      strong->next = strong->entries + 2 * new_size;
+      strong->index = strong->entries + 3 * new_size;
+      strong->key = weak->entries;
+      strong->count = make_fixnum (0);
+      weak->strong = strong;
+      strong->weak = weak;
+
+      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);
+
+      for (ptrdiff_t i = 0; i < new_size; i++)
+	{
+	  strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY;
+	  strong->value[i].lisp_object = 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_bits = make_fixnum (index_bits);
+      strong->table_size = make_fixnum (new_size);
+      strong->next_free = make_fixnum (0);
+
+      struct Lisp_Weak_Hash_Table *pseudo =
+	ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Weak_Hash_Table, PVEC_WEAK_HASH_TABLE);
+      pseudo->strong = strong;
+      pseudo->weak = weak;
+      Lisp_Object k, v;
+      DOHASH_WEAK (h, k, v)
+	{
+	  Fputhash (k, v, make_lisp_weak_hash_table (pseudo));
+	}
+
+      h->strong = strong;
+      h->weak = weak;
+    }
+}
+
 static const struct hash_table_test *
 hash_table_test_from_std (hash_table_std_test_t test)
 {
@@ -5058,6 +5269,7 @@ hash_table_test_from_std (hash_table_std_test_t test)
 void
 hash_table_thaw (Lisp_Object hash_table)
 {
+  eassert (HASH_TABLE_P (hash_table));
   struct Lisp_Hash_Table *h = XHASH_TABLE (hash_table);
 
   /* Freezing discarded most non-essential information; recompute it.
@@ -5173,6 +5385,24 @@ hash_lookup_with_hash (struct Lisp_Hash_Table *h,
   return -1;
 }
 
+/* Look up KEY with hash HASH in weak hash table H.
+   Return entry index or -1 if none.  */
+static ptrdiff_t
+weak_hash_lookup_with_hash (struct Lisp_Weak_Hash_Table *h,
+			    Lisp_Object key, hash_hash_t hash)
+{
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hash);
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i; i = WEAK_HASH_NEXT (h, i))
+    if (EQ (key, WEAK_HASH_KEY (h, i))
+	|| (h->strong->test->cmpfn
+	    && hash == WEAK_HASH_HASH (h, i)
+	    && !NILP (h->strong->test->cmpfn (key, WEAK_HASH_KEY (h, i), NULL))))
+      return i;
+
+  return -1;
+}
+
 /* Look up KEY in table H.  Return entry index or -1 if none.  */
 ptrdiff_t
 hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key)
@@ -5180,6 +5410,12 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key)
   return hash_lookup_with_hash (h, key, hash_from_key (h, key));
 }
 
+ptrdiff_t
+weak_hash_lookup (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  return weak_hash_lookup_with_hash (h, key, weak_hash_from_key (h, key));
+}
+
 /* Look up KEY in hash table H.  Return its hash value in *PHASH.
    Value is the index of the entry in H matching KEY, or -1 if not found.  */
 ptrdiff_t
@@ -5229,6 +5465,36 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
   return i;
 }
 
+/* Put an entry into weak hash table H that associates KEY with VALUE.
+   HASH is a previously computed hash code of KEY.
+   Value is the index of the entry in H matching KEY.  */
+
+ptrdiff_t
+weak_hash_put (struct Lisp_Weak_Hash_Table *h, Lisp_Object key, Lisp_Object value,
+	       hash_hash_t hash)
+{
+  //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);
+  //eassert (hash_unused_entry_key_p (HASH_KEY (h, i)));
+  h->strong->next_free = make_fixnum (WEAK_HASH_NEXT (h, i));
+  set_weak_hash_key_slot (h, i, key);
+  set_weak_hash_value_slot (h, i, value);
+
+  /* Remember its hash code.  */
+  set_weak_hash_hash_slot (h, i, hash);
+
+  /* Add new entry to its collision chain.  */
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hash);
+  set_weak_hash_next_slot (h, i, WEAK_HASH_INDEX (h, start_of_bucket));
+  set_weak_hash_index_slot (h, start_of_bucket, i);
+  return i;
+}
+
 
 /* Remove the entry matching KEY from hash table H, if there is one.  */
 
@@ -5270,6 +5536,82 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
 }
 
 
+/* Remove the entry matching KEY from weak hash table H, if there is one.  */
+
+void
+weak_hash_remove_from_table (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  hash_hash_t hashval = weak_hash_from_key (h, key);
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hashval);
+  ptrdiff_t prev = -1;
+
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i;
+       i = WEAK_HASH_NEXT (h, i))
+    {
+      if (EQ (key, WEAK_HASH_KEY (h, i))
+	  || (h->strong->test->cmpfn
+	      && hashval == WEAK_HASH_HASH (h, i)
+	      && !NILP (h->strong->test->cmpfn (key, WEAK_HASH_KEY (h, i), NULL))))
+	{
+	  /* Take entry out of collision chain.  */
+	  if (prev < 0)
+	    set_weak_hash_index_slot (h, start_of_bucket, WEAK_HASH_NEXT (h, i));
+	  else
+	    set_weak_hash_next_slot (h, prev, WEAK_HASH_NEXT (h, i));
+
+	  /* Clear slots in key_and_value and add the slots to
+	     the free list.  */
+	  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, XFIXNUM (h->strong->next_free));
+	  h->strong->next_free = make_fixnum (i);
+	  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1);
+	  break;
+	}
+
+      prev = i;
+    }
+}
+
+
+/* Remove the entry at ID0 from weak hash table H.  Called from GC with H
+   being a pointer to a structure on the stack. */
+
+void
+weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table *h, ptrdiff_t i0)
+{
+  hash_hash_t hashval = WEAK_HASH_HASH (h, i0);
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hashval);
+  ptrdiff_t prev = -1;
+
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i;
+       i = WEAK_HASH_NEXT (h, i))
+    {
+      if (i == i0)
+	{
+	  /* Take entry out of collision chain.  */
+	  if (prev < 0)
+	    set_weak_hash_index_slot (h, start_of_bucket, WEAK_HASH_NEXT (h, i));
+	  else
+	    set_weak_hash_next_slot (h, prev, WEAK_HASH_NEXT (h, i));
+
+	  /* Clear slots in key_and_value and add the slots to
+	     the free list.  */
+	  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, XFIXNUM (h->strong->next_free));
+	  h->strong->next_free = make_fixnum (i);
+	  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1);
+	  break;
+	}
+
+      prev = i;
+    }
+}
+
+
 /* Clear hash table H.  */
 
 static void
@@ -5294,6 +5636,30 @@ hash_clear (struct Lisp_Hash_Table *h)
     }
 }
 
+/* Clear weak hash table H.  */
+
+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++)
+	{
+	  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);
+
+      h->strong->next_free = make_fixnum (0);
+      h->strong->count = make_fixnum (0);
+    }
+}
+
 \f
 /************************************************************************
 			   Weak Hash Tables
@@ -5920,6 +6286,11 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
        doc: /* Return the number of elements in TABLE.  */)
   (Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      return wh->strong->count;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   return make_fixnum (h->count);
 }
@@ -5999,7 +6370,7 @@ DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0,
        doc: /* Return t if OBJ is a Lisp hash table object.  */)
   (Lisp_Object obj)
 {
-  return HASH_TABLE_P (obj) ? Qt : Qnil;
+  return (HASH_TABLE_P (obj) || WEAK_HASH_TABLE_P (obj)) ? Qt : Qnil;
 }
 
 
@@ -6007,6 +6378,12 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
        doc: /* Clear hash table TABLE and return it.  */)
   (Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      weak_hash_clear (wh);
+      return table;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   check_mutable_hash_table (table, h);
   hash_clear (h);
@@ -6020,6 +6397,12 @@ DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0,
 If KEY is not found, return DFLT which defaults to nil.  */)
   (Lisp_Object key, Lisp_Object table, Lisp_Object dflt)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      ptrdiff_t i = weak_hash_lookup (wh, key);
+      return i >= 0 ? WEAK_HASH_VALUE (wh, i) : dflt;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   ptrdiff_t i = hash_lookup (h, key);
   return i >= 0 ? HASH_VALUE (h, i) : dflt;
@@ -6032,6 +6415,17 @@ DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
 VALUE.  In any case, return VALUE.  */)
   (Lisp_Object key, Lisp_Object value, Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      EMACS_UINT hash = weak_hash_from_key (wh, key);
+      ptrdiff_t i = weak_hash_lookup_with_hash (wh, key, hash);
+      if (i >= 0)
+	set_weak_hash_value_slot (wh, i, value);
+      else
+	weak_hash_put (wh, key, value, hash);
+      return value;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   check_mutable_hash_table (table, h);
 
@@ -6050,6 +6444,12 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
        doc: /* Remove KEY from TABLE.  */)
   (Lisp_Object key, Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      weak_hash_remove_from_table (wh, key);
+      return Qnil;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   check_mutable_hash_table (table, h);
   hash_remove_from_table (h, key);
@@ -6065,6 +6465,13 @@ DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
 `maphash' always returns nil.  */)
   (Lisp_Object function, Lisp_Object table)
 {
+  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;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   /* We can't use DOHASH here since FUNCTION may violate the rules and
      we shouldn't crash as a result (although the effects are
diff --git a/src/igc.c b/src/igc.c
index 2165a69cacf..482272e9a89 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -372,6 +372,8 @@ #define IGC_DEFINE_LIST(data)                                                  \
   "IGC_OBJ_DUMPED_BUFFER_TEXT",
   "IGC_OBJ_DUMPED_BIGNUM_DATA",
   "IGC_OBJ_DUMPED_BYTES",
+  "IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART",
+  "IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART",
 };
 
 static_assert (ARRAYELTS (obj_type_names) == IGC_OBJ_NUM_TYPES);
@@ -399,6 +401,7 @@ obj_type_name (enum igc_obj_type type)
   "PVEC_BOOL_VECTOR",
   "PVEC_BUFFER",
   "PVEC_HASH_TABLE",
+  "PVEC_WEAK_HASH_TABLE",
 #ifndef IN_MY_FORK
   "PVEC_OBARRAY",
 #endif
@@ -460,8 +463,8 @@ pvec_type_name (enum pvec_type type)
 
 enum
 {
-  IGC_TYPE_BITS = 5,
-  IGC_HASH_BITS = 27,
+  IGC_TYPE_BITS = 6,
+  IGC_HASH_BITS = 26,
   IGC_SIZE_BITS = 32,
   IGC_HASH_MASK = (1 << IGC_HASH_BITS) - 1,
 };
@@ -562,6 +565,32 @@ object_nelems (void *client, size_t elem_size)
   return obj_client_size (h) / elem_size;
 }
 
+Lisp_Object
+igc_ptr_to_lisp (void *client)
+{
+  if (client == 0)
+    return Qnil;
+  mps_addr_t base = client_to_base (client);
+  struct igc_header *h = base;
+  switch (h->obj_type)
+    {
+    case IGC_OBJ_STRING:
+      return make_lisp_ptr (client, Lisp_String);
+
+    case IGC_OBJ_VECTOR:
+      return make_lisp_ptr (client, Lisp_Vectorlike);
+
+    case IGC_OBJ_CONS:
+      return make_lisp_ptr (client, Lisp_Cons);
+
+      return make_lisp_ptr (client, Lisp_Float);
+
+    default:
+      IGC_NOT_IMPLEMENTED ();
+      emacs_abort ();
+    }
+}
+
 /* Round NBYTES to the next multiple of ALIGN. */
 
 static size_t
@@ -638,6 +667,8 @@ IGC_DEFINE_LIST (igc_root);
   mps_ap_t leaf_ap;
   mps_ap_t weak_strong_ap;
   mps_ap_t weak_weak_ap;
+  mps_ap_t weak_hash_strong_ap;
+  mps_ap_t weak_hash_weak_ap;
   mps_ap_t immovable_ap;
 
   /* Quick access to the roots used for specpdl, bytecode stack and
@@ -674,6 +705,8 @@ IGC_DEFINE_LIST (igc_thread);
   mps_pool_t leaf_pool;
   mps_fmt_t weak_fmt;
   mps_pool_t weak_pool;
+  mps_fmt_t weak_hash_fmt;
+  mps_pool_t weak_hash_pool;
   mps_fmt_t immovable_fmt;
   mps_pool_t immovable_pool;
 
@@ -1522,6 +1555,8 @@ fix_charset_table (mps_ss_t ss, struct charset *table, size_t nbytes)
 
 static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v);
 static mps_res_t fix_vector_weak (mps_ss_t ss, struct Lisp_Vector *v);
+static mps_res_t fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong_Part *t);
+static mps_res_t fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Part *w);
 
 static mps_res_t
 dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
@@ -1645,6 +1680,15 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
 	IGC_FIX_CALL (ss, fix_charset_table (ss, (struct charset *)client,
 					     obj_size (header)));
 	break;
+
+      case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Strong_Part, client,
+			 fix_weak_hash_table_strong_part);
+	break;
+      case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Weak_Part, client,
+			 fix_weak_hash_table_weak_part);
+	break;
       }
   }
   MPS_SCAN_END (ss);
@@ -1841,6 +1885,60 @@ fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h)
   return MPS_RES_OK;
 }
 
+static mps_res_t
+fix_weak_hash_table (mps_ss_t ss, struct Lisp_Weak_Hash_Table *h)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    IGC_FIX12_RAW (ss, &h->strong);
+    IGC_FIX12_RAW (ss, &h->weak);
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong_Part *t)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    for (ssize_t i = 0; i < 4 * XFIXNUM (t->table_size); i++)
+      {
+	IGC_FIX12_OBJ (ss, &t->entries[i].lisp_object);
+      }
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Part *w)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    IGC_FIX12_RAW (ss, &w->strong);
+    struct Lisp_Weak_Hash_Table_Strong_Part *t = w->strong;
+    for (ssize_t i = 0; i < 4 * XFIXNUM (t->table_size); 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);
+
+	if (is_now_nil && !was_nil)
+	  {
+	    struct Lisp_Weak_Hash_Table pseudo_h =
+	      {
+		.strong = t,
+		.weak = w,
+	      };
+	    weak_hash_splat_from_table (&pseudo_h, i);
+	  }
+      }
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
 static mps_res_t
 fix_char_table (mps_ss_t ss, struct Lisp_Vector *v)
 {
@@ -2133,6 +2231,10 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
 	IGC_FIX_CALL_FN (ss, struct Lisp_Hash_Table, v, fix_hash_table);
 	break;
 
+      case PVEC_WEAK_HASH_TABLE:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table, v, fix_weak_hash_table);
+	break;
+
       case PVEC_CHAR_TABLE:
       case PVEC_SUB_CHAR_TABLE:
 	IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_char_table);
@@ -2261,6 +2363,7 @@ fix_vector_weak (mps_ss_t ss, struct Lisp_Vector *v)
       case PVEC_FRAME:
       case PVEC_WINDOW:
       case PVEC_HASH_TABLE:
+      case PVEC_WEAK_HASH_TABLE:
       case PVEC_CHAR_TABLE:
       case PVEC_SUB_CHAR_TABLE:
       case PVEC_BOOL_VECTOR:
@@ -2564,6 +2667,22 @@ create_weak_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
   return res;
 }
 
+static mps_res_t
+create_weak_hash_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
+{
+  struct igc *gc = t->gc;
+  mps_res_t res;
+  mps_pool_t pool = gc->weak_hash_pool;
+  MPS_ARGS_BEGIN (args)
+  {
+    MPS_ARGS_ADD (args, MPS_KEY_RANK,
+		  weak ? mps_rank_weak () : mps_rank_exact ());
+    res = mps_ap_create_k (ap, pool, args);
+  }
+  MPS_ARGS_END (args);
+  return res;
+}
+
 static void
 create_thread_aps (struct igc_thread *t)
 {
@@ -2576,8 +2695,10 @@ create_thread_aps (struct igc_thread *t)
   res = mps_ap_create_k (&t->immovable_ap, gc->immovable_pool, mps_args_none);
   IGC_CHECK_RES (res);
   res = create_weak_ap (&t->weak_strong_ap, t, false);
+  res = create_weak_hash_ap (&t->weak_hash_strong_ap, t, false);
   IGC_CHECK_RES (res);
   res = create_weak_ap (&t->weak_weak_ap, t, true);
+  res = create_weak_hash_ap (&t->weak_hash_weak_ap, t, true);
   IGC_CHECK_RES (res);
 }
 
@@ -2637,6 +2758,8 @@ igc_thread_remove (void **pinfo)
   mps_ap_destroy (t->d.leaf_ap);
   mps_ap_destroy (t->d.weak_strong_ap);
   mps_ap_destroy (t->d.weak_weak_ap);
+  mps_ap_destroy (t->d.weak_hash_strong_ap);
+  mps_ap_destroy (t->d.weak_hash_weak_ap);
   mps_ap_destroy (t->d.immovable_ap);
   mps_thread_dereg (deregister_thread (t));
 }
@@ -2956,6 +3079,7 @@ finalize_vector (mps_addr_t v)
     case PVEC_OBARRAY:
 #endif
     case PVEC_HASH_TABLE:
+    case PVEC_WEAK_HASH_TABLE:
     case PVEC_SYMBOL_WITH_POS:
     case PVEC_PROCESS:
     case PVEC_RECORD:
@@ -3005,6 +3129,8 @@ finalize (struct igc *gc, mps_addr_t base)
     case IGC_OBJ_DUMPED_BIGNUM_DATA:
     case IGC_OBJ_DUMPED_BYTES:
     case IGC_OBJ_BYTES:
+    case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+    case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
     case IGC_OBJ_NUM_TYPES:
       emacs_abort ();
 
@@ -3060,6 +3186,7 @@ maybe_finalize (mps_addr_t client, enum pvec_type tag)
     case PVEC_OBARRAY:
 #endif
     case PVEC_HASH_TABLE:
+    case PVEC_WEAK_HASH_TABLE:
     case PVEC_NORMAL_VECTOR:
     case PVEC_FREE:
     case PVEC_MARKER:
@@ -3300,6 +3427,12 @@ thread_ap (enum igc_obj_type type)
     case IGC_OBJ_VECTOR_WEAK:
       return t->d.weak_weak_ap;
 
+    case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+      return t->d.weak_hash_weak_ap;
+
+    case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+      return t->d.weak_hash_strong_ap;
+
     case IGC_OBJ_VECTOR:
     case IGC_OBJ_CONS:
     case IGC_OBJ_SYMBOL:
@@ -3664,12 +3797,51 @@ igc_alloc_lisp_obj_vec (size_t n)
   return alloc (n * sizeof (Lisp_Object), IGC_OBJ_OBJ_VEC);
 }
 
+static mps_addr_t
+weak_hash_find_dependent (mps_addr_t base)
+{
+  struct igc_header *h = base;
+  switch (h->obj_type)
+    {
+    case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+      {
+	mps_addr_t client = base_to_client (base);
+	struct Lisp_Weak_Hash_Table_Weak_Part *w = client;
+	return client_to_base (w->strong);
+      }
+    case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+      {
+	mps_addr_t client = base_to_client (base);
+	struct Lisp_Weak_Hash_Table_Strong_Part *w = client;
+	return client_to_base (w->weak);
+      }
+    default:
+      emacs_abort ();
+    }
+
+  return 0;
+}
+
 Lisp_Object *
 igc_make_hash_table_vec (size_t n)
 {
   return alloc (n * sizeof (Lisp_Object), IGC_OBJ_HASH_VEC);
 }
 
+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)
+{
+  return alloc (sizeof (struct Lisp_Weak_Hash_Table_Strong_Part) + 5 * size * sizeof (union 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)
+{
+  return alloc (sizeof (struct Lisp_Weak_Hash_Table_Weak_Part) + 5 * size * sizeof (union Lisp_Weak_Hash_Table_Entry),
+		IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART);
+}
+
 /* Like xpalloc, but uses 'alloc' instead of xrealloc, and should only
    be used for growing a vector of pointers whose current size is N
    pointers.  */
@@ -3865,6 +4037,7 @@ DEFUN ("igc-info", Figc_info, Sigc_info, 0, 0, 0, doc : /* */)
   walk_pool (gc, gc->dflt_pool, &st);
   walk_pool (gc, gc->leaf_pool, &st);
   walk_pool (gc, gc->weak_pool, &st);
+  walk_pool (gc, gc->weak_hash_pool, &st);
   walk_pool (gc, gc->immovable_pool, &st);
 
   Lisp_Object result = Qnil;
@@ -3964,7 +4137,7 @@ make_dflt_fmt (struct igc *gc)
 }
 
 static mps_pool_t
-make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls)
+make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls, mps_awl_find_dependent_t find_dependent)
 {
   mps_res_t res;
   mps_pool_t pool;
@@ -3973,6 +4146,8 @@ make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls)
     MPS_ARGS_ADD (args, MPS_KEY_FORMAT, fmt);
     MPS_ARGS_ADD (args, MPS_KEY_CHAIN, gc->chain);
     MPS_ARGS_ADD (args, MPS_KEY_INTERIOR, true);
+    if (find_dependent)
+      MPS_ARGS_ADD (args, MPS_KEY_AWL_FIND_DEPENDENT, find_dependent);
     res = mps_pool_create_k (&pool, gc->arena, cls, args);
   }
   MPS_ARGS_END (args);
@@ -3983,25 +4158,25 @@ make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls)
 static mps_pool_t
 make_pool_amc (struct igc *gc, mps_fmt_t fmt)
 {
-  return make_pool_with_class (gc, fmt, mps_class_amc ());
+  return make_pool_with_class (gc, fmt, mps_class_amc (), NULL);
 }
 
 static mps_pool_t
 make_pool_ams (struct igc *gc, mps_fmt_t fmt)
 {
-  return make_pool_with_class (gc, fmt, mps_class_ams ());
+  return make_pool_with_class (gc, fmt, mps_class_ams (), NULL);
 }
 
 static mps_pool_t
-make_pool_awl (struct igc *gc, mps_fmt_t fmt)
+make_pool_awl (struct igc *gc, mps_fmt_t fmt, mps_awl_find_dependent_t find_dependent)
 {
-  return make_pool_with_class (gc, fmt, mps_class_awl ());
+  return make_pool_with_class (gc, fmt, mps_class_awl (), find_dependent);
 }
 
 static mps_pool_t
 make_pool_amcz (struct igc *gc, mps_fmt_t fmt)
 {
-  return make_pool_with_class (gc, fmt, mps_class_amcz ());
+  return make_pool_with_class (gc, fmt, mps_class_amcz (), NULL);
 }
 
 static struct igc *
@@ -4020,7 +4195,9 @@ make_igc (void)
   gc->leaf_fmt = make_dflt_fmt (gc);
   gc->leaf_pool = make_pool_amcz (gc, gc->leaf_fmt);
   gc->weak_fmt = make_dflt_fmt (gc);
-  gc->weak_pool = make_pool_awl (gc, gc->weak_fmt);
+  gc->weak_pool = make_pool_awl (gc, gc->weak_fmt, NULL);
+  gc->weak_hash_fmt = make_dflt_fmt (gc);
+  gc->weak_hash_pool = make_pool_awl (gc, gc->weak_hash_fmt, weak_hash_find_dependent);
   gc->immovable_fmt = make_dflt_fmt (gc);
   gc->immovable_pool = make_pool_ams (gc, gc->immovable_fmt);
 
diff --git a/src/igc.h b/src/igc.h
index 95a0d25cbba..036fec5e238 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -56,6 +56,8 @@ #define EMACS_IGC_H
   IGC_OBJ_DUMPED_BUFFER_TEXT,
   IGC_OBJ_DUMPED_BIGNUM_DATA,
   IGC_OBJ_DUMPED_BYTES,
+  IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART,
+  IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART,
   IGC_OBJ_NUM_TYPES
 };
 
@@ -122,6 +124,8 @@ #define EMACS_IGC_H
 void *igc_grow_ptr_vec (void *v, ptrdiff_t *n, ptrdiff_t n_incr_min, ptrdiff_t n_max);
 void igc_grow_rdstack (struct read_stack *rs);
 Lisp_Object *igc_make_hash_table_vec (size_t n);
+struct Lisp_Weak_Hash_Table_Strong_Part *igc_alloc_weak_hash_table_strong_part(hash_table_weakness_t, size_t, size_t);
+struct Lisp_Weak_Hash_Table_Weak_Part *igc_alloc_weak_hash_table_weak_part(hash_table_weakness_t, size_t, size_t);
 void *igc_alloc_bytes (size_t nbytes);
 struct image_cache *igc_make_image_cache (void);
 struct interval *igc_make_interval (void);
diff --git a/src/lisp.h b/src/lisp.h
index 54f0a1715ea..525a87b01d9 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1039,6 +1039,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
   PVEC_BOOL_VECTOR,
   PVEC_BUFFER,
   PVEC_HASH_TABLE,
+  PVEC_WEAK_HASH_TABLE,
   PVEC_OBARRAY,
   PVEC_TERMINAL,
   PVEC_WINDOW_CONFIGURATION,
@@ -2558,6 +2559,7 @@ #define DOOBARRAY(oa, it)					\
 
 /* The structure of a Lisp hash table.  */
 
+struct Lisp_Weak_Hash_Table;
 struct Lisp_Hash_Table;
 struct hash_impl;
 
@@ -2605,6 +2607,55 @@ #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
+{
+  void *ptr;
+  Lisp_Object lisp_object; /* must be a fixnum or HASH_UNUSED_ENTRY_KEY! */
+};
+
+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;
+  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 */
+  hash_table_weakness_t weakness : 3;
+  hash_table_std_test_t frozen_test : 2;
+
+  /* True if the table can be purecopied.  The table cannot be
+     changed afterwards.  */
+  bool_bf purecopy : 1;
+
+  /* True if the table is mutable.  Ordinarily tables are mutable, but
+     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_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
+{
+  union vectorlike_header header;
+
+  struct Lisp_Weak_Hash_Table_Strong_Part *strong;
+  struct Lisp_Weak_Hash_Table_Weak_Part *weak;
+  Lisp_Object dump_replacement;
+};
+
 struct Lisp_Hash_Table
 {
   union vectorlike_header header;
@@ -2725,6 +2776,23 @@ XHASH_TABLE (Lisp_Object a)
   return h;
 }
 
+INLINE bool
+WEAK_HASH_TABLE_P (Lisp_Object a)
+{
+  return PSEUDOVECTORP (a, PVEC_WEAK_HASH_TABLE);
+}
+
+INLINE struct Lisp_Weak_Hash_Table *
+XWEAK_HASH_TABLE (Lisp_Object a)
+{
+  eassert (WEAK_HASH_TABLE_P (a));
+  struct Lisp_Weak_Hash_Table *h
+    = XUNTAG (a, Lisp_Vectorlike, struct Lisp_Weak_Hash_Table);
+  igc_check_fwd (h);
+  return h;
+}
+
+extern Lisp_Object igc_ptr_to_lisp (void *ptr);
 INLINE Lisp_Object
 make_lisp_hash_table (struct Lisp_Hash_Table *h)
 {
@@ -2732,6 +2800,13 @@ make_lisp_hash_table (struct Lisp_Hash_Table *h)
   return make_lisp_ptr (h, Lisp_Vectorlike);
 }
 
+INLINE Lisp_Object
+make_lisp_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
+{
+  eassert (PSEUDOVECTOR_TYPEP (&h->header, PVEC_WEAK_HASH_TABLE));
+  return make_lisp_ptr (h, Lisp_Vectorlike);
+}
+
 /* Value is the key part of entry IDX in hash table H.  */
 INLINE Lisp_Object
 HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2740,6 +2815,14 @@ HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->key[idx];
 }
 
+/* Value is the key part of entry IDX in hash table H.  */
+INLINE Lisp_Object
+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;
+}
+
 /* Value is the value part of entry IDX in hash table H.  */
 INLINE Lisp_Object
 HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2748,6 +2831,12 @@ HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->value[idx];
 }
 
+INLINE Lisp_Object
+WEAK_HASH_VALUE (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  return h->strong->value[idx].lisp_object;
+}
+
 /* Value is the hash code computed for entry IDX in hash table H.  */
 INLINE hash_hash_t
 HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2756,6 +2845,14 @@ HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->hash[idx];
 }
 
+/* Value is the hash code computed for entry IDX in hash table H.  */
+INLINE hash_hash_t
+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);
+}
+
 /* Value is the size of hash table H.  */
 INLINE ptrdiff_t
 HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
@@ -2763,6 +2860,13 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
   return h->table_size;
 }
 
+/* Value is the size of hash table H.  */
+INLINE ptrdiff_t
+WEAK_HASH_TABLE_SIZE (const struct Lisp_Weak_Hash_Table *h)
+{
+  return XFIXNUM (h->strong->table_size);
+}
+
 /* Size of the index vector in hash table H.  */
 INLINE ptrdiff_t
 hash_table_index_size (const struct Lisp_Hash_Table *h)
@@ -2770,6 +2874,12 @@ hash_table_index_size (const struct Lisp_Hash_Table *h)
   return (ptrdiff_t)1 << h->index_bits;
 }
 
+INLINE ptrdiff_t
+weak_hash_table_index_size (const struct Lisp_Weak_Hash_Table *h)
+{
+  return (ptrdiff_t)1 << XFIXNUM (h->strong->index_bits);
+}
+
 /* Hash value for KEY in hash table H.  */
 INLINE hash_hash_t
 hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
@@ -2777,6 +2887,13 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
   return h->test->hashfn (key, h);
 }
 
+/* Hash value for KEY in hash table H.  */
+INLINE hash_hash_t
+weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  return h->strong->test->hashfn (key, NULL);
+}
+
 /* Iterate K and V as key and value of valid entries in hash table H.
    The body may remove the current entry or alter its value slot, but not
    mutate TABLE in any other way.  */
@@ -2800,6 +2917,28 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
       ;									\
     else
 
+/* Iterate K and V as key and value of valid entries in hash table H.
+   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, \
+	 *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,	\
+           true);			                                \
+       eassert (dohash_##k##_##v##_base == (h)->strong->key		\
+		&& dohash_##k##_##v##_end				\
+		   == dohash_##k##_##v##_base				\
+		+ WEAK_HASH_TABLE_SIZE (h)),				\
+	 ++dohash_##k##_##v##_k, ++dohash_##k##_##v##_v)		\
+    if (hash_unused_entry_key_p (k))					\
+      ;									\
+    else
+
 /* Iterate I as index of valid entries in hash table H.
    Unlike DOHASH, this construct copes with arbitrary table mutations
    in the body.  The consequences of such mutations are limited to
@@ -2812,6 +2951,18 @@ #define DOHASH_SAFE(h, i)					\
       ;								\
     else
 
+/* Iterate I as index of valid entries in hash table H.
+   Unlike DOHASH, this construct copes with arbitrary table mutations
+   in the body.  The consequences of such mutations are limited to
+   whether and in what order entries are encountered by the loop
+   (which is usually bad enough), but not crashing or corrupting the
+   Lisp state.  */
+#define DOHASH_WEAK_SAFE(h, i)					\
+  for (ptrdiff_t i = 0; i < WEAK_HASH_TABLE_SIZE (h); i++)	\
+    if (hash_unused_entry_key_p (WEAK_HASH_KEY (h, i)))		\
+      ;								\
+    else
+
 void hash_table_thaw (Lisp_Object hash_table);
 void hash_table_rehash (struct Lisp_Hash_Table *h);
 
@@ -4086,6 +4237,13 @@ set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
   h->key[idx] = val;
 }
 
+INLINE void
+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;
+}
+
 INLINE void
 set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
 {
@@ -4093,6 +4251,13 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
   h->value[idx] = 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;
+}
+
 /* Use these functions to set Lisp_Object
    or pointer slots of struct Lisp_Symbol.  */
 
@@ -4354,13 +4519,23 @@ #define CONS_TO_INTEGER(cons, type, var)				\
 EMACS_UINT sxhash (Lisp_Object);
 Lisp_Object make_hash_table (const struct hash_table_test *, EMACS_INT,
                              hash_table_weakness_t, bool);
+Lisp_Object make_weak_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);
+Lisp_Object strengthen_hash_table (Lisp_Object weak);
+Lisp_Object strengthen_hash_table_for_dump (struct Lisp_Weak_Hash_Table *);
 ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object);
+ptrdiff_t weak_hash_lookup (struct Lisp_Weak_Hash_Table *, Lisp_Object);
 ptrdiff_t hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key,
 				hash_hash_t *phash);
 ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
 		    hash_hash_t);
+ptrdiff_t weak_hash_put (struct Lisp_Weak_Hash_Table *, Lisp_Object, Lisp_Object,
+			 hash_hash_t);
 void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object);
+void weak_hash_remove_from_table (struct Lisp_Weak_Hash_Table *, Lisp_Object);
+void weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table *h, ptrdiff_t i0);
+
 extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal;
 extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
 			       ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
diff --git a/src/pdumper.c b/src/pdumper.c
index a560dd06ba8..8f4d3f3dc25 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -1441,6 +1441,11 @@ dump_enqueue_object (struct dump_context *ctx,
                      Lisp_Object object,
                      struct link_weight weight)
 {
+  if (WEAK_HASH_TABLE_P (object))
+    {
+      strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (object));
+      object = XWEAK_HASH_TABLE (object)->dump_replacement;
+    }
   if (dump_object_needs_dumping_p (object))
     {
       dump_off state = dump_recall_object (ctx, object);
@@ -1943,6 +1948,11 @@ dump_field_lv_or_rawptr (struct dump_context *ctx,
       /* 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.  */
+      if (WEAK_HASH_TABLE_P (value))
+	{
+	  strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (value));
+	  value = XWEAK_HASH_TABLE (value)->dump_replacement;
+	}
       out_value = (intptr_t) 0xDEADF00D;
       dump_remember_fixup_lv (ctx,
                               out_field_offset,
@@ -3129,6 +3139,13 @@ dump_vectorlike (struct dump_context *ctx,
       return dump_vectorlike_generic (ctx, &v->header);
     case PVEC_BOOL_VECTOR:
       return dump_bool_vector(ctx, v);
+    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);
     case PVEC_HASH_TABLE:
       return dump_hash_table (ctx, lv);
     case PVEC_OBARRAY:
diff --git a/src/print.c b/src/print.c
index 2840252246f..f0453b72188 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2188,6 +2188,7 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun,
     case PVEC_CHAR_TABLE:
     case PVEC_SUB_CHAR_TABLE:
     case PVEC_HASH_TABLE:
+    case PVEC_WEAK_HASH_TABLE:
     case PVEC_BIGNUM:
     case PVEC_BOOL_VECTOR:
     /* Impossible cases.  */
@@ -2786,6 +2787,54 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	    goto next_obj;
 	  }
 
+	case PVEC_WEAK_HASH_TABLE:
+	  {
+	    struct Lisp_Weak_Hash_Table *h = XWEAK_HASH_TABLE (obj);
+	    /* Implement a readable output, e.g.:
+	       #s(hash-table test equal data (k1 v1 k2 v2)) */
+	    print_c_string ("#s(hash-table", printcharfun);
+
+	    if (!BASE_EQ (h->strong->test->name, Qeql))
+	      {
+		print_c_string (" test ", printcharfun);
+		print_object (h->strong->test->name, printcharfun, escapeflag);
+	      }
+
+	    if (h->strong->weakness != Weak_None)
+	      {
+		print_c_string (" weakness ", printcharfun);
+		print_object (hash_table_weakness_symbol (h->strong->weakness),
+			      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;
+	  }
+
 	case PVEC_BIGNUM:
 	  print_bignum (obj, printcharfun);
 	  break;