*WORLD-LOCK* -> **WORLD-LOCK**.
*FINALIZER-STORE* -> **FINALIZER-STORE**.
*FINALIZER-STORE-LOCK* -> **FINALIZER-STORE-LOCK**.
...eating your own dogfood is good for you.
(declare (ignore table))
`(progn ,@body))
(declare (ignore table))
`(progn ,@body))
+(defmacro defglobal (name value &rest doc)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter ,name
+ (if (boundp ',name)
+ (symbol-value ',name)
+ ,value)
+ ,@doc)))
+
;;; The GENESIS function works with fasl code which would, in the
;;; target SBCL, work on ANSI-STREAMs (streams which aren't extended
;;; Gray streams). In ANSI Common Lisp, an ANSI-STREAM is just a
;;; The GENESIS function works with fasl code which would, in the
;;; target SBCL, work on ANSI-STREAMs (streams which aren't extended
;;; Gray streams). In ANSI Common Lisp, an ANSI-STREAM is just a
(declare (ignore name value))
nil)
(declare (ignore name value))
nil)
+#!+(and sb-lutex sb-thread)
+(defun make-lutex () nil)
+
(defmacro with-mutex ((mutex) &body body)
(declare (ignore mutex))
`(locally ,@body))
(defmacro with-mutex ((mutex) &body body)
(declare (ignore mutex))
`(locally ,@body))
-(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::with-system-mutex (*finalizer-store-lock* :without-gcing t)
+ `(sb!thread::with-system-mutex (**finalizer-store-lock** :without-gcing t)
,@body))
(defun finalize (object function &key dont-save)
,@body))
(defun finalize (object function &key dont-save)
(error "Cannot finalize NIL."))
(with-finalizer-store-lock
(push (list (make-weak-pointer object) function dont-save)
(error "Cannot finalize NIL."))
(with-finalizer-store-lock
(push (list (make-weak-pointer object) function dont-save)
object)
(defun deinit-finalizers ()
;; remove :dont-save finalizers
(with-finalizer-store-lock
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)
nil)
(defun cancel-finalization (object)
;; run.
(when object
(with-finalizer-store-lock
;; 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))
:key (lambda (list)
(weak-pointer-value (car list))))))
object))
(defun run-pending-finalizers ()
(let (pending)
(with-finalizer-store-lock
(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))
(delete-if (lambda (list)
(when (null (weak-pointer-value (car list)))
(push (second list) pending)
t))
;; 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)
;;;; here: certainly enough that I (dan, 2003.1.22) don't want to mess
;;;; around deciding how to thread-safetify it. So we use a Big Lock.
;;;; Because this code is mutually recursive with the compiler, we use
;;;; here: certainly enough that I (dan, 2003.1.22) don't want to mess
;;;; around deciding how to thread-safetify it. So we use a Big Lock.
;;;; Because this code is mutually recursive with the compiler, we use
+;;;; the **WORLD-LOCK**.
;;;; miscellaneous load utilities
;;;; miscellaneous load utilities
(!begin-collecting-cold-init-forms)
;;; This lock is seized in the compiler, and related areas -- like the
;;; classoid/layout/class system.
(!begin-collecting-cold-init-forms)
;;; This lock is seized in the compiler, and related areas -- like the
;;; classoid/layout/class system.
+(defglobal **world-lock** nil)
- (setf *world-lock* (sb!thread:make-mutex :name "World Lock")))
+ (setf **world-lock** (sb!thread:make-mutex :name "World Lock")))
(!defun-from-collected-cold-init-forms !world-lock-cold-init)
(defmacro with-world-lock (() &body body)
(!defun-from-collected-cold-init-forms !world-lock-cold-init)
(defmacro with-world-lock (() &body body)
- `(sb!thread:with-recursive-lock (*world-lock*)
+ `(sb!thread:with-recursive-lock (**world-lock**)
,@body))
(declaim (type fixnum *compiler-sset-counter*))
,@body))
(declaim (type fixnum *compiler-sset-counter*))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)