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.

5 files changed, 59 insertions, 30 deletions

diff --git a/ChangeLog b/ChangeLog
index 8ef53851..e063d450 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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.
diff --git a/eval.c b/eval.c
index b79b88f1..ff348b8d 100644
--- a/eval.c
+++ b/eval.c
@@ -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));
diff --git a/hash.c b/hash.c
index 78052119..510339b8 100644
--- a/hash.c
+++ b/hash.c
@@ -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);
 }
diff --git a/lib.c b/lib.c
index 186a4a8c..6703c024 100644
--- a/lib.c
+++ b/lib.c
@@ -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);
diff --git a/lib.h b/lib.h
index 8f4fae65..3e2db2a4 100644
--- a/lib.h
+++ b/lib.h
@@ -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; }