gc: do finalizers completely on one phase.

* gc.c (call_finalizers_impl): Iterate over the finalizer
registrations until no more finalizers are identified,
performing additional rounds, as necessary. Thus if finalizers
register more finalizers that are eligible for processing
according to the criteria of he current phase, those are done
in the current phase.
(gc_finalize): We must now carefully set the reachable flag to
1 for a new finalization entry. This was always the right
thing to do and is logically correct: if an object is being
passed to finalize, it is necessarily reachable.  Leaving the
0 initialization would do bad things now, as follows. If any
object whatsoever has a finalizer registered against it during
GC-driven finalization, its finalizer will be called. This is
bad if the object isn't garbage.  Secondly, the object may be
moved into generation 0, and put into the freshobj list. This
is extremely bad if the object is reachable by generation 1
objects, which is now a wrong-way reference.

* txr.1: Updated.

1 files changed, 34 insertions, 31 deletions

diff --git a/gc.c b/gc.c
index 50b88be9..fc7ec675 100644
--- a/gc.c
+++ b/gc.c
@@ -757,47 +757,50 @@ NOINLINE static void prepare_finals(void)
 static val call_finalizers_impl(val ctx,
                                 int (*should_call)(struct fin_reg *, val))
 {
-  struct fin_reg *f, **tail;
-  struct fin_reg *found = 0, **ftail = &found;
   val ret = nil;
 
-  if (!final_list)
-    return ret;
+  for (;;) {
+    struct fin_reg *f, **tail;
+    struct fin_reg *found = 0, **ftail = &found;
 
-  for (f = final_list, tail = &final_list; f; ) {
-    struct fin_reg *next = f->next;
+    for (f = final_list, tail = &final_list; f; ) {
+      struct fin_reg *next = f->next;
 
-    if (should_call(f, ctx)) {
-      *ftail = f;
-      ftail = &f->next;
-      f->next = 0;
-    } else {
-      *tail = f;
-      tail = &f->next;
+      if (should_call(f, ctx)) {
+        *ftail = f;
+        ftail = &f->next;
+        f->next = 0;
+      } else {
+        *tail = f;
+        tail = &f->next;
+      }
+
+      f = next;
     }
 
-    f = next;
-  }
+    *tail = 0;
+    final_tail = tail;
 
-  *tail = 0;
-  final_tail = tail;
+    if (!found)
+      break;
 
-  while (found) {
-    struct fin_reg *next = found->next;
-    val obj = found->obj;
-    funcall1(found->fun, obj);
+    do {
+      struct fin_reg *next = found->next;
+      val obj = found->obj;
+      funcall1(found->fun, obj);
 #if CONFIG_GEN_GC
-    if (--obj->t.fincount == 0 && inprogress && obj->t.gen == 0) {
-      if (freshobj_idx < FRESHOBJ_VEC_SIZE) {
-        freshobj[freshobj_idx++] = obj;
-      } else {
-        full_gc = 1;
+      if (--obj->t.fincount == 0 && inprogress && obj->t.gen == 0) {
+        if (freshobj_idx < FRESHOBJ_VEC_SIZE) {
+          freshobj[freshobj_idx++] = obj;
+        } else {
+          full_gc = 1;
+        }
       }
-    }
 #endif
-    free(found);
-    found = next;
-    ret = t;
+      free(found);
+      found = next;
+      ret = t;
+    } while (found);
   }
 
   return ret;
@@ -990,7 +993,7 @@ val gc_finalize(val obj, val fun, val rev_order_p)
     struct fin_reg *f = coerce(struct fin_reg *, chk_malloc(sizeof *f));
     f->obj = obj;
     f->fun = fun;
-    f->reachable = 0;
+    f->reachable = 1;
 
 #if CONFIG_GEN_GC
     if (++obj->t.fincount == 0) {