gc: eliminate most uses of gc_mutated.

The code is using gc_mutated in situations that resemble
assignment: a value is stored into a slot in some object.
These situations should be handled using the same logic as
embodied in the gc_set function. This is because gc_set will
consider both objects, and in many cases will not have to do
anything special. E.g. if an immature object is stored into
another immature object, or mature into immature, or mature
into mature. Whereas gc_mutated is a "just in case" function
which forces the garbage collector to traverse the indicated
object, if that object is mature.

In this patch we refactor gc_set to expose its underlying
logic with a somewhat more flexible function called
gc_assign_check. We put that behind a conditionally defined
macro called setcheck, and then use that to replace
invocations of the mut macro in various places.

The only uses of gc_mutated that remain are in the bulk
vector assignment and copy_struct: operations in which
potentially many element values are migrated from one
aggregate object to another, making it potentially expensive
to do individual assignment checks.

* gc.c (gc_assign_check): New function, formed from guts of
gc_set.
(gc_set): Now a trivial function, implemented via call to
gc_assign_check.

* gc.h (gc_assign_check): Declared.

* lib.c (cons): Use setcheck instead of gc_mutated, since we
are storing only two values into the existing cons: the car
and the cdr.

* struct.c (clear_struct): Use setcheck instead of gc_mutated,
since we are just storing one value into the structure, the
clear_val. The fact that we are storing it into multiple slots
is irrelevant.

* vm.c (vm_make_closure): Use setcheck instead of mut, using
the new heap_vector as the child object with regard to the
closure. Rationale: the only threat here is that when we
allocate the heap vector, a GC is triggered which pushes the
closure into the mature generation. Then the store of the heap
vector into the closure is a wrong-way reference, with regard
to generational GC. The elements in the vector are immaterial;
they are older than both the closure and the vector, therefore
their relationship to either object is a right-way reference.
(vm_set, vm_sm_set): Replace mut by a setcheck between the
vector from the display and the new value being stored in it.
(vm_stab): Replace the gc_mutated check, which should have
been a mut macro call, with a setcheck between the vm, and the
binding being stored into the table.  The gc_mutated should
have been wrapped with an #if CONFIG_GEN_GC so we are fixing
a build bug here: the code would have prevented TXR from being
built with the generational GC disabled.

6 files changed, 20 insertions, 17 deletions

diff --git a/gc.c b/gc.c
index 18c65915..15384794 100644
--- a/gc.c
+++ b/gc.c
@@ -820,25 +820,27 @@ int gc_is_reachable(val obj)
 
 #if CONFIG_GEN_GC
 
-val gc_set(loc lo, val obj)
+void gc_assign_check(val p, val c)
 {
-  val *ptr = valptr(lo);
-
-  if (lo.obj && is_ptr(obj) && lo.obj->t.gen == 1 && obj->t.gen == 0 && !full_gc) {
+  if (p && is_ptr(c) && p->t.gen == 1 && c->t.gen == 0 && !full_gc) {
     if (checkobj_idx < CHECKOBJ_VEC_SIZE) {
-      obj->t.gen = -1;
-      checkobj[checkobj_idx++] = obj;
+      c->t.gen = -1;
+      checkobj[checkobj_idx++] = c;
     } else if (gc_enabled) {
       gc();
-      /* obj can't be in gen 0 because there are no baby objects after gc */
+      /* c can't be in gen 0 because there are no baby objects after gc */
     } else {
       /* We have no space to in checkobj record this backreference, and gc is
          not available to promote obj to gen 1. We must schedule a full gc. */
       full_gc = 1;
     }
   }
+}
 
-  *ptr = obj;
+val gc_set(loc lo, val obj)
+{
+  gc_assign_check(lo.obj, obj);
+  *valptr(lo) = obj;
   return obj;
 }
 
@@ -862,7 +864,6 @@ val gc_mutated(val obj)
   return obj;
 }
 
