Add (empty) write barriers in preparation for more advanced GC.

builtin.c

@@ -81,18 +81,25 @@ static void register_structure(gc_root_t *ms_root)
   _get_struct(ms_root->value)->type = ms_root->value;
   /* Slot 1: Name */
   _get_struct(ms_root->value)->slots[SS(NAME)] = string_to_value("structure");
+  WRITE_BARRIER(ms_root->value);
   /* Slot 2: Super/parent structure type, or FALSE_VALUE */
   _get_struct(ms_root->value)->slots[SS(SUPER)] = FALSE_VALUE;
   /* Slot 3: Vector of slot names; size == total number of slots (excl. type) */
   _get_struct(ms_root->value)->slots[SS(SLOTS)] = make_vector(STRUCTURE_SLOTS, UNDEFINED);
+  WRITE_BARRIER(ms_root->value);
   {
     gc_root_t vec_root;
     register_gc_root(&vec_root, _get_struct(ms_root->value)->slots[SS(SLOTS)]);
     _get_vector(vec_root.value)->elements[SS(NAME)] = string_to_value("name");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[SS(SUPER)] = string_to_value("super");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[SS(SLOTS)] = string_to_value("slots");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[SS(CALLABLE)] = string_to_value("callable");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[SS(MUTABLE)] = string_to_value("mutable");
+    WRITE_BARRIER(vec_root.value);
     unregister_gc_root(&vec_root);
   }
   /* Slot 4: Callable object used as proxy when structure is APPLY'd. */
@@ -116,21 +123,31 @@ static void register_template(gc_root_t *ms_root)
 
   /* Slot 1: Name */
   _get_struct(tmp_root.value)->slots[SS(NAME)] = string_to_value("template");
+  WRITE_BARRIER(tmp_root.value);
   /* Slot 2: Super/parent structure type, or FALSE_VALUE */
   _get_struct(tmp_root.value)->slots[SS(SUPER)] = FALSE_VALUE;
   /* Slot 3: Vector of slot names; size == total number of slots */
   _get_struct(tmp_root.value)->slots[SS(SLOTS)] = make_vector(TEMPLATE_SLOTS, UNDEFINED);
+  WRITE_BARRIER(tmp_root.value);
   {
     gc_root_t vec_root;
     register_gc_root(&vec_root, _get_struct(tmp_root.value)->slots[SS(SLOTS)]);
     _get_vector(vec_root.value)->elements[TS(GLOBAL_VARS)]   = string_to_value("global-vars");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[TS(INSTANCE_VARS)] = string_to_value("instance-vars");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[TS(FRAME_VARS)]    = string_to_value("frame-vars");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[TS(BYTE_CODE)]     = string_to_value("byte-code");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[TS(TAIL_CALL)]     = string_to_value("tail-call");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[TS(ARG_LIST)]      = string_to_value("argument-list");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[TS(CONTINUATION)]  = string_to_value("continuation");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[TS(CONTEXT)]       = string_to_value("context");
+    WRITE_BARRIER(vec_root.value);
     unregister_gc_root(&vec_root);
   }
   /* Slot 4: Callable object used as proxy when structure is apply'd. */
@@ -154,21 +171,31 @@ static void register_lambda(gc_root_t *ms_root)
 
   /* Slot 1: Name */
   _get_struct(tmp_root.value)->slots[SS(NAME)] = string_to_value("lambda");
+  WRITE_BARRIER(tmp_root.value);
   /* Slot 2: Super/parent structure type, or FALSE_VALUE */
   _get_struct(tmp_root.value)->slots[SS(SUPER)] = FALSE_VALUE;
   /* Slot 3: Vector of slot names; size == total number of slots */
   _get_struct(tmp_root.value)->slots[SS(SLOTS)] = make_vector(LAMBDA_SLOTS, UNDEFINED);
