[Chicken-hackers] [PATCH] make symbol-GC more reliable

[Felix]

This patch tries to fix the currently unreliable garbage collection
of unused symbols ("-:w" runtime option):

a) clear weak-entry-table on heap-resizing to avoid keeping stale pointers
   to the old heap-space(s)
b) use a randomization value recomputed on every GC to reduce the probability
   of unresolvable hashtable collisions which would cause some values never
   to be reclaimed

This change seems to recover all unused symbols, both in interpreted
and compiled code.


cheers,
felix

>From 487d155e48d76f75b6792b426eee437a61302cbf Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Fri, 2 Nov 2012 10:50:30 +0100
Subject: [PATCH] Make symbol-GC more reliable by

a) clear weak-entry-table on heap-resizing to avoid keeping stale pointers
   to the old heap-space(s)
b) use a randomization value recomputed on every GC to reduce the probability
   of unresolvable hashtable collisions which would cause some values never
   to be reclaimed

This change seems to recover all unused symbols, both in interpreted
and compiled code.
---
 runtime.c                |   14 ++++++++++----
 tests/symbolgc-tests.scm |   20 ++++++++++++++------
 2 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/runtime.c b/runtime.c
index 3538944..3ddbae1 100644
--- a/runtime.c
+++ b/runtime.c
@@ -412,6 +412,7 @@ static C_TLS int
   gc_count_1,
   gc_count_1_total,
   gc_count_2,
+  weak_table_randomization,
   interrupt_reason,
   stack_size_changed,
   dlopen_flags,
@@ -649,7 +650,9 @@ int CHICKEN_initialize(int heap, int stack, int symbols, 
void *toplevel)
 
   /* Allocate weak item table: */
   if(C_enable_gcweak) {
-    if((weak_item_table = (WEAK_TABLE_ENTRY *)C_calloc(WEAK_TABLE_SIZE, 
sizeof(WEAK_TABLE_ENTRY))) == NULL)
+    weak_item_table = (WEAK_TABLE_ENTRY *)C_calloc(WEAK_TABLE_SIZE, 
sizeof(WEAK_TABLE_ENTRY));
+
+    if(weak_item_table == NULL)
       return 0;
   }
 
@@ -2769,6 +2772,9 @@ C_regparm void C_fcall C_reclaim(void *trampoline, void 
*proc)
   gc_mode = GC_MINOR;
   start = C_fromspace_top;
 
+  if(C_enable_gcweak) 
+    weak_table_randomization = rand();
+
   /* Entry point for second-level GC (on explicit request or because of full 
fromspace): */
 #ifdef HAVE_SIGSETJMP
   if(C_sigsetjmp(gc_restart, 0) || start >= C_fromspace_limit) {
@@ -3328,12 +3334,12 @@ C_regparm void C_fcall C_rereclaim2(C_uword size, int 
double_plus)
     remark(&flist->finalizer);
   }
 
-  /* Mark weakly held items: */
+  /* Clear weakly held items: */
   if(C_enable_gcweak) {
     wep = weak_item_table; 
 
     for(i = 0; i < WEAK_TABLE_SIZE; ++i, ++wep)
-      if(wep->item != 0) remark(&wep->item);
+      wep->item = wep->container = 0;
   }
 
   /* Mark trace-buffer: */
@@ -3608,7 +3614,7 @@ C_regparm WEAK_TABLE_ENTRY *C_fcall 
lookup_weak_table_entry(C_word item, C_word
   WEAK_TABLE_ENTRY *wep;
 
   for(n = 0; n < WEAK_HASH_ITERATIONS; ++n) {
-    key = (key + disp) % WEAK_TABLE_SIZE;
+    key = (key + disp + weak_table_randomization) % WEAK_TABLE_SIZE;
     wep = &weak_item_table[ key ];
 
     if(wep->item == 0) {
diff --git a/tests/symbolgc-tests.scm b/tests/symbolgc-tests.scm
index 210247b..efe458e 100644
--- a/tests/symbolgc-tests.scm
+++ b/tests/symbolgc-tests.scm
@@ -5,11 +5,13 @@
 
 (use extras)
 
-(assert (##sys#fudge 15))
+(assert (##sys#fudge 15) "please run this test with the `-:w' runtime option")
 
+(define n 'n)                          ; intern "n" which is used below
 (define *count1* (vector-ref (##sys#symbol-table-info) 2))
 
 (print "starting with " *count1* " symbols")
+
 (print "interning 10000 symbols ...")
 
 (do ((i 10000 (sub1 i)))
@@ -18,11 +20,17 @@
 
 (print "recovering ...")
 
-(let loop ()
+(let loop ((i 0))
   (let ((n (vector-ref (##sys#symbol-table-info) 2)))
-    (print* n " ")
-    (unless (< (- n *count1*) 200)     ; allow some
-      (gc #t)
-      (loop))))
+    (print* (- n *count1*) " ")
+    (cond ((> i 100)
+          (unless (= n *count1*)
+            (error "unable to reclaim all symbols")))
+         ((< (- n *count1*) 100)     ; allow some
+          (gc #t)
+          (loop (+ i 1)))
+         (else 
+          (gc #t)
+          (loop 0)))))
 
 (print "\ndone.")
-- 
1.7.0.4