message

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

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index cabe030..39e1d69 100644 (file)
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -287,18 +287,20 @@
   (maybe-mumble "opt")
   (event ir1-optimize-until-done)
   (let ((count 0)
-       (cleared-reanalyze nil))
+       (cleared-reanalyze nil)
+        (fastp nil))
     (loop
       (when (component-reanalyze component)
        (setq count 0)
        (setq cleared-reanalyze t)
        (setf (component-reanalyze component) nil))
       (setf (component-reoptimize component) nil)
-      (ir1-optimize component)
+      (ir1-optimize component fastp)
       (cond ((component-reoptimize component)
              (incf count)
-             (when (and (= count *max-optimize-iterations*)
-                        (not (component-reanalyze component)))
+             (when (and (>= count *max-optimize-iterations*)
+                        (not (component-reanalyze component))
+                        (eq (component-reoptimize component) :maybe))
                (maybe-mumble "*")
                (cond ((retry-delayed-ir1-transforms :optimize)
                      (maybe-mumble "+")
@@ -315,7 +317,8 @@
            (t
              (maybe-mumble " ")
             (return)))
-      (maybe-mumble "."))
+      (setq fastp (>= count *max-optimize-iterations*))
+      (maybe-mumble (if fastp "-" ".")))
     (when cleared-reanalyze
       (setf (component-reanalyze component) t)))
   (values))
@@ -666,7 +669,7 @@
     (format t "~4TL~D: ~S~:[~; [closure]~]~%"
            (label-id (entry-info-offset entry))
            (entry-info-name entry)
-           (entry-info-closure-p entry)))
+           (entry-info-closure-tn entry)))
   (terpri)
   (pre-pack-tn-stats component *standard-output*)
   (terpri)
@@ -690,6 +693,8 @@
   ;; If a file, the truename of the corresponding source file. If from
   ;; a Lisp form, :LISP. If from a stream, :STREAM.
   (name (missing-arg) :type (or pathname (member :lisp :stream)))
+  ;; the external format that we'll call OPEN with, if NAME is a file.
+  (external-format nil)
   ;; the defaulted, but not necessarily absolute file name (i.e. prior
   ;; to TRUENAME call.) Null if not a file. This is used to set
   ;; *COMPILE-FILE-PATHNAME*, and if absolute, is dumped in the
@@ -723,9 +728,10 @@
   (stream nil :type (or stream null)))
 
 ;;; Given a pathname, return a SOURCE-INFO structure.
-(defun make-file-source-info (file)
+(defun make-file-source-info (file external-format)
   (let ((file-info (make-file-info :name (truename file)
                                   :untruename file
+                                   :external-format external-format
                                   :write-date (file-write-date file))))
 
     (make-source-info :file-info file-info)))
@@ -782,10 +788,13 @@
   (declare (type source-info info))
   (or (source-info-stream info)
       (let* ((file-info (source-info-file-info info))
-            (name (file-info-name file-info)))
+            (name (file-info-name file-info))
+             (external-format (file-info-external-format file-info)))
        (setf sb!xc:*compile-file-truename* name
              sb!xc:*compile-file-pathname* (file-info-untruename file-info)
-             (source-info-stream info) (open name :direction :input)))))
+             (source-info-stream info)
+              (open name :direction :input
+                    :external-format external-format)))))
 
 ;;; Close the stream in INFO if it is open.
 (defun close-source-info (info)
@@ -993,18 +1002,12 @@
     ;; whole FUNCTIONAL-KIND=:TOPLEVEL case could go away..)
 
     (locall-analyze-clambdas-until-done (list fun))
-    
+
     (multiple-value-bind (components-from-dfo top-components hairy-top)
         (find-initial-dfo (list fun))
+      (declare (ignore hairy-top))
 
       (let ((*all-components* (append components-from-dfo top-components)))
-       ;; FIXME: This is more monkey see monkey do based on CMU CL
-       ;; code. If anyone figures out why to only prescan HAIRY-TOP
-       ;; and TOP-COMPONENTS here, instead of *ALL-COMPONENTS* or
-       ;; some other combination of results from FIND-INITIAL-VALUES,
-       ;; it'd be good to explain it.
-       (mapc #'preallocate-physenvs-for-toplevelish-lambdas hairy-top)
-       (mapc #'preallocate-physenvs-for-toplevelish-lambdas top-components)
         (dolist (component-from-dfo components-from-dfo)
           (compile-component component-from-dfo)
           (replace-toplevel-xeps component-from-dfo)))
@@ -1536,7 +1539,7 @@
   #!+sb-doc
   "Compile INPUT-FILE, producing a corresponding fasl file and returning
    its filename. Besides the ANSI &KEY arguments :OUTPUT-FILE, :VERBOSE,
-   :PRINT, and :EXTERNAL-FORMAT,the following extensions are supported:
+   :PRINT, and :EXTERNAL-FORMAT, the following extensions are supported:
      :TRACE-FILE
         If given, internal data structures are dumped to the specified
         file, or if a value of T is given, to a file of *.trace type
@@ -1555,15 +1558,13 @@
    optimization values, and the :BLOCK-COMPILE argument will probably
    become deprecated."
 
-  (unless (eq external-format :default)
-    (error "Non-:DEFAULT EXTERNAL-FORMAT values are not supported."))
   (let* ((fasl-output nil)
         (output-file-name nil)
         (compile-won nil)
         (warnings-p nil)
         (failure-p t) ; T in case error keeps this from being set later
         (input-pathname (verify-source-file input-file))
-        (source-info (make-file-source-info input-pathname))
+        (source-info (make-file-source-info input-pathname external-format))
         (*compiler-trace-output* nil)) ; might be modified below
 
     (unwind-protect