Support for reverse order in finalization.

A new optional argument on finalize allows it to
be expressed that multiple finalizers on the same
object are to be called in reverse order, which is
potentially for objects with inheritance.

* gc.c (gc_finalize): New optional argument, rev_order_p.
Insert at the head of the list if this argument is
specified and true.
(gc_late_init): Register finalize as three-argument
function with optional argument.

* gc.h (gc_finalize): Declaration updated.

* share/txr/stdlib/struct.tl (defstruct): Register :fini
functions in reverse, so that derived finalizers
are called before supertype finalizers.

* txr.1: Documented new finalize argument, and
behavior of :fini.

5 files changed, 45 insertions, 26 deletions

diff --git a/gc.c b/gc.c
index 9128e9d9..4ead33b7 100644
--- a/gc.c
+++ b/gc.c
@@ -808,18 +808,28 @@ static val gc_wrap(void)
   return nil;
 }
 
-val gc_finalize(val obj, val fun)
+val gc_finalize(val obj, val fun, val rev_order_p)
 {
   type_check(fun, FUN);
 
+  rev_order_p = default_bool_arg(rev_order_p);
+
   if (is_ptr(obj)) {
     struct fin_reg *f = coerce(struct fin_reg *, chk_malloc(sizeof *f));
     f->obj = obj;
     f->fun = fun;
     f->reachable = 0;
-    f->next = 0;
-    *final_tail = f;
-    final_tail = &f->next;
+
+    if (rev_order_p) {
+      if (!final_list)
+        final_tail = &f->next;
+      f->next = final_list;
+      final_list = f;
+    } else {
+      f->next = 0;
+      *final_tail = f;
+      final_tail = &f->next;
+    }
   }
   return obj;
 }
@@ -828,7 +838,7 @@ void gc_late_init(void)
 {
   reg_fun(intern(lit("gc"), system_package), func_n0(gc_wrap));
   reg_fun(intern(lit("gc-set-delta"), system_package), func_n1(gc_set_delta));
-  reg_fun(intern(lit("finalize"), user_package), func_n2(gc_finalize));
+  reg_fun(intern(lit("finalize"), user_package), func_n3o(gc_finalize, 2));
 }
 
 /*
diff --git a/gc.h b/gc.h
index 67e0867f..d7b00a69 100644
--- a/gc.h
+++ b/gc.h
@@ -35,7 +35,7 @@ int gc_state(int);
 void gc_mark(val);
 void gc_conservative_mark(val);
 int gc_is_reachable(val);
-val gc_finalize(val obj, val fun);
+val gc_finalize(val obj, val fun, val rev_order_p);
 
 #if CONFIG_GEN_GC
 val gc_set(loc, val);
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index c8eadc8b..24bccbe5 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -117,7 +117,8 @@
                           ,*(cdr instance-init-form))))
                   ,*(if (cdr instance-fini-form)
                       ^((finalize ,arg-sym (lambda (,(car instance-fini-form))
-                                             ,*(cdr instance-fini-form)))))))
+                                             ,*(cdr instance-fini-form))
+                                  t)))))
            ,(if args
               (let ((gens (mapcar (ret (gensym)) args)))
                 ^(lambda (,arg-sym ,*gens)
diff --git a/struct.c b/struct.c
index 214cdf56..c520f493 100644
--- a/struct.c
+++ b/struct.c
@@ -205,7 +205,7 @@ val make_struct_type(val name, val super,
     st->initfun = initfun;
     st->boactor = boactor;
 
-    gc_finalize(stype, struct_type_finalize_f);
+    gc_finalize(stype, struct_type_finalize_f, nil);
 
     for (sl = 0, stsl = STATIC_SLOT_BASE, iter = all_slots;
          iter;
diff --git a/txr.1 b/txr.1
index daff899d..1596ab73 100644
--- a/txr.1
+++ b/txr.1
@@ -17887,12 +17887,16 @@ the
 code, if any, has been executed. The registration
 takes place as if by the evaluation of the form
 .cblk
-.meti (finalize << obj (lambda <> (param) << body-form ...))
+.meti (finalize << obj (lambda <> (param) << body-form ...) t)
 .cble
 where
 .meta obj
-denotes the structure instance.
-
+denotes the structure instance. Note the
+.code t
+argument which requests reverse order of registration, ensuring that if an
+object has multiple finalizers registered at different levels of inheritance
+hierarchy, the finalizers specified for a derived structure type are called
+before inherited finalizers.
 .RE
 .PP
 
@@ -33608,7 +33612,7 @@ special builds of \*(TX for small systems.
 
 .coNP Function @ finalize
 .synb
-.mets (finalize < object << function )
+.mets (finalize < object < function <> [ reverse-order-p ])
 .syne
 .desc
 The
@@ -33626,21 +33630,26 @@ will be called with
 .meta object
 as its only argument.
 
-Finalizers are called in the same order in which they are registered:
-newer registrations are called after older registrations.
+Multiple finalizer functions can be registered for the same object.
+They are all called when the object becomes unreachable.
+
+If the
+.meta reverse-order-p
+argument isn't specified, or is
+.codn nil ,
+then finalizer is registered at the end of the list.
 
 If
-.meta object
-is registered multiple times by multiple calls to
-.codn finalize ,
-then if those finalizers are called, they are all called, in the order
-of registration.
+.meta reverse-order-p
+is true, then the finalizer is registered at the front of
+the list.
 
-After a finalization call takes place, its registration is removed;
-.meta object
-and
-.meta function
-are no longer associated.  However, neither
+Finalizers which are activated in the same finalization processing phase
+are called in the order in which they appear in the
+registration list.
+
+After a finalization call takes place, its registration is removed.  However,
+neither
 .meta object
 nor
 .meta function
@@ -33652,8 +33661,7 @@ to store somewhere a persistent reference to
 .meta object
 or to itself, thereby reinstating these objects as reachable.
 
-.meta function
-is itself permitted to call
+A finalizer is itself permitted to call
 .code finalize
 to register the original
 .code object