~ chicken-core (chicken-5) f97a4e630c1390372c168327ee97838f633d0eac

commit f97a4e630c1390372c168327ee97838f633d0eac
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Nov 2 10:50:30 2012 +0100
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Sun Nov 4 14:13:17 2012 +0100

    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
    c) only enter symbol objects in the w-e-t - which is, after all, kind of obvious ...
    
    This change seems to recover all unused symbols, both in interpreted
    and compiled code.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/runtime.c b/runtime.c
index 3538944d..dece653c 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) {
@@ -3148,7 +3154,9 @@ C_regparm void C_fcall really_mark(C_word *x)
   }
   else { /* (major GC) */
     /* Increase counter (saturated at 2) if weakly held item (someone pointed to this object): */
-    if(C_enable_gcweak && (wep = lookup_weak_table_entry(val, 0)) != NULL) {
+    if(C_enable_gcweak &&
+       (h & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE &&
+       (wep = lookup_weak_table_entry(val, 0)) != NULL) {
       if((wep->container & WEAK_COUNTER_MAX) == 0) ++wep->container;
     }
 
@@ -3328,12 +3336,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 +3616,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 210247bf..19cc84cc 100644
--- a/tests/symbolgc-tests.scm
+++ b/tests/symbolgc-tests.scm
@@ -5,11 +5,17 @@
 
 (use extras)
 
-(assert (##sys#fudge 15))
+(assert (##sys#fudge 15) "please run this test with the `-:w' runtime option")
+
+(define (gcsome #!optional (n 100))
+  (do ((i n (sub1 i))) ((zero? i)) (gc #t)))
+
+(gcsome)
 
 (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 +24,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.")