From 6d865f2acdf5f93f06ddd0f4d3ac3a450d36dcd7 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 2 Sep 2015 07:32:43 -0700
Subject: Fix incorrect finalization of struct-type.

The issue is that we can't call remhash in the cobj destroy
handler, because we are in the middle of gc. The fix is to
register a proper finalization hook. This is the first use of
finalize from within TXR.

* gc.c (gc_finalize): static becomes extern.

* gc.h (gc_finalize): Declared.

* struct.c (struct_type_finalize_f): New static variable.
(struct_init): GC-protect new static variable, and initialize
it to point to new struct_type_finalize function.
(struct_type_finalize): New function: performs the remhash
calls previously done in struct_type_free.
(make_struct_type): Register a finalizer hook for every new
structure type, which will call struct_type_finalize.
(struct_type_free): Static function removed.
(struct_type_ops): Use generic cobj_destroy_free_op since
all that is left to do is to free the handle.
---
 struct.c | 34 ++++++++++++++++++++--------------
 1 file changed, 20 insertions(+), 14 deletions(-)

(limited to 'struct.c')

diff --git a/struct.c b/struct.c
index 0dc0dc1e..b1920d97 100644
--- a/struct.c
+++ b/struct.c
@@ -70,16 +70,20 @@ val struct_type_s;
 static cnum struct_id_counter;
 static val struct_type_hash;
 static val slot_hash;
+static val struct_type_finalize_f;
 
+static val struct_type_finalize(val obj);
 static struct cobj_ops struct_type_ops;
 static struct cobj_ops struct_inst_ops;
 
 void struct_init(void)
 {
-  protect(&struct_type_hash, &slot_hash, convert(val *, 0));
+  protect(&struct_type_hash, &slot_hash, &struct_type_finalize_f,
+          convert(val *, 0));
   struct_type_s = intern(lit("struct-type"), user_package);
   struct_type_hash = make_hash(nil, nil, nil);
   slot_hash = make_hash(nil, nil, t);
+  struct_type_finalize_f = func_n1(struct_type_finalize);
   reg_fun(intern(lit("make-struct-type"), user_package),
           func_n5(make_struct_type));
   reg_fun(intern(lit("find-struct-type"), user_package),
@@ -101,6 +105,18 @@ static noreturn void no_such_struct(val ctx, val sym)
             ctx, sym, nao);
 }
 
+static val struct_type_finalize(val obj)
+{
+  struct struct_type *st = coerce(struct struct_type *, obj->co.handle);
+  val id = num(st->id);
+  val slot;
+
+  for (slot = st->slots; slot; slot = cdr(slot))
+    remhash(slot_hash, cons(car(slot), id));
+
+  return nil;
+}
+
 val make_struct_type(val name, val super, val slots, val initfun, val boactor)
 {
   val self = lit("make-struct-type");
@@ -152,6 +168,8 @@ val make_struct_type(val name, val super, val slots, val initfun, val boactor)
     for (sl = 0, slot = all_slots; slot; sl++, slot = cdr(slot))
       sethash(slot_hash, cons(car(slot), id), num_fast(sl));
 
+    gc_finalize(stype, struct_type_finalize_f);
+
     return stype;
   }
 }
@@ -186,18 +204,6 @@ static void struct_type_print(val obj, val out, val pretty)
   format(out, lit("#<struct-type ~s>"), st->name, nao);
 }
 
-static void struct_type_free(val obj)
-{
-  struct struct_type *st = coerce(struct struct_type *, obj->co.handle);
-  val id = num(st->id);
-  val slot;
-
-  for (slot = st->slots; slot; slot = cdr(slot))
-    remhash(slot_hash, cons(car(slot), id));
-
-  free(st);
-}
-
 static void struct_type_mark(val obj)
 {
   struct struct_type *st = coerce(struct struct_type *, obj->co.handle);
@@ -514,7 +520,7 @@ static cnum struct_inst_hash(val obj)
 static struct cobj_ops struct_type_ops = {
   eq,
   struct_type_print,
-  struct_type_free,
+  cobj_destroy_free_op,
   struct_type_mark,
   cobj_hash_op
 };
-- 
cgit v1.2.3