Ticket #1173: working-symbol-gc.patch

NEWS

@@ -23 +23 @@
     which is faster because it is inlined (#1260, thanks to Kooda).
   - The default error handler now truncates very long condition
     messages (thanks to Lemonboy).
+  - Weak symbol GC (-:w) no longer drops random symbols (#1173).
 
 - Syntax expander
   - DSSSL lambda lists have improved hygiene, so they don't need

chicken.h

@@ -2652 +2652 @@
 {
   C_word *p = *ptr, *p0 = p;
 
-  *(p++) = C_BUCKET_TYPE | (C_SIZEOF_BUCKET - 1);
+  if (C_enable_gcweak)
+    *(p++) = C_BUCKET_TYPE | C_SPECIALBLOCK_BIT | (C_SIZEOF_BUCKET - 1);
+  else
+    *(p++) = C_BUCKET_TYPE | (C_SIZEOF_BUCKET - 1);
   *(p++) = head;
   *(p++) = tail;
   *ptr = p;

runtime.c

@@ -156 +156 @@
 
 #define MAX_HASH_PREFIX                64
 
-#define WEAK_TABLE_SIZE                997
-#define WEAK_HASH_ITERATIONS           4
-#define WEAK_HASH_DISPLACEMENT         7
-#define WEAK_COUNTER_MASK              3
-#define WEAK_COUNTER_MAX               2
-
 #define TEMPORARY_STACK_SIZE           4096
 #define STRING_BUFFER_SIZE             4096
 #define DEFAULT_MUTATION_STACK_SIZE    1024
@@ -285 +279 @@
   char *module_name;
 } LF_LIST;
 
-typedef struct weak_table_entry_struct
-{
-  C_word item,                  /* item weakly held (symbol) */
-         container;             /* object holding reference to symbol, lowest 3 bits are */
-} WEAK_TABLE_ENTRY;             /*   also used as a counter, saturated at 2 or more */
-
 typedef struct finalizer_node_struct
 {
   struct finalizer_node_struct
@@ -438 +426 @@
   gc_count_1,
   gc_count_1_total,
   gc_count_2,
-  weak_table_randomization,
   stack_size_changed,
   dlopen_flags,
   heap_size_changed,
@@ -474 +461 @@
   allocated_finalizer_count,
   pending_finalizer_count,
   callback_returned_flag;
-static C_TLS WEAK_TABLE_ENTRY *weak_item_table;
 static C_TLS C_GC_ROOT *gc_root_list = NULL;
 static C_TLS FINALIZER_NODE 
   *finalizer_list,
@@ -501 +487 @@
 static void usual_panic(C_char *msg) C_noret;
 static void horror(C_char *msg) C_noret;
 static void C_fcall really_mark(C_word *x) C_regparm;
-static WEAK_TABLE_ENTRY *C_fcall lookup_weak_table_entry(C_word item, C_word container) C_regparm;
 static C_cpsproc(values_continuation) C_noret;
 static C_word add_symbol(C_word **ptr, C_word key, C_word string, C_SYMBOL_TABLE *stable);
 static C_regparm int C_fcall C_in_new_heapp(C_word x);
@@ -515 +500 @@
 static void C_fcall really_remark(C_word *x) C_regparm;
 static C_word C_fcall intern0(C_char *name) C_regparm;
 static void C_fcall update_locative_table(int mode) C_regparm;
+static void C_fcall update_symbol_tables(int mode) C_regparm;
 static LF_LIST *find_module_handle(C_char *name);
 static void set_profile_timer(C_uword freq);
 static void take_profile_sample();
@@ -687 +673 @@
   C_gc_mutation_hook = NULL;
   C_gc_trace_hook = NULL;
 
-  /* Allocate weak item table: */
-  if(C_enable_gcweak) {
-    weak_item_table = (WEAK_TABLE_ENTRY *)C_calloc(WEAK_TABLE_SIZE, sizeof(WEAK_TABLE_ENTRY));
-
-    if(weak_item_table == NULL)
-      return 0;
-  }
-
   /* Initialize finalizer lists: */
   finalizer_list = NULL;
   finalizer_free_list = NULL;
@@ -2834 +2812 @@
   C_cblockend
 #endif
 
+/* Keep all symbols that are globally bound (i.e., top-level
+ * identifiers) or have non-empty property lists.
+ * Keywords will always be discarded.
+ */
+#define keep_symbol(s) ((C_block_item((s), 0) != C_SCHEME_UNBOUND &&    \
+                         C_block_item((s), 0) != (s) /* kw */) ||       \
+                        C_block_item((s), 2) != C_SCHEME_END_OF_LIST)
 
 C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
 {
-  int i, j, n, fcount, weakn = 0;
+  int i, j, n, fcount;
   C_uword count, bytes;
-  C_word *p, **msp, bucket, last, item, container;
+  C_word *p, **msp, bucket, last;
   C_header h;
   C_byte *tmp, *start;
   LF_LIST *lfn;
   C_SCHEME_BLOCK *bp;
   C_GC_ROOT *gcrp;
-  WEAK_TABLE_ENTRY *wep;
   double tgc = 0;
   C_SYMBOL_TABLE *stp;
   volatile int finalizers_checked;
@@ -2874 +2858 @@
   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) {
@@ -2916 +2897 @@
       for(i = 0; i < lfn->count; ++i)
         mark(&lfn->lf[i]);
 
-    /* Mark symbol tables: */
-    for(stp = symbol_table_list; stp != NULL; stp = stp->next)
-      for(i = 0; i < stp->size; ++i)
-        mark(&stp->table[i]);
-
     /* Mark collectibles: */
     for(msp = collectibles; msp < collectibles_top; ++msp)
       if(*msp != NULL) mark(*msp);
@@ -2954 +2930 @@
     mark(&tinfo->thread);
   }
 
+  /* Mark symbol tables: */
+  for(stp = symbol_table_list; stp != NULL; stp = stp->next) {
+    for(i = 0; i < stp->size; ++i) {
+      mark(&stp->table[i]); /* Ensure buckets survive */
+
+      if (C_enable_gcweak) {
+        for(bucket = stp->table[ i ]; bucket != C_SCHEME_END_OF_LIST; bucket = C_block_item(bucket,1)) {
+          if (keep_symbol(C_block_item(bucket, 0)))
+            mark(&C_block_item(bucket, 0));
+        }
+      }
+    }
+  }
+
  rescan:
   /* Mark nested values in already moved (marked) blocks in breadth-first manner: */
   while(heap_scan_top < (gc_mode == GC_MINOR ? C_fromspace_top : tospace_top)) {
@@ -3092 +3082 @@
 
   i_like_spaghetti:
     ++gc_count_2;
-
-    if(C_enable_gcweak) {
-      /* Check entries in weak item table and recover items ref'd only
-         once, which are unbound symbols and have empty property-lists: */
-      weakn = 0;
-      wep = weak_item_table;
-
-      for(i = 0; i < WEAK_TABLE_SIZE; ++i, ++wep)
-        if(wep->item != 0) { 
-          if((wep->container & WEAK_COUNTER_MAX) == 0 && /* counter saturated? (more than 1) */
-             is_fptr((item = C_block_header(wep->item)))) { /* and forwarded/collected */
-            item = fptr_to_ptr(item);                       /* recover obj from forwarding ptr */
-            container = wep->container & ~WEAK_COUNTER_MASK;
-
-            if(C_header_bits(item) == C_SYMBOL_TYPE && 
-               C_block_item(item, 0) == C_SCHEME_UNBOUND &&
-               C_block_item(item, 2) == C_SCHEME_END_OF_LIST) {
-              ++weakn;
-              C_set_block_item(container, 0, C_SCHEME_UNDEFINED); /* clear reference to item */
-            }
-          }
-
-          wep->item = wep->container = 0;
-        }
-
-      /* Remove empty buckets in symbol table: */
-      for(stp = symbol_table_list; stp != NULL; stp = stp->next) {
-        for(i = 0; i < stp->size; ++i) {
-          last = 0;
-          
-          for(bucket = stp->table[ i ]; bucket != C_SCHEME_END_OF_LIST; bucket = C_block_item(bucket,1))
-            if(C_block_item(bucket,0) == C_SCHEME_UNDEFINED) {
-              if(last) C_set_block_item(last, 1, C_block_item(bucket,1));
-              else stp->table[ i ] = C_block_item(bucket,1);
-            }
-            else last = bucket;
-        }
-      }
-    }
   }
 
+  update_symbol_tables(gc_mode);
+
   if(gc_mode == GC_MAJOR) {
     tgc = C_cpu_milliseconds() - tgc;
     gc_ms += tgc;
@@ -3169 +3122 @@
           (C_uword)tospace_start, (C_uword)tospace_top, 
           (C_uword)tospace_limit);
 
-    if(gc_mode == GC_MAJOR && C_enable_gcweak && weakn)
-      C_dbg("GC", C_text("%d recoverable weakly held items found\n"), weakn);
-    
     C_dbg("GC", C_text("%d locatives (from %d)\n"), locative_table_count, locative_table_size);
   }
 