+  WRITE_BARRIER(tmp_root.value);
   {
     gc_root_t vec_root;
     register_gc_root(&vec_root, _get_struct(tmp_root.value)->slots[SS(SLOTS)]);
     _get_vector(vec_root.value)->elements[LS(GLOBAL_VARS)]   = string_to_value("global-vars");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[LS(INSTANCE_VARS)] = string_to_value("instance-vars");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[LS(FRAME_VARS)]    = string_to_value("frame-vars");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[LS(BYTE_CODE)]     = string_to_value("byte-code");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[LS(TAIL_CALL)]     = string_to_value("tail-call");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[LS(ARG_LIST)]      = string_to_value("argument-list");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[LS(CONTINUATION)]  = string_to_value("continuation");
+    WRITE_BARRIER(vec_root.value);
     _get_vector(vec_root.value)->elements[LS(CONTEXT)]       = string_to_value("context");
+    WRITE_BARRIER(vec_root.value);
     unregister_gc_root(&vec_root);
   }
   /* Slot 4: Callable object used as proxy when structure is apply'd. */

gc.h

@@ -79,6 +79,11 @@ typedef void (builtin_fn_t)(struct interp_state *state);
 #define _CADR(x) _CAR(_CDR(x))
 #define _CDDR(x) _CDR(_CDR(x))
 
+/* Invoke this macro after creating any reference from a Gen-1 GC object to a Gen-0 object. */
+/* If unsure, invoke the macro; at most there will be a slight cost in performance. */
+/* Failing to invoke the macro before the next Gen-0 GC can lead to incorrect behavior. */
+#define WRITE_BARRIER(gen1_value) ((void)0)
+
 typedef struct object
 {
   value_t tag;

interp.c

@@ -16,7 +16,7 @@
 #include "builtin.h"
 #include "interp.h"
 
-/* Ex: _SLOT_VALUE(STRUCTURE, v, NAME) */
+/* Ex: _SLOT_VALUE(STRUCTURE, v, NAME) */
 #define _SLOT_VALUE(t,v,s) (_get_struct(v)->slots[t ## _SLOT_ ## s])
 #define _LAMBDA_SLOT(v,s)  _SLOT_VALUE(LAMBDA, v, s)
 
@@ -152,7 +152,7 @@ value_t run_interpreter(value_t lambda, value_t argv)
 /* TODO: Permit derivatives of 'structure', and improve detection of cycles. */
 static bool struct_is_a(value_t s, value_t type)
 {
-  /* Detect unbounded loops w/ cyclic 'parent' links. */
+  /* Detect unbounded loops w/ cyclic 'super' links. */
   int ttl = 256;
 
   if (!is_struct(s))
@@ -196,6 +196,7 @@ static void vector_set(value_t v, fixnum_t idx, value_t newval)
   vector_t *vec = get_vector(v);
   release_assert((idx >= 0) && (idx < vec->size));
   vec->elements[idx] = newval;
+  WRITE_BARRIER(v);
 }
 
 static void byte_string_set(value_t v, fixnum_t idx, char newval)
@@ -214,6 +215,7 @@ static void struct_set(value_t v, fixnum_t idx, value_t newval)
   release_assert((idx >= 0) && (idx < s->nslots));
 
   s->slots[idx] = newval;
+  WRITE_BARRIER(v);
 }
 
 static value_t make_lambda(interp_state_t *state, value_t templ)
@@ -237,18 +239,26 @@ static value_t make_lambda(interp_state_t *state, value_t templ)
                                        ->slots[TEMPLATE_SLOT_INSTANCE_VARS])->size,
                      UNDEFINED);
   _LAMBDA_SLOT(lambda_root.value, INSTANCE_VARS) = temp;
+  WRITE_BARRIER(lambda_root.value);
 
   ls = _get_struct(lambda_root.value);
   ts = _get_struct(templ_root.value);
 
   /* All but the instance variables are just shallow-copied. */
   ls->slots[LAMBDA_SLOT_GLOBAL_VARS]  = ts->slots[TEMPLATE_SLOT_GLOBAL_VARS];
