X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-package.lisp;h=a1f24bbec9b267faa02d19b5ea06b9e60689e652;hb=89c5e67daff0215420fb0998b8e20915ddea1437;hp=1084cdff2fe050fff0c67221aa66cde7019041e4;hpb=ff92598854bf7cae8d57fe49cef4d9a98e1ab345;p=sbcl.git

diff --git a/src/code/early-package.lisp b/src/code/early-package.lisp
index 1084cdf..a1f24bb 100644
--- a/src/code/early-package.lisp
+++ b/src/code/early-package.lisp
@@ -53,14 +53,24 @@
 	   (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 condition)
+           (sb!c:compiler-error condition)))
+    (handler-bind ((package-lock-violation #'resignal))
+      (with-single-package-locked-error ()
+        (assert-symbol-home-package-unlocked symbol control)))))
+
 (defmacro without-package-locks (&body body)
   #!+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))
+body. Body can begin with declarations."  
+  `(let (#!+sb-package-locks (*ignored-package-locks* t))
     ,@body))
 
 (!defun-from-collected-cold-init-forms !early-package-cold-init)