projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Microoptimize type-tests on x86oids.
[sbcl.git]
/
src
/
code
/
final.lisp
diff --git
a/src/code/final.lisp
b/src/code/final.lisp
index
d6619ed
..
cfa36f1
100644
(file)
--- a/
src/code/final.lisp
+++ b/
src/code/final.lisp
@@
-11,22
+11,26
@@
(in-package "SB!IMPL")
(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: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)
+(defun finalize (object function &key dont-save)
#!+sb-doc
"Arrange for the designated FUNCTION to be called when there
are no more references to OBJECT, including references in
FUNCTION itself.
#!+sb-doc
"Arrange for the designated FUNCTION to be called when there
are no more references to OBJECT, including references in
FUNCTION itself.
+If DONT-SAVE is true, the finalizer will be cancelled when
+SAVE-LISP-AND-DIE is called: this is useful for finalizers
+deallocating system memory, which might otherwise be called
+with addresses from the old image.
+
In a multithreaded environment FUNCTION may be called in any
thread. In both single and multithreaded environments FUNCTION
may be called in any dynamic scope: consequences are unspecified
In a multithreaded environment FUNCTION may be called in any
thread. In both single and multithreaded environments FUNCTION
may be called in any dynamic scope: consequences are unspecified
@@
-37,19
+41,21
@@
signalled in whichever thread the FUNCTION was called in.
Examples:
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)
(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)))
(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 ()
(defvar *rec* nil)
(defun oops ()
@@
-60,13
+66,21
@@
Examples:
(progn
(finalize \"oops\" #'oops)
(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"
; -> ERROR, caught, WARNING signalled"
+ (unless object
+ (error "Cannot finalize NIL."))
(with-finalizer-store-lock
(with-finalizer-store-lock
- (push (cons (make-weak-pointer object) function)
- *finalizer-store*))
+ (push (list (make-weak-pointer object) function dont-save)
+ **finalizer-store**))
object)
object)
+(defun deinit-finalizers ()
+ ;; remove :dont-save finalizers
+ (with-finalizer-store-lock
+ (setf **finalizer-store** (delete-if #'third **finalizer-store**)))
+ nil)
+
(defun cancel-finalization (object)
#!+sb-doc
"Cancel any finalization for OBJECT."
(defun cancel-finalization (object)
#!+sb-doc
"Cancel any finalization for OBJECT."
@@
-74,21
+88,21
@@
Examples:
;; run.
(when object
(with-finalizer-store-lock
;; run.
(when object
(with-finalizer-store-lock
- (setf *finalizer-store*
- (delete object *finalizer-store*
- :key (lambda (pair)
- (weak-pointer-value (car pair))))))
+ (setf **finalizer-store**
+ (delete object **finalizer-store**
+ :key (lambda (list)
+ (weak-pointer-value (car list))))))
object))
(defun run-pending-finalizers ()
(let (pending)
(with-finalizer-store-lock
object))
(defun run-pending-finalizers ()
(let (pending)
(with-finalizer-store-lock
- (setf *finalizer-store*
- (delete-if (lambda (pair)
- (when (null (weak-pointer-value (car pair)))
- (push (cdr pair) pending)
- t))
- *finalizer-store*)))
+ (setf **finalizer-store**
+ (delete-if (lambda (list)
+ (when (null (weak-pointer-value (car list)))
+ (push (second list) 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)
;; 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)