+  WRITE_BARRIER(lambda_root.value);
   ls->slots[LAMBDA_SLOT_FRAME_VARS]   = ts->slots[TEMPLATE_SLOT_FRAME_VARS];
+  WRITE_BARRIER(lambda_root.value);
   ls->slots[LAMBDA_SLOT_BYTE_CODE]    = ts->slots[TEMPLATE_SLOT_BYTE_CODE];
+  WRITE_BARRIER(lambda_root.value);
   ls->slots[LAMBDA_SLOT_TAIL_CALL]    = ts->slots[TEMPLATE_SLOT_TAIL_CALL];
+  WRITE_BARRIER(lambda_root.value);
   ls->slots[LAMBDA_SLOT_ARG_LIST]     = ts->slots[TEMPLATE_SLOT_ARG_LIST];
+  WRITE_BARRIER(lambda_root.value);
   ls->slots[LAMBDA_SLOT_CONTINUATION] = ts->slots[TEMPLATE_SLOT_CONTINUATION];
+  WRITE_BARRIER(lambda_root.value);
   ls->slots[LAMBDA_SLOT_CONTEXT]      = ts->slots[TEMPLATE_SLOT_CONTEXT];
+  WRITE_BARRIER(lambda_root.value);
 
   l_inst = _get_vector(ls->slots[LAMBDA_SLOT_INSTANCE_VARS]);
   t_inst = get_byte_string(ts->slots[TEMPLATE_SLOT_INSTANCE_VARS]);
@@ -256,6 +266,7 @@ static value_t make_lambda(interp_state_t *state, value_t templ)
   for (size_t i = 0; i < t_inst->size; ++i)
   {
     l_inst->elements[i] = get_input(state, t_inst->bytes[i]);
+    WRITE_BARRIER(object_value(l_inst));
   }
 
   unregister_gc_root(&templ_root);
@@ -487,9 +498,9 @@ static void run_statement(interp_state_t *state, uint8_t code, uint8_t in1, uint
 
   switch (code)
   {
-  case 0x40: get_box(ST1)->value = ST2; break;
+  case 0x40: get_box(ST1)->value = ST2; WRITE_BARRIER(ST1); break;
-  case 0x41: get_pair(ST1)->car = ST2; break;
+  case 0x41: get_pair(ST1)->car = ST2; WRITE_BARRIER(ST1); break;
-  case 0x42: get_pair(ST1)->cdr = ST2; break;
+  case 0x42: get_pair(ST1)->cdr = ST2; WRITE_BARRIER(ST1); break;
   case 0x60: vector_set(ST1, get_fixnum(ST2), ST3); break;
   case 0x61: byte_string_set(ST1, get_fixnum(ST2), (char)get_fixnum(ST3)); break;
   case 0x62: struct_set(ST1, get_fixnum(ST2), ST3); break;
@@ -553,6 +564,7 @@ static void set_output(const interp_state_t *state, fixnum_t var, value_t val)
   var -= 128;
   release_assert(var < state->nframe);
   vec->elements[var] = val;
+  WRITE_BARRIER(state->frame.value);
 }
 
 static void register_state(interp_state_t *state, value_t lambda, value_t argv)

reader.c

@@ -216,6 +216,7 @@ static void reverse_list(value_t *list, value_t newcdr)
   {
     value_t temp = _get_pair(lst)->cdr;
     _get_pair(lst)->cdr = newcdr;
+    WRITE_BARRIER(lst);
     newcdr = lst;
     lst = temp;
   }
@@ -633,6 +634,7 @@ static value_t read_vector(reader_state_t *state)
   for (size_t i = 0; i < length; ++i)
   {
     _get_vector(value)->elements[i] = _CAR(item);
+    /* No write barrier needed here. */
     item = _CDR(item);
   }
 
@@ -659,6 +661,7 @@ static value_t read_struct(reader_state_t *state)
   for (size_t i = 0; i < slots; ++i)
   {
     _get_struct(value)->slots[i] = _CAR(item);
+    /* No write barrier needed here. */
     item = _CDR(item);
   }
 
@@ -753,6 +756,7 @@ static void set_placeholder(reader_state_t *state, value_t place, value_t value)
   assert(is_placeholder(state, place));
   release_assert(is_undefined(_CADR(place)));
   _CADR(place) = value;
+  WRITE_BARRIER(_CDR(place));
 }
 
 static void finalize_placeholders(reader_state_t *state)
