~ chicken-core (chicken-5) abc3cf4dd97f77da2b6cc7c6c36937205ef2eea8

commit abc3cf4dd97f77da2b6cc7c6c36937205ef2eea8
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Fri Jun 30 15:28:08 2017 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Jul 16 14:57:16 2017 +0200

    Fix unpersistability sanity check for symbol GC
    
    The sanity check we do just before dropping symbols from the symbol
    table will ensure that the "bound value" slot of a symbol is either
    empty or contains the symbol itself.  If either is violated, the
    assertion check fails.
    
    This is correct, but keywords may have been moved by the GC and
    replaced with forwarding pointers.  This means the symbol value slot
    could contain a forwarding pointer, which is definitely _not_ equal to
    the symbol itself.
    
    To fix this, before performing our sanity checks, we now fix up any
    forwarding pointers in the symbol's value.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/runtime.c b/runtime.c
index 64020e24..311a1be7 100644
--- a/runtime.c
+++ b/runtime.c
@@ -4132,6 +4132,25 @@ C_regparm void C_fcall update_locative_table(int mode)
   if(mode != GC_REALLOC) locative_table_count = hi;
 }
 
+static C_regparm void fixup_symbol_forwards(C_word sym)
+{
+  C_word val, h;
+  int i, s = C_header_size(sym); /* 3 */
+
+  for (i = 0; i < s; i++) {
+    val = C_block_item(sym, i);
+    if (!C_immediatep(val)) {
+      h = C_block_header(val);
+
+      while(is_fptr(h)) {
+        val = fptr_to_ptr(h);
+        h = C_block_header(val);
+      }
+      C_set_block_item(sym, i, val);
+    }
+  }
+}
+
 C_regparm void C_fcall update_symbol_tables(int mode)
 {
   int weakn = 0, i;
@@ -4159,17 +4178,11 @@ C_regparm void C_fcall update_symbol_tables(int mode)
 
 #ifdef DEBUGBUILD
         /* Detect inconsistencies before dropping / keeping the symbol */
+        fixup_symbol_forwards(sym);
 	{
 	  C_word str = C_symbol_name(sym);
           int str_perm;
 
-	  h = C_block_header(str);
-
-	  while(is_fptr(h)) {
-	    str = fptr_to_ptr(h);
-	    h = C_block_header(str);
-	  }
-
           str_perm = !C_in_stackp(str) && !C_in_heapp(str) &&
                   !C_in_scratchspacep(str) &&
                   (mode == GC_REALLOC ? !C_in_new_heapp(str) : 1);
@@ -4196,7 +4209,10 @@ C_regparm void C_fcall update_symbol_tables(int mode)
 	  if(last) C_set_block_item(last, 1, C_block_item(bucket,1));
 	  else stp->table[ i ] = C_block_item(bucket,1);
 
+#ifndef NDEBUG
+          fixup_symbol_forwards(sym);
 	  assert(!C_persistable_symbol(sym));
+#endif
 	  ++weakn;
 	} else {
 	  C_set_block_item(bucket,0,sym); /* Might have moved */