X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffinal.lisp;h=cfa36f1dba686f94c4daae37f504563c9fab543e;hb=HEAD;hp=c2ef070664eacc010ded303b484315c2b3219cd4;hpb=afb56ab2865fdb72102a9bb6b2c846b7b5a6ad7e;p=sbcl.git

diff --git a/src/code/final.lisp b/src/code/final.lisp
index c2ef070..cfa36f1 100644
--- a/src/code/final.lisp
+++ b/src/code/final.lisp
@@ -11,15 +11,14 @@
 
 (in-package "SB!IMPL")
 
-(defvar *finalizer-store* nil)
+(defglobal **finalizer-store** nil)
 
-(defvar *finalizer-store-lock*
+(defglobal **finalizer-store-lock**
   (sb!thread:make-mutex :name "Finalizer store lock."))
 
 (defmacro with-finalizer-store-lock (&body body)
-  `(sb!thread::call-with-system-mutex (lambda () ,@body)
-                                      *finalizer-store-lock*
-                                      t))
+  `(sb!thread::with-system-mutex (**finalizer-store-lock** :without-gcing t)
+     ,@body))
 
 (defun finalize (object function &key dont-save)
   #!+sb-doc
@@ -42,19 +41,21 @@ signalled in whichever thread the FUNCTION was called in.
 
 Examples:
 
-  ;;; good (assumes RELEASE-HANDLE is re-entrant)
+  ;;; GOOD, assuming RELEASE-HANDLE is re-entrant.
   (let* ((handle (get-handle))
          (object (make-object handle)))
    (finalize object (lambda () (release-handle handle)))
    object)
 
-  ;;; bad, finalizer refers to object being finalized, causing
-  ;;; it to be retained indefinitely
+  ;;; BAD, finalizer refers to object being finalized, causing
+  ;;; it to be retained indefinitely!
   (let* ((handle (get-handle))
          (object (make-object handle)))
-    (finalize object (lambda () (release-handle (object-handle object)))))
+    (finalize object
+              (lambda ()
+                (release-handle (object-handle object)))))
 
-  ;;; bad, not re-entrant
+  ;;; BAD, not re-entrant!
   (defvar *rec* nil)
 
   (defun oops ()
@@ -65,19 +66,19 @@ Examples:
 
   (progn
     (finalize \"oops\" #'oops)
-    (oops)) ; causes GC and re-entry to #'oops due to the finalizer
+    (oops)) ; GC causes re-entry to #'oops due to the finalizer
             ; -> ERROR, caught, WARNING signalled"
   (unless object
     (error "Cannot finalize NIL."))
   (with-finalizer-store-lock
     (push (list (make-weak-pointer object) function dont-save)
-          *finalizer-store*))
+          **finalizer-store**))
   object)
 
 (defun deinit-finalizers ()
   ;; remove :dont-save finalizers
   (with-finalizer-store-lock
-    (setf *finalizer-store* (delete-if #'third *finalizer-store*)))
+    (setf **finalizer-store** (delete-if #'third **finalizer-store**)))
   nil)
 
 (defun cancel-finalization (object)
@@ -87,8 +88,8 @@ Examples:
   ;; run.
   (when object
     (with-finalizer-store-lock
-        (setf *finalizer-store*
-              (delete object *finalizer-store*
+        (setf **finalizer-store**
+              (delete object **finalizer-store**
                       :key (lambda (list)
                              (weak-pointer-value (car list))))))
     object))
@@ -96,12 +97,12 @@ Examples:
 (defun run-pending-finalizers ()
   (let (pending)
     (with-finalizer-store-lock
-        (setf *finalizer-store*
+        (setf **finalizer-store**
               (delete-if (lambda (list)
                            (when (null (weak-pointer-value (car list)))
                              (push (second list) pending)
                              t))
-                          *finalizer-store*)))
+                         **finalizer-store**)))
     ;; We want to run the finalizer bodies outside the lock in case
     ;; finalization of X causes finalization to be added for Y.
     (dolist (fun pending)