diff options
| -rw-r--r-- | ChangeLog | 26 | ||||
| -rw-r--r-- | eval.c | 10 | ||||
| -rw-r--r-- | hash.c | 6 | ||||
| -rw-r--r-- | lib.c | 44 | ||||
| -rw-r--r-- | lib.h | 3 |
5 files changed, 59 insertions, 30 deletions
@@ -1,3 +1,29 @@ +2012-04-01 Kaz Kylheku <kaz@kylheku.com> + + Start of ground-work for ephemeral GC. We must add some abstraction + to places where we potentially assign a reference to a younger object + inside a field located in an older object (chronological + backreference) and also where we take the address of an object + field, making it possible that the user of the address will do so. + + This patch does not take care of vectors. + + No, this is not an April Fool's joke. + + * eval.c (env_fbind, env_vbind, env_replace_vbind, lookup_var, + lookup_sym_lisp1): Use set macro instead of assignment. + + * hash.c (hash_grow, set_hash_userdata, hash_next): + Use set macro instead of assignment. + + * lib.c (rplaca, rplacd, string_extend, length_str, replace_str, + rehome_sym, lazy_stream_func, lazy_str, lazy_str_force, + lazy_str_force_upto, obj_init): Use set macro instead of assignment. + + (car_l, cdr_l): Use loc instead of address-of operator. + + * lib.h (set, loc): New macros. + 2012-03-31 Kaz Kylheku <kaz@kylheku.com> * hash.c (last_equal_key, last_equal_hash): New static variables. @@ -82,21 +82,21 @@ val make_env(val vbindings, val fbindings, val up_env) val env_fbind(val env, val sym, val fun) { type_check(env, ENV); - env->e.fbindings = acons_new(sym, fun, env->e.fbindings); + set(env->e.fbindings, acons_new(sym, fun, env->e.fbindings)); return sym; } val env_vbind(val env, val sym, val obj) { type_check(env, ENV); - env->e.vbindings = acons_new(sym, obj, env->e.vbindings); + set(env->e.vbindings, acons_new(sym, obj, env->e.vbindings)); return sym; } static void env_replace_vbind(val env, val bindings) { type_check(env, ENV); - env->e.vbindings = bindings; + set(env->e.vbindings, bindings); } noreturn static val eval_error(val form, val fmt, ...) @@ -120,7 +120,7 @@ val lookup_var(val env, val sym) val bind = gethash(top_vb, sym); if (cobjp(bind)) { struct c_var *cv = (struct c_var *) cptr_get(bind); - cv->bind->c.cdr = *cv->loc; + set(cv->bind->c.cdr, *cv->loc); return cv->bind; } return bind; @@ -183,7 +183,7 @@ static val lookup_sym_lisp1(val env, val sym) val bind = gethash(top_vb, sym); if (cobjp(bind)) { struct c_var *cv = (struct c_var *) cptr_get(bind); - cv->bind->c.cdr = *cv->loc; + set(cv->bind->c.cdr, *cv->loc); return cv->bind; } return or2(bind, gethash(top_fb, sym)); @@ -346,7 +346,7 @@ static void hash_grow(struct hash *h) } h->modulus = new_modulus; - h->table = new_table; + set(h->table, new_table); } val make_hash(val weak_keys, val weak_vals, val equal_based) @@ -451,7 +451,7 @@ val set_hash_userdata(val hash, val data) { struct hash *h = (struct hash *) cobj_handle(hash, hash_s); val olddata = h->userdata; - h->userdata = data; + set(h->userdata, data); return olddata; } @@ -502,7 +502,7 @@ val hash_next(val *iter) *iter = nil; return nil; } - hi->cons = vecref(h->table, num(hi->chain)); + set(hi->cons, vecref(h->table, num(hi->chain))); } return car(hi->cons); } @@ -224,9 +224,9 @@ val rplaca(val cons, val new_car) { switch (type(cons)) { case CONS: - return cons->c.car = new_car; + return set(cons->c.car, new_car); case LCONS: - return cons->lc.car = new_car; + return set(cons->lc.car, new_car); default: type_mismatch(lit("~s is not a cons"), cons, nao); } @@ -237,9 +237,9 @@ val rplacd(val cons, val new_cdr) { switch (type(cons)) { case CONS: - return cons->c.cdr = new_cdr; + return set(cons->c.cdr, new_cdr); case LCONS: - return cons->lc.cdr = new_cdr; + return set(cons->lc.cdr, new_cdr); default: type_mismatch(lit("~s is not a cons"), cons, nao); } @@ -249,13 +249,13 @@ val *car_l(val cons) { switch (type(cons)) { case CONS: - return &cons->c.car; + return loc(cons->c.car); case LCONS: if (cons->lc.func) { funcall1(cons->lc.func, cons); cons->lc.func = nil; } - return &cons->lc.car; + return loc(cons->lc.car); default: type_mismatch(lit("~s is not a cons"), cons, nao); } @@ -265,13 +265,13 @@ val *cdr_l(val cons) { switch (type(cons)) { case CONS: - return &cons->c.cdr; + return loc(cons->c.cdr); case LCONS: if (cons->lc.func) { funcall1(cons->lc.func, cons); cons->lc.func = nil; } - return &cons->lc.cdr; + return loc(cons->lc.cdr); default: type_mismatch(lit("~s is not a cons"), cons, nao); } @@ -1431,8 +1431,8 @@ val string_extend(val str, val tail) str->st.str = (wchar_t *) chk_realloc((mem_t *) str->st.str, alloc * sizeof *str->st.str); - str->st.alloc = num(alloc); - str->st.len = plus(str->st.len, needed); + set(str->st.alloc, num(alloc)); + set(str->st.len, plus(str->st.len, needed)); if (stringp(tail)) { wmemcpy(str->st.str + len, c_str(tail), c_num(needed) + 1); @@ -1475,8 +1475,8 @@ val length_str(val str) } if (!str->st.len) { - str->st.len = num(wcslen(str->st.str)); - str->st.alloc = plus(str->st.len, one); + set(str->st.len, num(wcslen(str->st.str))); + set(str->st.alloc, plus(str->st.len, one)); } return str->st.len; } @@ -1741,7 +1741,7 @@ val replace_str(val str_in, val items, val from, val to) wmemmove(str_in->st.str + t - c_num(len_diff), str_in->st.str + t, (l - t) + 1); - str_in->st.len = minus(len, len_diff); + set(str_in->st.len, minus(len, len_diff)); to = plus(from, len_it); } else if (lt(len_rep, len_it)) { val len_diff = minus(len_it, len_rep); @@ -2262,7 +2262,7 @@ static val rehome_sym(val sym, val package) if (sym->s.package) remhash(sym->s.package->pk.symhash, symbol_name(sym)); - sym->s.package = package; + set(sym->s.package, package); sethash(package->pk.symhash, symbol_name(sym), sym); return sym; } @@ -3316,8 +3316,8 @@ static val lazy_stream_func(val env, val lcons) val next = cdr(env) ? pop(cdr_l(env)) : get_line(stream); val ahead = get_line(stream); - lcons->lc.car = next; - lcons->lc.cdr = if2(ahead, make_lazy_cons(lcons->lc.func)); + set(lcons->lc.car, next); + set(lcons->lc.cdr, if2(ahead, make_lazy_cons(lcons->lc.func))); lcons->lc.func = nil; if (!next || !ahead) @@ -3357,12 +3357,12 @@ val lazy_str(val lst, val term, val limit) obj->ls.prefix = null_string; obj->ls.list = nil; } else { - obj->ls.prefix = cat_str(list(first(lst), term, nao), nil); - obj->ls.list = rest(lst); + set(obj->ls.prefix, cat_str(list(first(lst), term, nao), nil)); + set(obj->ls.list, rest(lst)); limit = if2(limit, minus(limit, one)); } - obj->ls.opts = cons(term, limit); + set(obj->ls.opts, cons(term, limit)); return obj; } @@ -3376,7 +3376,7 @@ val lazy_str_force(val lstr) while ((!lim || gt(lim, zero)) && lstr->ls.list) { val next = pop(&lstr->ls.list); val term = car(lstr->ls.opts); - lstr->ls.prefix = cat_str(list(lstr->ls.prefix, next, term, nao), nil); + set(lstr->ls.prefix, cat_str(list(lstr->ls.prefix, next, term, nao), nil)); if (lim) lim = minus(lim, one); } @@ -3399,7 +3399,7 @@ val lazy_str_force_upto(val lstr, val index) { val next = pop(&lstr->ls.list); val term = car(lstr->ls.opts); - lstr->ls.prefix = cat_str(list(lstr->ls.prefix, next, term, nao), nil); + set(lstr->ls.prefix, cat_str(list(lstr->ls.prefix, next, term, nao), nil)); if (lim) lim = minus(lim, one); } @@ -4048,7 +4048,7 @@ static void obj_init(void) /* t can't be interned, because gethash_l needs t in order to do its job. */ t = *gethash_l(user_package->pk.symhash, lit("t"), 0) = make_sym(lit("t")); - t->s.package = user_package; + set(t->s.package, user_package); null = intern(lit("null"), user_package); cons_s = intern(lit("cons"), user_package); @@ -217,6 +217,9 @@ union obj { struct flonum fl; }; +#define set(place, val) ((place) = (val)) +#define loc(place) (&(place)) + INLINE cnum tag(val obj) { return ((cnum) obj) & TAG_MASK; } INLINE int is_ptr(val obj) { return obj && tag(obj) == TAG_PTR; } INLINE int is_num(val obj) { return tag(obj) == TAG_NUM; } |