@@ -3200 +3150 @@
 
 C_regparm void C_fcall really_mark(C_word *x)
 {
-  C_word val, item;
+  C_word val;
   C_uword n, bytes;
   C_header h;
   C_SCHEME_BLOCK *p, *p2;
-  WEAK_TABLE_ENTRY *wep;
 
   val = *x;
 
@@ -3227 +3176 @@
       return;
     }
 
-    if((C_uword)val >= (C_uword)fromspace_start && (C_uword)val < (C_uword)C_fromspace_top) return;
+    if((C_uword)val >= (C_uword)fromspace_start && (C_uword)val < (C_uword)C_fromspace_top)
+      return;
 
     p2 = (C_SCHEME_BLOCK *)C_align((C_uword)C_fromspace_top);
 
@@ -3257 +3207 @@
     C_memcpy(p2->data, p->data, bytes);
   }
   else { /* (major GC) */
-    /* Increase counter (saturated at 2) if weakly held item (someone pointed to this object): */
-    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;
-    }
-
     if(is_fptr(h)) {
       val = fptr_to_ptr(h);
 
@@ -3299 +3242 @@
     }
 #endif
 
-    if(C_enable_gcweak && (h & C_HEADER_TYPE_BITS) == C_BUCKET_TYPE) {
-      item = C_block_item(val,0);
-
-      /* Lookup item in weak item table or add entry: */
-      if((wep = lookup_weak_table_entry(item, (C_word)p2)) != NULL) {
-        /* If item is already forwarded, then set count to 2: */
-        if(is_fptr(C_block_header(item))) wep->container |= 2;
-      }
-    }
-
     n = C_header_size(p);
     bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word);
 
@@ -3348 +3281 @@
   C_cblockend
 #endif
 
-
 /* Do a major GC into a freshly allocated heap: */
 
 C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize)
 {
   int i, j;
   C_uword count, n, bytes;
-  C_word *p, **msp, item, last;
+  C_word *p, **msp, bucket, last;
   C_header h;
   C_byte *tmp, *start;
   LF_LIST *lfn;
   C_SCHEME_BLOCK *bp;
-  WEAK_TABLE_ENTRY *wep;
   C_GC_ROOT *gcrp;
   C_SYMBOL_TABLE *stp;
   FINALIZER_NODE *flist;
@@ -3443 +3374 @@
       remark(&lfn->lf[i]);
 
   /* Mark symbol table: */
-  for(stp = symbol_table_list; stp != NULL; stp = stp->next)
-    for(i = 0; i < stp->size; ++i)
-      remark(&stp->table[i]);
+  for(stp = symbol_table_list; stp != NULL; stp = stp->next) {
+    for(i = 0; i < stp->size; ++i) {
+      remark(&stp->table[i]); /* Ensure buckets survive */
+
+      if (C_enable_gcweak) {
+        for(bucket = stp->table[ i ]; bucket != C_SCHEME_END_OF_LIST; bucket = C_block_item(bucket,1)) {
+          if(keep_symbol(C_block_item(bucket, 0)))
+            remark(&C_block_item(bucket, 0));
+        }
+      }
+    }
+  }
 
   /* Mark collectibles: */
   for(msp = collectibles; msp < collectibles_top; ++msp)
@@ -3473 +3413 @@
     remark(&flist->finalizer);
   }
 