-
 val gc_push(val obj, loc plist)
 {
   return gc_set(plist, cons(obj, deref(plist)));
diff --git a/gc.h b/gc.h
index 4c3bc042..7025fa59 100644
--- a/gc.h
+++ b/gc.h
@@ -43,6 +43,7 @@ val gc_call_finalizers(val obj);
 #if CONFIG_GEN_GC
 val gc_set(loc, val);
 val gc_push(val, loc);
+void gc_assign_check(val p, val c);
 val gc_mutated(val);
 extern int full_gc;
 #endif
diff --git a/lib.c b/lib.c
index 761646ff..52320dfe 100644
--- a/lib.c
+++ b/lib.c
@@ -2857,9 +2857,8 @@ val cons(val car, val cdr)
   if (recycled_conses) {
     obj = recycled_conses;
     recycled_conses = recycled_conses->c.cdr;
-#if CONFIG_GEN_GC
-    gc_mutated(obj);
-#endif
+    setcheck(obj, car);
+    setcheck(obj, cdr);
   } else {
     obj = make_obj();
     obj->c.type = CONS;
diff --git a/lib.h b/lib.h
index 718e2c86..ff432bea 100644
--- a/lib.h
+++ b/lib.h
@@ -337,6 +337,7 @@ INLINE loc mkloc_fun(val *ptr, val obj)
 #define deref(lo) (*(lo).ptr)
 #define valptr(lo) ((lo).ptr)
 #define set(lo, val) (gc_set(lo, val))
+#define setcheck(tgt, src) (gc_assign_check(tgt, src))
 #define mut(obj) (gc_mutated(obj));
 #define mpush(val, lo) (gc_push(val, lo))
 #else
@@ -348,6 +349,7 @@ typedef val *loc;
 #define deref(lo) (*(lo))
 #define valptr(lo) (lo)
 #define set(lo, val) (*(lo) = (val))
+#define setcheck(tgt, src) ((void) 0)
 #define mut(obj) ((void) (obj))
 #define mpush(val, lo) (push(val, lo))
 #endif
diff --git a/struct.c b/struct.c
index 2acc0b65..94f53b6b 100644
--- a/struct.c
+++ b/struct.c
@@ -697,7 +697,7 @@ val clear_struct(val strct, val value)
   for (i = 0; i < st->nslots; i++)
     si->slot[i] = clear_val;
 
-  mut(strct);
+  setcheck(strct, clear_val);
 
   return strct;
 }
diff --git a/vm.c b/vm.c
index 26d73304..774124a4 100644
--- a/vm.c
+++ b/vm.c
@@ -271,7 +271,7 @@ static val vm_make_closure(struct vm *vm, int frsz)
         cdi->mem = heap_vec->v.vec;
         memcpy(cdi->mem, mem, size);
         memset(mem, 0, size);
-        mut(closure);
+        setcheck(closure, heap_vec);
         *sdi = *cdi;
         break;
       }
@@ -357,7 +357,7 @@ INLINE void vm_set(struct vm_env *dspl, unsigned ref, val newval)
   env->mem[i] = newval;
 
   if (is_ptr(env->vec))
-    mut(env->vec);
+    setcheck(env->vec, newval);
 }
 
 INLINE void vm_sm_set(struct vm_env *dspl, unsigned ref, val newval)
@@ -372,7 +372,7 @@ INLINE void vm_sm_set(struct vm_env *dspl, unsigned ref, val newval)
   env->mem[i] = newval;
 
   if (is_ptr(env->vec))
-    mut(env->vec);
+    setcheck(env->vec, newval);
 }
 
 
@@ -505,7 +505,7 @@ static loc vm_stab(struct vm *vm, unsigned fun,
     eval_error(vd->bytecode,
                lit("~a ~s is not defined"), kind_str,
                vecref(vd->symvec, num(fun)), nao);
-  gc_mutated(vd->self);
+  setcheck(vd->self, fe->bind);
   return (fe->bindloc = cdr_l(fe->bind));
 }