call-finalizers: allow recursion.

Code to invoke finalizers and remove them from the
list is consolidated: both the gc and call-finalizers
now use the same lower-level function.

Finalizers may now themselves call-finalizers; it is no longer
"unspecified behavior". This greatly improves the the TXR Lisp
support for RAII, since :fini handlers of objects can call
finalization on related objects. For instance a container
being finalized can call the finalizers of contained objects.

* gc.c (call_finalizers_impl): New function. Gathers all
eligible finalizer registrations into a local list,
first, removing them from the global list. Then does the
calls in a second pass. Also, relative to the original
functions which it replaces, this fixes an incorrect case:
when the list is of length 1 and contains an eligible
entry, in which case the global final_tail pointer is left
aiming at a local variable!
(is_reachable_final): New static function.
(call_finalizers): Use call_finalizers_impl, specifying
is_reachable_final as the predicate.
(is_matching_final): New static function.
(gc_call_finalizers): Use call_finalizers_impl, specifying
is_matching_final as the predicate.

* txr.1: Update documentation about call-finalizers.

1 files changed, 41 insertions, 40 deletions

diff --git a/gc.c b/gc.c
index 4e7c9eb9..33afca91 100644
--- a/gc.c
+++ b/gc.c
@@ -650,32 +650,54 @@ static void prepare_finals(void)
   }
 }
 
-static void call_finals(void)
+static val call_finalizers_impl(val ctx,
+                                int (*should_call)(struct fin_reg *, val))
 {
-  struct fin_reg *new_list = 0, *old_list = final_list;
-  struct fin_reg **tail = &new_list, *f, *next;
+  struct fin_reg *f, **tail;
+  struct fin_reg *found = 0, **ftail = &found;
+  val ret = nil;
 
   if (!final_list)
-    return;
-
-  final_list = 0;
-  final_tail = &final_list;
+    return ret;
 
-  for (f = old_list; f; f = next) {
-    next = f->next;
+  for (f = final_list, tail = &final_list; f; ) {
+    struct fin_reg *next = f->next;
 
-    if (!f->reachable) {
-      funcall1(f->fun, f->obj);
-      free(f);
+    if (should_call(f, ctx)) {
+      *ftail = f;
+      ftail = &f->next;
+      f->next = 0;
     } else {
       *tail = f;
       tail = &f->next;
     }
+
+    f = next;
   }
 
   *tail = 0;
-  *final_tail = new_list;
   final_tail = tail;
+
+  while (found) {
+    struct fin_reg *next = found->next;
+    funcall1(found->fun, found->obj);
+    free(found);
+    found = next;
+    ret = t;
+  }
+
+  return ret;
+}
+
+static int is_unreachable_final(struct fin_reg *f, val ctx)
+{
+  (void) ctx;
+  return !f->reachable;
+}
+
+static void call_finals(void)
+{
+  (void) call_finalizers_impl(nil, is_unreachable_final);
 }
 
 void gc(void)
@@ -868,35 +890,14 @@ val gc_finalize(val obj, val fun, val rev_order_p)
   return obj;
 }
 
-val gc_call_finalizers(val obj)
+static int is_matching_final(struct fin_reg *f, val obj)
 {
-  struct fin_reg *new_list = 0, *old_list = final_list;
-  struct fin_reg **tail = &new_list, *f, *next;
-  val ret = nil;
-
-  if (!final_list)
-    return ret;
-
-  final_list = 0;
-  final_tail = &final_list;
-
-  for (f = old_list; f; f = next) {
-    next = f->next;
-
-    if (f->obj == obj) {
-      funcall1(f->fun, f->obj);
-      free(f);
-      ret = t;
-    } else {
-      *tail = f;
-      tail = &f->next;
-    }
-  }
+  return f->obj == obj;
+}
 
-  *tail = 0;
-  *final_tail = new_list;
-  final_tail = tail;
-  return ret;
+val gc_call_finalizers(val obj)
+{
+  return call_finalizers_impl(obj, is_matching_final);
 }
 
 void gc_late_init(void)