diff --git a/builtin.c b/builtin.c index 20091f8..13770b5 100644 --- a/builtin.c +++ b/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. */ diff --git a/gc.h b/gc.h index f8e0fa2..87750f1 100644 --- a/gc.h +++ b/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; diff --git a/interp.c b/interp.c index cbe3978..747e75d 100644 --- a/interp.c +++ b/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 0x41: get_pair(ST1)->car = ST2; break; - case 0x42: get_pair(ST1)->cdr = ST2; break; + case 0x40: get_box(ST1)->value = ST2; WRITE_BARRIER(ST1); break; + case 0x41: get_pair(ST1)->car = ST2; WRITE_BARRIER(ST1); 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) diff --git a/reader.c b/reader.c index ab6c560..8a5e8b3 100644 --- a/reader.c +++ b/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); - _tree_replace(&_get_pair(*in)->cdr, oldval, newval, &this_seen); + updated = _tree_replace(&_get_pair(*in)->car, 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) diff --git a/rosella.c b/rosella.c index 02c4463..e42296b 100644 --- a/rosella.c +++ b/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: