X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffinal.lisp;h=597d5d08ec296ab166dc9efec6699732ab1cf5b7;hb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;hp=15a45a6b1dfdbc04e9872161795baf5eb389fc4b;hpb=79cc569a97e444389350ea3f5b1017374fe16bec;p=sbcl.git diff --git a/src/code/final.lisp b/src/code/final.lisp index 15a45a6..597d5d0 100644 --- a/src/code/final.lisp +++ b/src/code/final.lisp @@ -13,11 +13,11 @@ (defvar *finalizer-store* nil) -(defvar *finalizer-store-lock* +(defvar *finalizer-store-lock* (sb!thread:make-mutex :name "Finalizer store lock.")) (defun finalize (object function) - #!+sb-doc + #!+sb-doc "Arrange for the designated FUNCTION to be called when there are no more references to OBJECT, including references in FUNCTION itself. @@ -48,19 +48,19 @@ Examples: (defvar *rec* nil) (defun oops () - (when *rec* + (when *rec* (error \"recursive OOPS\")) (let ((*rec* t)) (gc))) ; or just cons enough to cause one - (progn + (progn (finalize \"oops\" #'oops) (oops)) ; causes GC and re-entry to #'oops due to the finalizer ; -> ERROR, caught, WARNING signalled" (sb!sys:without-gcing (sb!thread:with-mutex (*finalizer-store-lock*) - (push (cons (make-weak-pointer object) function) - *finalizer-store*))) + (push (cons (make-weak-pointer object) function) + *finalizer-store*))) object) (defun cancel-finalization (object) @@ -70,28 +70,28 @@ Examples: ;; run. (when object (sb!sys:without-gcing - (sb!thread:with-mutex (*finalizer-store-lock*) - (setf *finalizer-store* - (delete object *finalizer-store* - :key (lambda (pair) - (weak-pointer-value (car pair))))))) + (sb!thread:with-mutex (*finalizer-store-lock*) + (setf *finalizer-store* + (delete object *finalizer-store* + :key (lambda (pair) + (weak-pointer-value (car pair))))))) object)) (defun run-pending-finalizers () (let (pending) (sb!sys:without-gcing - (sb!thread:with-mutex (*finalizer-store-lock*) - (setf *finalizer-store* - (delete-if (lambda (pair) - (when (null (weak-pointer-value (car pair))) - (push (cdr pair) pending) - t)) - *finalizer-store*)))) + (sb!thread:with-mutex (*finalizer-store-lock*) + (setf *finalizer-store* + (delete-if (lambda (pair) + (when (null (weak-pointer-value (car pair))) + (push (cdr pair) pending) + t)) + *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) (handler-case - (funcall fun) - (error (c) - (warn "Error calling finalizer ~S:~% ~S" fun c))))) + (funcall fun) + (error (c) + (warn "Error calling finalizer ~S:~% ~S" fun c))))) nil)