0.6.12.3:
[sbcl.git] / src / compiler / main.lisp
index 0f0f7de..871a27c 100644 (file)
        (setf (component-reanalyze component) nil))
       (setf (component-reoptimize component) nil)
       (ir1-optimize component)
-      (unless (component-reoptimize component)
-       (maybe-mumble " ")
-       (return))
-      (incf count)
-      (when (= count *max-optimize-iterations*)
-       (event ir1-optimize-maxed-out)
-       (maybe-mumble "* ")
-       (setf (component-reoptimize component) nil)
-       (do-blocks (block component)
-         (setf (block-reoptimize block) nil))
-       (return))
+      (cond ((component-reoptimize component)
+             (incf count)
+             (when (= count *max-optimize-iterations*)
+               (maybe-mumble "*")
+               (cond ((retry-delayed-ir1-transforms :optimize)
+                     (maybe-mumble "+")
+                     (setq count 0))
+                     (t
+                     (event ir1-optimize-maxed-out)
+                     (setf (component-reoptimize component) nil)
+                     (do-blocks (block component)
+                       (setf (block-reoptimize block) nil))
+                     (return)))))
+            ((retry-delayed-ir1-transforms :optimize)
+            (setf count 0)
+            (maybe-mumble "+"))
+           (t
+             (maybe-mumble " ")
+            (return)))
       (maybe-mumble "."))
     (when cleared-reanalyze
       (setf (component-reanalyze component) t)))
   (values))
 
 (defparameter *constraint-propagate* t)
-(defparameter *reoptimize-after-type-check-max* 5)
+
+;;; KLUDGE: This was bumped from 5 to 10 in a DTC patch ported by MNA
+;;; from CMU CL into sbcl-0.6.11.44, the same one which allowed IR1
+;;; transforms to be delayed. Either DTC or MNA or both didn't explain
+;;; why, and I don't know what the rationale was. -- WHN 2001-04-28
+;;;
+;;; FIXME: It would be good to document why it's important to have a
+;;; large value here, and what the drawbacks of an excessively large
+;;; value are; and it might also be good to make it depend on
+;;; optimization policy.
+(defparameter *reoptimize-after-type-check-max* 10)
 
 (defevent reoptimize-maxed-out
   "*REOPTIMIZE-AFTER-TYPE-CHECK-MAX* exceeded.")
 (defun ir1-phases (component)
   (declare (type component component))
   (let ((*constraint-number* 0)
-       (loop-count 1))
-    (declare (special *constraint-number*))
+       (loop-count 1)
+        (*delayed-ir1-transforms* nil))
+    (declare (special *constraint-number* *delayed-ir1-transforms*))
     (loop
       (ir1-optimize-until-done component)
       (when (or (component-new-functions component)
       (when *constraint-propagate*
        (maybe-mumble "constraint ")
        (constraint-propagate component))
-      (maybe-mumble "type ")
+      (when (retry-delayed-ir1-transforms :constraint)
+        (maybe-mumble "Rtran "))
       ;; Delay the generation of type checks until the type
       ;; constraints have had time to propagate, else the compiler can
       ;; confuse itself.
                       (component-reanalyze component)
                       (component-new-functions component)
                       (component-reanalyze-functions component))
-                  (< loop-count (- *reoptimize-after-type-check-max* 2)))
+                  (< loop-count (- *reoptimize-after-type-check-max* 4)))
+        (maybe-mumble "type ")
        (generate-type-checks component)
        (unless (or (component-reoptimize component)
                    (component-reanalyze component)
          (entry-analyze component)
          (ir2-convert component)
 
-         (when (policy nil (>= speed compilation-speed))
+         (when (policy *lexenv* (>= speed compilation-speed))
            (maybe-mumble "copy ")
            (copy-propagate component))
 
                                    *compile-object*))
              (null))))))
 
-  ;; We are done, so don't bother keeping anything around.
+  ;; We're done, so don't bother keeping anything around.
   (setf (component-info component) nil)
 
   (values))
 
+(defun policy-byte-compile-p (thing)
+  (policy thing
+         (and (zerop speed)
+              (<= debug 1))))
+
 ;;; Return our best guess for whether we will byte compile code
 ;;; currently being IR1 converted. This is only a guess because the
 ;;; decision is made on a per-component basis.
 (defun byte-compiling ()
   (if (eq *byte-compiling* :maybe)
       (or (eq *byte-compile* t)
-         ;; FIXME: It's bad to share this expression between this
-         ;; function and LAMBDA-IS-BYTE-COMPILABLE-P (and who knows
-         ;; where else?), it should be factored out into some
-         ;; common function.
-         (policy nil (and (zerop speed) (<= debug 1))))
+          (policy-byte-compile-p *lexenv*))
       (and *byte-compile* *byte-compiling*)))
 
 ;;; Delete components with no external entry points before we try to
                      (leaf-refs fun))
         (return))))))
 
-(defun lambda-is-byte-compilable-p (lambda)
-  #|
-  (format t "~S SPEED=~S DEBUG=~S~%" ; REMOVEME
-          lambda
-          (policy (lambda-bind lambda) speed)
-          (policy (lambda-bind lambda) debug))
-  |#
-  (policy (lambda-bind lambda)
-         (and (zerop speed) (<= debug 1))))  
-
 (defun byte-compile-this-component-p (component)
   (ecase *byte-compile*
     ((t) t)
     ((nil) nil)
     ((:maybe)
-     (every #'lambda-is-byte-compilable-p (component-lambdas component)))))
+     (every #'policy-byte-compile-p (component-lambdas component)))))
 
 (defun compile-component (component)
   (let* ((*component-being-compiled* component)
 ;;; *TOP-LEVEL-LAMBDAS* instead.
 (defun convert-and-maybe-compile (form path)
   (declare (list path))
-  (let* ((*lexenv* (make-lexenv :policy *policy*
-                               :interface-policy *interface-policy*))
+  (let* ((*lexenv* (make-lexenv :policy *policy*))
         (tll (ir1-top-level form path nil)))
     (cond ((eq *block-compile* t) (push tll *top-level-lambdas*))
          (t (compile-top-level (list tll) nil)))))
   (multiple-value-bind (forms decls) (sb!sys:parse-body (cdr form) nil)
     (let* ((*lexenv*
            (process-decls decls nil nil (make-continuation)))
-          ;; Binding *xxx-POLICY* is pretty much of a hack, since it
+          ;; 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
           ;; value of *POLICY* as the policy. The need for this hack
           ;; FIXME: Ideally, something should be done so that DECLAIM
           ;; inside LOCALLY works OK. Failing that, at least we could
           ;; issue a warning instead of silently screwing up.
-          (*policy* (lexenv-policy *lexenv*))
-          (*interface-policy* (lexenv-interface-policy *lexenv*)))
+          (*policy* (lexenv-policy *lexenv*)))
       (process-top-level-progn forms path))))
 
 ;;; Force any pending top-level forms to be compiled and dumped so
         (*block-compile* *block-compile-argument*)
         (*package* (sane-package))
         (*policy* *policy*)
-        (*interface-policy* *interface-policy*)
         (*lexenv* (make-null-lexenv))
         (*converting-for-interpreter* nil)
         (*source-info* info)