From 7b508930b78766c14932847512824282aae59ec0 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 31 Dec 2020 06:53:02 -0800
Subject: gc: add finalization count to objects.

With the finalization count, we don't have to scan the
freshobj array for duplicates when calling finalizers.
However, the limited range of the counter limits how many
times we can register a finalizer against an object.

* gc.c (make_obj): Reset the new fincount field to zero
for a newly minted object.
(call_finalizers_impl): Decrement the fincount for
each object. Only run the freshobj-related logic when
the count hits zero.
(gc_finalize): Bump the fincount of a registered object. If
the counter overflows, throw an exception.

* lib.h (obj_common): Add new field fincount for the
finalization count.

* tree.c (tr_rebuild): Fix up dummy object initializer
to accommodate the new member.

* txr.1: Document that there is a limit on the number
of times an object can be registered for finalization.
---
 gc.c   | 34 ++++++++++++++++++----------------
 lib.h  |  3 ++-
 tree.c |  2 +-
 txr.1  |  9 +++++++--
 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
-- 
cgit v1.2.3