;;; packages for which locks are ignored, T when locks for
;;; all packages are ignored, and :invalid outside package-lock
;;; context. FIXME: This needs to be rebound for each thread.
-(defvar *ignored-package-locks*
+(defvar *ignored-package-locks*
(error "*IGNORED-PACKAGE-LOCKS* should be set up in cold-init."))
(!cold-init-forms
(setf *ignored-package-locks* :invalid))
-(defmacro with-single-package-locked-error ((&optional kind thing &rest format)
- &body body)
+(defmacro with-single-package-locked-error ((&optional kind thing &rest format)
+ &body body)
#!-sb-package-locks (declare (ignore kind thing format))
#!-sb-package-locks
`(progn ,@body)
`(progn
(/show0 ,(first format))
(let ((,topmost nil))
- ;; We use assignment and conditional restoration instead of
- ;; dynamic binding because we want the ignored locks
- ;; to propagate to the topmost context.
- (when (eq :invalid *ignored-package-locks*)
- (setf *ignored-package-locks* nil
- ,topmost t))
- (unwind-protect
- (progn
- ,@(ecase kind
- (:symbol
- `((assert-symbol-home-package-unlocked ,thing ,@format)))
- (:package
- `((assert-package-unlocked
- (find-undeleted-package-or-lose ,thing) ,@format)))
- ((nil)
- `()))
- ,@body)
- (when ,topmost
- (setf *ignored-package-locks* :invalid)))))))
+ ;; We use assignment and conditional restoration instead of
+ ;; dynamic binding because we want the ignored locks
+ ;; to propagate to the topmost context.
+ (when (eq :invalid *ignored-package-locks*)
+ (setf *ignored-package-locks* nil
+ ,topmost t))
+ (unwind-protect
+ (progn
+ ,@(ecase kind
+ (:symbol
+ `((assert-symbol-home-package-unlocked ,thing ,@format)))
+ (:package
+ `((assert-package-unlocked
+ (find-undeleted-package-or-lose ,thing) ,@format)))
+ ((nil)
+ `()))
+ ,@body)
+ (when ,topmost
+ (setf *ignored-package-locks* :invalid)))))))
(defun compiler-assert-symbol-home-package-unlocked (symbol control)
#!-sb-package-locks
(declare (ignore symbol control))
#!+sb-package-locks
(flet ((resignal (condition)
- ;; Signal the condition to give user defined handlers a chance,
- ;; if they decline convert to compiler-error.
+ ;; Signal the condition to give user defined handlers a chance,
+ ;; if they decline convert to compiler-error.
(signal condition)
(sb!c:compiler-error condition)))
(handler-bind ((package-lock-violation #'resignal))
#!+sb-doc
"Ignores all runtime package lock violations during the execution of
body. Body can begin with declarations."
- #!-sb-package-locks
- `(progn ,@body)
- #!+sb-package-locks
- `(let ((*ignored-package-locks* t))
+ `(let (#!+sb-package-locks (*ignored-package-locks* t))
,@body))
(!defun-from-collected-cold-init-forms !early-package-cold-init)