X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=39e1d69037d85aab3c66a7cd8e3ecbd5c5641cd7;hb=079ef9dad558ca07cb8178ef428bf738112174fa;hp=cabe030d93de918efbd4141aa29902dd7d0c399a;hpb=208e7b3072e383a2b2555ee259c9691e45cac3d6;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index cabe030..39e1d69 100644
--- 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