Tue Jun 30 22:54:49 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * CLISP workaround finalizer for objects in weak hash table crash.
diff -rN -u old-smoke/src/clos.lisp new-smoke/src/clos.lisp
--- old-smoke/src/clos.lisp	2014-10-10 20:14:24.000000000 +0200
+++ new-smoke/src/clos.lisp	2014-10-10 20:14:24.000000000 +0200
@@ -258,7 +258,7 @@
   (declare (optimize (speed 3)))
   (let ((object (get-object object-pointer)))
     (when object
-      (cancel-finalization object)
+      (remove-finalizer object)
       (remove-object object-pointer)
       (setf (slot-value object 'pointer) (null-pointer)))))
 
@@ -301,7 +301,7 @@
       (let ((converted-value (convert-argument value type nil)))
         (push-smoke-stack stack converted-value (type-id type))
         (when (stack-p type) ;; Pass by value => smoke deletes the object.
-          (cancel-finalization converted-value)
+          (remove-finalizer converted-value)
           (when (typep value 'smoke-standard-object)
             (transfer-ownership-to value object)))))))
 
@@ -472,7 +472,7 @@
 (defun transfer-ownership-to (object new-owner)
   "Transfers the ownership of OBJECT to C++."
   (declare (optimize (speed 3)))
-  (cancel-finalization object)
+  (remove-finalizer object)
   (if (virtual-destructor-p (class-of object))
       (keep-wrapper object new-owner)
       (remove-object (pointer object))))
@@ -482,5 +482,4 @@
 cl-smoke is responsible for deleting the object."
   (when current-owner
     (remove-wrapper-object object current-owner))
-  (let ((finalizer (make-finalize object)))
-    (finalize object finalizer)))
+  (set-finalizer object))
diff -rN -u old-smoke/src/object-map.lisp new-smoke/src/object-map.lisp
--- old-smoke/src/object-map.lisp	2014-10-10 20:14:24.000000000 +0200
+++ new-smoke/src/object-map.lisp	2014-10-10 20:14:24.000000000 +0200
@@ -21,10 +21,7 @@
             "Synchronized hash table not implemented."))
   (defun make-synchronized-hash-table (&key weakness)
     (if weakness
-        #-cmucl (make-weak-hash-table :weakness #-clisp weakness
-                                      ;; CLISP crash with weak hash table
-                                      ;; leak memory (see also: #'keep-wrapper)
-                                      #+clisp nil)
+        #-cmucl (make-weak-hash-table :weakness weakness)
         #+cmucl (make-hash-table :weak-p weakness)
         (make-hash-table))))
 
@@ -72,6 +69,21 @@
         function class pointer condition)
   #+sbcl (sb-debug:backtrace 10))
 
+(declaim (inline remove-finalizer))
+(defun remove-finalizer (object)
+  #-clisp
+  (cancel-finalization object)
+  #+clisp
+  (when (typep object 'smoke-standard-object)
+    (cancel-finalization (slot-value object 'finalizer))))
+
+(declaim (inline set-finalizer))
+(defun set-finalizer (object)
+  #-clisp
+  (finalize object (make-finalize object))
+  #+clisp
+  (finalize (slot-value object 'finalizer) (make-finalize object)))
+
 (defgeneric make-finalize (object)
   (:documentation "Returns a function to be called when OBJECT is finalized."))
 
diff -rN -u old-smoke/src/objects/stack.lisp new-smoke/src/objects/stack.lisp
--- old-smoke/src/objects/stack.lisp	2014-10-10 20:14:24.000000000 +0200
+++ new-smoke/src/objects/stack.lisp	2014-10-10 20:14:24.000000000 +0200
@@ -43,6 +43,7 @@
   ((pointer :reader pointer
             :initarg :pointer
             :documentation "Pointer to the C++ object.")
+   #+clisp (finalizer :type list :initform (list nil))
    ;; We can not have a global table of objects owned by C++,
    ;; since then they would be alway reacable from Lisp and thus
    ;; cycles would never be garbage collected.