0.8.3.70:
[sbcl.git] / src / compiler / main.lisp
index 4e0ba72..6a2d2bf 100644 (file)
          (multiple-value-bind (code-length trace-table fixups)
              (generate-code component)
 
+            #-sb-xc-host
            (when *compiler-trace-output*
              (format *compiler-trace-output*
                      "~|~%disassembly of code for ~S~2%" component)
 (defun describe-component (component *standard-output*)
   (declare (type component component))
   (format t "~|~%;;;; component: ~S~2%" (component-name component))
-  (print-blocks component)
+  (print-all-blocks component)
   (values))
 
 (defun describe-ir2-component (component *standard-output*)
 ;;; We parse declarations and then recursively process the body.
 (defun process-toplevel-locally (body path compile-time-too &key vars funs)
   (declare (list path))
-  (multiple-value-bind (forms decls) (parse-body body nil)
-    (let* ((*lexenv*
-           (process-decls decls vars funs (make-continuation)))
+  (multiple-value-bind (forms decls)
+      (parse-body body :doc-string-allowed nil :toplevel t)
+    (let* ((*lexenv* (process-decls decls vars funs))
+           ;; FIXME: VALUES declaration
+           ;;
           ;; Binding *POLICY* is pretty much of a hack, since it
           ;; causes LOCALLY to "capture" enclosed proclamations. It
           ;; is necessary because CONVERT-AND-MAYBE-COMPILE uses the
                          (declare (ignore funs))
                          (process-toplevel-locally body
                                                    path
-                                                   compile-time-too))))
+                                                   compile-time-too))
+                       :compile))
                      ((symbol-macrolet)
                       (funcall-in-symbol-macrolet-lexenv
                        magic
                          (process-toplevel-locally body
                                                    path
                                                    compile-time-too
-                                                   :vars vars)))))))
+                                                   :vars vars))
+                       :compile)))))
                 ((locally)
                  (process-toplevel-locally (rest form) path compile-time-too))
                 ((progn)
 ;;; Return (VALUES NIL WARNINGS-P FAILURE-P).
 (defun sub-compile-file (info)
   (declare (type source-info info))
-  (let* ((*block-compile* *block-compile-arg*)
-        (*package* (sane-package))
-        (*policy* *policy*)
-        (*lexenv* (make-null-lexenv))
-        (*source-info* info)
-        (sb!xc:*compile-file-pathname* nil)
-        (sb!xc:*compile-file-truename* nil)
-        (*toplevel-lambdas* ())
-        (*fun-names-in-this-file* ())
-        (*compiler-error-bailout*
-         (lambda ()
-           (compiler-mumble "~2&; fatal error, aborting compilation~%")
-           (return-from sub-compile-file (values nil t t))))
-        (*current-path* nil)
-        (*last-source-context* nil)
-        (*last-original-source* nil)
-        (*last-source-form* nil)
-        (*last-format-string* nil)
-        (*last-format-args* nil)
-        (*last-message-count* 0)
-        ;; FIXME: Do we need this rebinding here? It's a literal
-        ;; translation of the old CMU CL rebinding to
-        ;; (OR *BACKEND-INFO-ENVIRONMENT* *INFO-ENVIRONMENT*),
-        ;; and it's not obvious whether the rebinding to itself is
-        ;; needed that SBCL doesn't need *BACKEND-INFO-ENVIRONMENT*.
-        (*info-environment* *info-environment*)
-        (*gensym-counter* 0))
+  (let ((*package* (sane-package))
+        (*readtable* *readtable*)
+        (sb!xc:*compile-file-pathname* nil) ; really bound in
+        (sb!xc:*compile-file-truename* nil) ; SUB-SUB-COMPILE-FILE
+
+        (*policy* *policy*)
+        (*lexenv* (make-null-lexenv))
+        (*block-compile* *block-compile-arg*)
+        (*source-info* info)
+        (*toplevel-lambdas* ())
+        (*fun-names-in-this-file* ())
+        (*compiler-error-bailout*
+         (lambda ()
+           (compiler-mumble "~2&; fatal error, aborting compilation~%")
+           (return-from sub-compile-file (values nil t t))))
+        (*current-path* nil)
+        (*last-source-context* nil)
+        (*last-original-source* nil)
+        (*last-source-form* nil)
+        (*last-format-string* nil)
+        (*last-format-args* nil)
+        (*last-message-count* 0)
+        ;; FIXME: Do we need this rebinding here? It's a literal
+        ;; translation of the old CMU CL rebinding to
+        ;; (OR *BACKEND-INFO-ENVIRONMENT* *INFO-ENVIRONMENT*),
+        ;; and it's not obvious whether the rebinding to itself is
+        ;; needed that SBCL doesn't need *BACKEND-INFO-ENVIRONMENT*.
+        (*info-environment* *info-environment*)
+        (*gensym-counter* 0))
     (handler-case
        (with-compilation-values
         (sb!xc:with-compilation-unit ()