2 files changed, 76 insertions, 41 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)
diff --git a/txr.1 b/txr.1
index ec45060f..18816b61 100644
--- a/txr.1
+++ b/txr.1
@@ -51335,8 +51335,42 @@ If any finalizers are called, it returns
 otherwise
 .codn nil .
 
-Note: the behavior is unspecified if a finalizer function calls
+It is permissible for a finalizer function itself to call
 .codn call-finalizers .
+Such a call can happen in two possible contexts: during actual
+reclamation driven by garbage collection, or under the scope of a
+.code call-finalizers
+invocation from application code.
+
+Under the scope of garbage-collection-driven reclamation, the
+order of finalizer calls may not be what the application logic
+expects. For instance even though a finalizer registered for some object
+.code A
+itself invokes
+.codn "(call-finalizers B)" ,
+it may be the case during GC reclamation that both
+.code A
+and
+.code B
+are identified as unreachable objects at the same time, and some or all
+finalizers registered against
+.code B
+have already been called before the given
+.code A
+finalizer performs the explicit
+.code call-finalizers
+invocation against
+.codn B .
+Thus the the call either has no effect at all, or only calls some remaining
+.code B
+finalizers that have not yet been processed, rather than all of them,
+as the application expects.
+
+The application must avoid creating a dependency on the order of
+finalization calls, to prevent the situation that the finalization actions are
+only correct under an explicit
+.code call-finalizers
+but incorrect under spontaneous reclamation driven by garbage collection.
 
 .SS* Modularization
 .coNP Variable @ self-path