4 files changed, 28 insertions, 20 deletions

diff --git a/gc.c b/gc.c
index 493da5f0..50b88be9 100644
--- a/gc.c
+++ b/gc.c
@@ -220,6 +220,7 @@ val make_obj(void)
 #endif
 #if CONFIG_GEN_GC
       ret->t.gen = 0;
+      ret->t.fincount = 0;
       if (!full_gc)
         freshobj[freshobj_idx++] = ret;
 #endif
@@ -783,24 +784,14 @@ static val call_finalizers_impl(val ctx,
 
   while (found) {
     struct fin_reg *next = found->next;
-    int dup, i, freshobj_idx_start = freshobj_idx;
     val obj = found->obj;
     funcall1(found->fun, obj);
 #if CONFIG_GEN_GC
-    if (inprogress && obj->t.gen == 0) {
-      for (dup = 0, i = freshobj_idx_start; i < freshobj_idx; i++) {
-        if (freshobj[i] == obj) {
-          dup = 1;
-          break;
-        }
-      }
-
-      if (!dup) {
-        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
@@ -990,7 +981,8 @@ static val gc_wrap(val full)
 
 val gc_finalize(val obj, val fun, val rev_order_p)
 {
-  type_check(lit("gc-finalize"), fun, FUN);
+  val self = lit("gc-finalize");
+  type_check(self, fun, FUN);
 
   rev_order_p = default_null_arg(rev_order_p);
 
@@ -1000,6 +992,16 @@ val gc_finalize(val obj, val fun, val rev_order_p)
     f->fun = fun;
     f->reachable = 0;
 
+#if CONFIG_GEN_GC
+    if (++obj->t.fincount == 0) {
+      obj->t.fincount--;
+      free(f);
+      uw_throwf(error_s,
+                lit("~a: too many finalizations registered against object ~s"),
+                self, obj, nao);
+    }
+#endif
+
     if (rev_order_p) {
       if (!final_list)
         final_tail = &f->next;
diff --git a/lib.h b/lib.h
index c1951a88..f6cc8975 100644
--- a/lib.h
+++ b/lib.h
@@ -94,7 +94,8 @@ typedef unsigned char mem_t;
 #if CONFIG_GEN_GC
 #define obj_common \
   type_t type : PTR_BIT/2; \
-  int gen : PTR_BIT/2
+  unsigned fincount : PTR_BIT/4; \
+  int gen : PTR_BIT/4;
 #else
 #define obj_common \
   type_t type
diff --git a/tree.c b/tree.c
index fb74f143..db074654 100644
--- a/tree.c
+++ b/tree.c
@@ -237,7 +237,7 @@ static val tn_build_tree(ucnum n, val x)
 static void tr_rebuild(struct tree *tr, val node, val parent, ucnum size)
 {
 #if CONFIG_GEN_GC
-  obj_t dummy = { { TNOD, 0, { 0 }, 0 } };
+  obj_t dummy = { { TNOD, 0, 0, { 0 }, 0 } };
 #else
   obj_t dummy = { { TNOD, { 0 }, 0 } };
 #endif
diff --git a/txr.1 b/txr.1
index 98612ad7..c28ea95c 100644
--- a/txr.1
+++ b/txr.1
@@ -66770,8 +66770,13 @@ will be called with
 .meta object
 as its only argument.
 
-Multiple finalizer functions can be registered for the same object.
-They are all called when the object becomes unreachable.
+Multiple finalizer functions can be registered for the same object,
+up to an internal limit which is not required to be greater than 255.
+If the limit is exceeded,
+.code finalize
+throws an error exception.
+
+All registered finalizers are called when the object becomes unreachable.
 Finalizers registered against an object may also be invoked
 and removed using the
 .code call-finalizers