-  /* Clear weakly held items: */
-  if(C_enable_gcweak) {
-    wep = weak_item_table; 
-
-    for(i = 0; i < WEAK_TABLE_SIZE; ++i, ++wep)
-      wep->item = wep->container = 0;
-  }
-
   /* Mark trace-buffer: */
   for(tinfo = trace_buffer; tinfo < trace_buffer_limit; ++tinfo) {
     remark(&tinfo->cooked1);
@@ -3515 +3447 @@
     heap_scan_top = (C_byte *)bp + C_align(bytes) + sizeof(C_word);
   }
 
+  update_symbol_tables(GC_REALLOC);
+
   heap_free (heapspace1, heapspace1_size);
   heap_free (heapspace2, heapspace2_size);
   
@@ -3560 +3494 @@
   C_uword n, bytes;
   C_header h;
   C_SCHEME_BLOCK *p, *p2;
-  WEAK_TABLE_ENTRY *wep;
 
   val = *x;
 
@@ -3734 +3667 @@
   if(mode != GC_REALLOC) locative_table_count = hi;
 }
 
-
-C_regparm WEAK_TABLE_ENTRY *C_fcall lookup_weak_table_entry(C_word item, C_word container)
+C_regparm void C_fcall update_symbol_tables(int mode)
 {
-  C_uword
-    key = (C_uword)item >> 2,
-    disp = 0,
-    n;
-  WEAK_TABLE_ENTRY *wep;
-
-  for(n = 0; n < WEAK_HASH_ITERATIONS; ++n) {
-    key = (key + disp + weak_table_randomization) % WEAK_TABLE_SIZE;
-    wep = &weak_item_table[ key ];
+  int weakn = 0, i;
+  C_word bucket, last, sym, h;
+  C_SYMBOL_TABLE *stp;
 
-    if(wep->item == 0) {
-      if(container != 0) {
-        /* Add fresh entry: */
-        wep->item = item;
-        wep->container = container;
-        return wep;
+  if(C_enable_gcweak) {
+    /* Fixup symbol table */
+    for(stp = symbol_table_list; stp != NULL; stp = stp->next) {
+      for(i = 0; i < stp->size; ++i) {
+        last = 0;
+
+        for(bucket = stp->table[ i ]; bucket != C_SCHEME_END_OF_LIST; bucket = C_block_item(bucket,1)) {
+
+          sym = C_block_item(bucket, 0);
+          h = C_block_header(sym);
+          /* Resolve any forwarding pointers */
+          while(is_fptr(h)) {
+            sym = fptr_to_ptr(h);
+            h = C_block_header(sym);
+          }
+
+          /* If the symbol is unreferenced, drop it: */
+          if(!C_truep(C_permanentp(sym)) &&
+             (mode == GC_REALLOC ?
+              !C_in_new_heapp(sym) :
+              !C_in_fromspacep(sym))) {
+            if(last) C_set_block_item(last, 1, C_block_item(bucket,1));
+            else stp->table[ i ] = C_block_item(bucket,1);
+            ++weakn;
+            assert(!keep_symbol(sym));
+          } else {
+            assert((h & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE);
+            C_set_block_item(bucket,0,sym); /* Might have moved */
+            last = bucket;
+          }
+        }
       }
-
-      return NULL;
     }
-    else if(wep->item == item) return wep;
-    else disp += WEAK_HASH_DISPLACEMENT;
+    if(gc_report_flag && weakn)
+      C_dbg("GC", C_text("%d recoverable weakly held items found\n"), weakn);
+  } else {
+#ifdef DEBUGBUILD
+    /* Sanity check: all symbols should've been marked */
+    for(stp = symbol_table_list; stp != NULL; stp = stp->next)
+      for(i = 0; i < stp->size; ++i)
+        for(bucket = stp->table[ i ]; bucket != C_SCHEME_END_OF_LIST; bucket = C_block_item(bucket,1)) {
+          sym = C_block_item(bucket, 0);
+          assert(!is_fptr(C_block_header(sym)) &&
+                 (C_truep(C_permanentp(sym)) ||
+                  (mode == GC_REALLOC ?
+                   C_in_new_heapp(sym) :
+                   C_in_fromspacep(sym))));
+        }
+#endif
   }
-
-  return NULL;
 }