X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-package.lisp;h=25c73ff98d42f211442c2f54788ff7a990e0992d;hb=b44ca02cb963446ef23fec989786462ce88bca84;hp=a1f24bbec9b267faa02d19b5ea06b9e60689e652;hpb=e801083c864fa8f11d79be53a5d95584c960f2b3;p=sbcl.git diff --git a/src/code/early-package.lisp b/src/code/early-package.lisp index a1f24bb..25c73ff 100644 --- a/src/code/early-package.lisp +++ b/src/code/early-package.lisp @@ -18,13 +18,13 @@ ;;; 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) @@ -33,33 +33,33 @@ `(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)) @@ -69,7 +69,7 @@ (defmacro without-package-locks (&body body) #!+sb-doc "Ignores all runtime package lock violations during the execution of -body. Body can begin with declarations." +body. Body can begin with declarations." `(let (#!+sb-package-locks (*ignored-package-locks* t)) ,@body))