From 40d2a0076af69c3227bc13606aebdb5822ed7f0d Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 23 Feb 2011 11:59:38 +0100
Subject: [PATCH] GC dead links in weak hash tables before a possible rehash

* libguile/hashtab.c (vacuum_weak_hash_table): New helper, goes through
  the entirety of a weak hash table, vacuuming dead entries.
  (scm_hash_fn_create_handle_x): If when adding to a weak hash table, we
  would trigger a rehash, vacuum the table first.  The weak_bucket_assoc
  would have only caught dead entries within one bucket.

  Without this patch, the following code leaks:

  (let lp ()
    (call-with-output-string
      (lambda (port)
        (display "foo" port)))
    (lp))
---
 libguile/hashtab.c | 34 +++++++++++++++++++++++++++++-----
 1 file changed, 29 insertions(+), 5 deletions(-)

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index f3887c213..c703108cf 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -120,6 +120,26 @@ scm_fixup_weak_alist (SCM alist, size_t *removed_items)
   return result;
 }
 
+static void
+vacuum_weak_hash_table (SCM table)
+{
+  SCM buckets = SCM_HASHTABLE_VECTOR (table);
+  unsigned long k = SCM_SIMPLE_VECTOR_LENGTH (buckets);
+  size_t len = SCM_HASHTABLE_N_ITEMS (table);
+
+  while (k--)
+    {
+      size_t removed;
+      SCM alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
+      alist = scm_fixup_weak_alist (alist, &removed);
+      assert (removed <= len);
+      len -= removed;
+      SCM_SIMPLE_VECTOR_SET (buckets, k, alist);
+    }
+
+  SCM_SET_HASHTABLE_N_ITEMS (table, len);
+}
+
 
 /* Packed arguments for `do_weak_bucket_fixup'.  */
 struct t_fixup_args
@@ -651,12 +671,16 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
 	}
       SCM_SETCDR (new_bucket, SCM_SIMPLE_VECTOR_REF (buckets, k));
       SCM_SIMPLE_VECTOR_SET (buckets, k, new_bucket);
-      /* Update element count and maybe rehash the table.  The
-         table might have too few entries here since weak hash
-         tables used with the hashx_* functions can not be
-         rehashed after GC.
-      */
       SCM_HASHTABLE_INCREMENT (table);
+
+      /* Maybe rehash the table.  If it's a weak table, pump all of the
+         buckets first to remove stale links.  If the weak table is of
+         the kind that gets lots of insertions of short-lived values, we
+         might never need to actually rehash.  */
+      if (SCM_HASHTABLE_WEAK_P (table)
+          && SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table))
+        vacuum_weak_hash_table (table);
+          
       if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table)
           || SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table))
         scm_i_rehash (table, hash_fn, closure, FUNC_NAME);