0.8.19.30: less COMPILE-FILE verbosity

[sbcl.git] / src / compiler / target-main.lisp

diff --git a/src/compiler/target-main.lisp b/src/compiler/target-main.lisp
index d455fbc..5d81a45 100644 (file)
--- a/src/compiler/target-main.lisp
+++ b/src/compiler/target-main.lisp
@@ -48,8 +48,10 @@
             (*source-info* (make-lisp-source-info form))
             (*toplevel-lambdas* ())
             (*block-compile* nil)
+             (*allow-instrumenting* nil)
             (*compiler-error-bailout*
-             (lambda ()
+             (lambda (&optional error)
+                (declare (ignore error))
                (compiler-mumble
                 "~2&fatal error, aborting compilation~%")
                (return-from actually-compile (values nil t nil))))
@@ -61,6 +63,19 @@
             (*last-format-args* nil)
             (*last-message-count* 0)
             (*gensym-counter* 0)
+            ;; KLUDGE: This rebinding of policy is necessary so that
+            ;; forms such as LOCALLY at the REPL actually extend the
+            ;; compilation policy correctly.  However, there is an
+            ;; invariant that is potentially violated: future
+            ;; refactoring must not allow this to be done in the file
+            ;; compiler.  At the moment we're clearly alright, as we
+            ;; call %COMPILE with a core-object, not a fasl-stream,
+            ;; but caveat future maintainers. -- CSR, 2002-10-27
+            (*policy* (lexenv-policy *lexenv*))
+            ;; see above
+            (*handled-conditions* (lexenv-handled-conditions *lexenv*))
+            ;; ditto
+            (*disabled-package-locks* (lexenv-disabled-package-locks *lexenv*))
             ;; FIXME: ANSI doesn't say anything about CL:COMPILE
             ;; interacting with these variables, so we shouldn't. As
             ;; of SBCL 0.6.7, COMPILE-FILE controls its verbosity by
@@ -69,11 +84,12 @@
             ;; controlled by function arguments and lexical variables.
             (*compile-verbose* nil)
             (*compile-print* nil))
-       (clear-stuff)
-       (find-source-paths form 0)
-       (%compile form (make-core-object)
-                 :name name
-                 :path '(original-source-start 0 0))))))
+       (handler-bind (((satisfies handle-condition-p) #'handle-condition-handler))
+         (clear-stuff)
+         (find-source-paths form 0)
+         (%compile form (make-core-object)
+                   :name name
+                   :path '(original-source-start 0 0)))))))
 
 (defun compile-in-lexenv (name definition lexenv)
   (multiple-value-bind (compiled-definition warnings-p failure-p)