Thu Jun 11 20:45:05 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * futile CLISP fixes
diff -rN -u old-smoke/src/clos.lisp new-smoke/src/clos.lisp
--- old-smoke/src/clos.lisp	2014-10-27 18:18:49.000000000 +0100
+++ new-smoke/src/clos.lisp	2014-10-27 18:18:49.000000000 +0100
@@ -451,6 +451,7 @@
     ret))
 
 (defun keep-wrapper (object new-owner)
+  #-clisp
   (when (member object (owned-objects new-owner))
     (cerror "ignore" "~A has already been called for ~A."
             #'keep-wrapper object))
diff -rN -u old-smoke/src/object-map.lisp new-smoke/src/object-map.lisp
--- old-smoke/src/object-map.lisp	2014-10-27 18:18:49.000000000 +0100
+++ new-smoke/src/object-map.lisp	2014-10-27 18:18:49.000000000 +0100
@@ -21,9 +21,19 @@
             "Synchronized hash table not implemented."))
   (defun make-synchronized-hash-table (&key weakness)
     (if weakness
-        #-cmucl (make-weak-hash-table :weakness 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-hash-table :weak-p weakness)
         (make-hash-table))))
+
+;; FIXME
+;; CLISP has problems with weak hashtables and finalizers.
+;; trivial-garbage has a workaround!?
+;; http://sourceforge.net/tracker/index.php?func=detail&aid=1472478&group_id=1355&atid=101355
+;; crashes 2.47 and 2.44.1
+;; Works when not using a weak hash table, but now we are leaking memory!
      
 
 (defvar *object-map* (make-synchronized-hash-table :weakness :value)
@@ -31,27 +41,37 @@
 except object with a non virtual destuctor which had their ownership transfered
 to C++.")
 
+(declaim (inline ptr -address))
+(defun ptr-address (pointer)
+  ;; CLISP returns NIL for a null pointer
+  #+clisp
+  (if pointer
+      (pointer-address pointer)
+      0)
+  #-clisp
+  (pointer-address pointer))
+
 (declaim (inline get-object))
 (defun get-object (pointer)
-  (gethash (pointer-address pointer) *object-map*))
+  (gethash (ptr-address pointer) *object-map*))
 
 (declaim (inline (setf get-object)))
 (defun (setf get-object) (value pointer)
-  (setf (gethash (pointer-address pointer) *object-map*)
+  (setf (gethash (ptr-address pointer) *object-map*)
         value))
 
 (defun has-pointer-p (pointer)
   "Returns T when there is an object for POINTER in the map and NIL otherwise."
-  (nth-value 1 (gethash (pointer-address pointer) *object-map*)))
+  (nth-value 1 (gethash (ptr-address pointer) *object-map*)))
 
 (defun remove-if-exists (pointer)
-  (remhash (pointer-address pointer) *object-map*))
+  (remhash (ptr-address pointer) *object-map*))
 
 (defun remove-object (pointer)
   (assert (has-pointer-p pointer)
           (pointer)
           "No object to remove for pointer ~A." pointer)
-  (remhash (pointer-address pointer) *object-map*))
+  (remhash (ptr-address pointer) *object-map*))
 
 (defun report-finalize-error (condition function class pointer)
   "Report the error CONDITION it the finalizer FUNCTION for the