From 59460d1a4877f8b07cc91e045f07eb2c02bb8771 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Mon, 11 Feb 2008 19:47:27 +0100
Subject: Do not rely on the GC to remove entries of a weak hash table.

This patch finally makes Objective-CL not crash consistently on CLISP.

darcs-hash:20d392bc8e5203efd20e3c57224c2b1338ecb8d9
---
 Lisp/internal-utilities.lisp | 2 +-
 Lisp/libobjcl.lisp           | 2 +-
 Lisp/memory-management.lisp  | 1 +
 Lisp/method-invocation.lisp  | 2 +-
 Lisp/weak-hash-tables.lisp   | 3 +++
 5 files changed, 7 insertions(+), 3 deletions(-)

(limited to 'Lisp')

diff --git a/Lisp/internal-utilities.lisp b/Lisp/internal-utilities.lisp
index bf255ad..1c54068 100644
--- a/Lisp/internal-utilities.lisp
+++ b/Lisp/internal-utilities.lisp
@@ -19,7 +19,7 @@
 
 
 (defmacro atomically (&body body)
-  ;; Use a reentrant global lock here.
+  ;; FIXME: Use a reentrant global lock here.
   `(progn ,@body))
 
 
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 6e8e2f5..aacedab 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -826,7 +826,7 @@ separating parts by hyphens works nicely in all of the `:INVERT`,
     (let ((array-pointer (%objcl-class-direct-slots class-ptr
                                                     count-ptr
                                                     element-size-ptr)))
-      (unless (null-pointer-p array-pointer)
+      (unless (zerop (mem-ref count-ptr :unsigned-int))
         (unwind-protect
             (loop with element-size = (mem-ref element-size-ptr :unsigned-int)
                   with count = (mem-ref count-ptr :unsigned-int)
diff --git a/Lisp/memory-management.lisp b/Lisp/memory-management.lisp
index 4829a1e..6e4731a 100644
--- a/Lisp/memory-management.lisp
+++ b/Lisp/memory-management.lisp
@@ -113,6 +113,7 @@
                        ;; object wrapper cannot be used anymore.  We're
                        ;; right within its finalisation phase, after
                        ;; all.
+                       (weak-remhash address hash-table)
                        (primitive-invoke pointer "release" :void)))
                 (trivial-garbage:finalize new-wrapper #'finalizer)))
             new-wrapper)))))
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index 4653960..879996d 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -332,7 +332,7 @@ easier to use with __apply__.
                   ;; an Objective-C object.  In the latter case,
                   ;; INITIALIZE-INSTANCE does the memory management for
                   ;; us.
-                  (error (make-condition 'exception :pointer error-cell)))
+                  (error (make-pointer-wrapper 'exception :pointer error-cell)))
                 (case return-type
                   ((id objective-c-class exception selector)
                    (let ((*skip-retaining*
diff --git a/Lisp/weak-hash-tables.lisp b/Lisp/weak-hash-tables.lisp
index b016aa5..80b6100 100644
--- a/Lisp/weak-hash-tables.lisp
+++ b/Lisp/weak-hash-tables.lisp
@@ -33,6 +33,8 @@
             ;; Clean up.
             (remhash key hash-table)))))
 
+  (setf (fdefinition 'weak-remhash) (fdefinition 'remhash))
+
   (defun (setf weak-gethash) (value key hash-table)
     (setf (gethash key hash-table)
           (trivial-garbage:make-weak-pointer value))))
@@ -47,6 +49,7 @@
                                           :test 'eql))
 
   (setf (fdefinition 'weak-gethash) (fdefinition 'gethash))
+  (setf (fdefinition 'weak-remhash) (fdefinition 'remhash))
 
   (defun (setf weak-gethash) (value key hash-table)
     (setf (gethash key hash-table) value)))
-- 
cgit v1.2.3