X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fearly-package.lisp;h=fb2e1d273d4e7ae27baeebb96630a136be19c5c4;hb=cd5a858174d892f876699373dc3ea389cf2c4d40;hp=25c73ff98d42f211442c2f54788ff7a990e0992d;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/early-package.lisp b/src/code/early-package.lisp
index 25c73ff..fb2e1d2 100644
--- a/src/code/early-package.lisp
+++ b/src/code/early-package.lisp
@@ -53,18 +53,20 @@
            (when ,topmost
              (setf *ignored-package-locks* :invalid)))))))
 
-(defun compiler-assert-symbol-home-package-unlocked (symbol control)
+(defun program-assert-symbol-home-package-unlocked (context symbol control)
   #!-sb-package-locks
-  (declare (ignore symbol control))
+  (declare (ignore context 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)))))
+  (handler-bind ((package-lock-violation
+                  (lambda (condition)
+                    (ecase context
+                      (:compile
+                       (warn "Compile-time package lock violation:~%  ~A"
+                             condition)
+                       (sb!c:compiler-error condition))
+                      (:eval
+                       (eval-error condition))))))
+    (with-single-package-locked-error (:symbol symbol control))))
 
 (defmacro without-package-locks (&body body)
   #!+sb-doc