Tue Jun 30 22:54:49 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* CLISP workaround finalizer for objects in weak hash table crash.

--- old-smoke/src/clos.lisp 2014-09-30 10:32:08.000000000 +0200

+++ new-smoke/src/clos.lisp 2014-09-30 10:32:08.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))

--- old-smoke/src/object-map.lisp 2014-09-30 10:32:08.000000000 +0200

+++ new-smoke/src/object-map.lisp 2014-09-30 10:32:08.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."))

--- old-smoke/src/objects/stack.lisp 2014-09-30 10:32:08.000000000 +0200

+++ new-smoke/src/objects/stack.lisp 2014-09-30 10:32:08.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.