@@ -776,6 +780,7 @@ static void finalize_placeholders(reader_state_t *state)
       else if (is_placeholder(state, _CADR(item)))
       {
         _CADR(item) = _CADR(_CADR(item));
+        WRITE_BARRIER(_CDR(item));
         changed = true;
       }
     }
@@ -801,53 +806,66 @@ typedef struct seen_value
   struct seen_value *prev;
 } seen_value_t;
 
-static void _tree_replace(value_t *in, value_t oldval, value_t newval,
+static bool _tree_replace(value_t *in, value_t oldval, value_t newval,
                           seen_value_t *seen)
 {
   seen_value_t this_seen = { *in, seen };
+  bool updated = false;
 
   for (seen_value_t *item = seen; item; item = item->prev)
   {
     if (*in == item->value)
-      return;
+      return false;
   }
 
   if (*in == oldval)
   {
     *in = newval;
+    return true;
   }
   else if (is_box(*in))
   {
-    _tree_replace(&_get_box(*in)->value, oldval, newval, &this_seen);
+    updated = _tree_replace(&_get_box(*in)->value, oldval, newval, &this_seen);
   }
   else if (is_pair(*in))
   {
-    _tree_replace(&_get_pair(*in)->car, oldval, newval, &this_seen);
+    updated = _tree_replace(&_get_pair(*in)->car, oldval, newval, &this_seen);
-    _tree_replace(&_get_pair(*in)->cdr, oldval, newval, &this_seen);
+
+    if (_tree_replace(&_get_pair(*in)->cdr, oldval, newval, &this_seen))
+      updated = true;
   }
   else if (is_vector(*in))
   {
     for (size_t i = 0; i < _get_vector(*in)->size; ++i)
     {
-      _tree_replace(&_get_vector(*in)->elements[i], oldval, newval, &this_seen);
+      if (_tree_replace(&_get_vector(*in)->elements[i], oldval, newval, &this_seen))
+        updated = true;
     }
   }
   else if (is_struct(*in))
   {
-    _tree_replace(&_get_struct(*in)->type, oldval, newval, &this_seen);
+    updated = _tree_replace(&_get_struct(*in)->type, oldval, newval, &this_seen);
 
     for (size_t i = 0; i < _get_struct(*in)->nslots; ++i)
-      _tree_replace(&_get_struct(*in)->slots[i], oldval, newval, &this_seen);
+    {
+      if (_tree_replace(&_get_struct(*in)->slots[i], oldval, newval, &this_seen))
+        updated = true;
+    }
   }
   else if (is_weak_box(*in))
   {
-    _tree_replace(&_get_weak_box(*in)->value, oldval, newval, &this_seen);
+    updated = _tree_replace(&_get_weak_box(*in)->value, oldval, newval, &this_seen);
   }
+
+  if (updated)
+    WRITE_BARRIER(*in);
+
+  return false;
 }
 
 static void tree_replace(value_t *in, value_t oldval, value_t newval)
 {
-  _tree_replace(in, oldval, newval, NULL);
+  (void)_tree_replace(in, oldval, newval, NULL);
 }
 
 static void next_char(reader_state_t *state)

rosella.c

@@ -169,7 +169,8 @@ static void test_garbage_collection(bool keep_going)
         break;
       case 3:
         root.value = cons(root.value, cons(fixnum_value(-1), NIL));
-        get_pair(get_pair(root.value)->cdr)->cdr = root.value;
+        _CDDR(root.value) = root.value;
+        WRITE_BARRIER(_CDR(root.value));
         break;
       case 4:
       case 5: