0.9.2.26: refactoring internals of foreign linkage

[sbcl.git] / src / code / early-package.lisp

diff --git a/src/code/early-package.lisp b/src/code/early-package.lisp
index 1084cdf..a1f24bb 100644 (file)
--- 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)