1.0.7.28: compiler being nicer to the compiler

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

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 8d34d60..2c41365 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -131,7 +131,7 @@
     (dolist (arg (basic-combination-args call))
       (when arg
         (flush-lvar-externally-checkable-type arg))))
-  (pushnew fun (lambda-calls-or-closes (node-home-lambda call)))
+  (sset-adjoin fun (lambda-calls-or-closes (node-home-lambda call)))
   (recognize-dynamic-extent-lvars call fun)
   (merge-tail-sets call fun)
   (change-ref-leaf ref fun)
@@ -191,7 +191,7 @@
          (optional-dispatch-entry-point-fun fun 0)
          (loop for ep in (optional-dispatch-entry-points fun)
                and n from min
-               do (entries `((= ,n-supplied ,n)
+               do (entries `((eql ,n-supplied ,n)
                              (%funcall ,(force ep) ,@(subseq temps 0 n)))))
          `(lambda (,n-supplied ,@temps)
             ;; FIXME: Make sure that INDEX type distinguishes between
@@ -201,7 +201,9 @@
             (cond
              ,@(if more (butlast (entries)) (entries))
              ,@(when more
-                 `((,(if (zerop min) t `(>= ,n-supplied ,max))
+                 ;; KLUDGE: (NOT (< ...)) instead of >= avoids one round of
+                 ;; deftransforms and lambda-conversion.
+                 `((,(if (zerop min) t `(not (< ,n-supplied ,max)))
                     ,(let ((n-context (gensym))
                            (n-count (gensym)))
                        `(multiple-value-bind (,n-context ,n-count)
@@ -355,8 +357,7 @@
   (loop
    (let ((did-something nil))
      (dolist (clambda clambdas)
-       (let* ((component (lambda-component clambda))
-              (*all-components* (list component)))
+       (let ((component (lambda-component clambda)))
          ;; The original CMU CL code seemed to implicitly assume that
          ;; COMPONENT is the only one here. Let's make that explicit.
          (aver (= 1 (length (functional-components clambda))))
@@ -496,7 +497,7 @@
         (aver (= (optional-dispatch-min-args fun) 0))
         (aver (not (functional-entry-fun fun)))
         (setf (basic-combination-kind call) :local)
-        (pushnew ep (lambda-calls-or-closes (node-home-lambda call)))
+        (sset-adjoin ep (lambda-calls-or-closes (node-home-lambda call)))
         (merge-tail-sets call ep)
         (change-ref-leaf ref ep)
 
@@ -832,7 +833,8 @@
   (depart-from-tail-set clambda)
 
   (let* ((home (node-home-lambda call))
-         (home-physenv (lambda-physenv home)))
+         (home-physenv (lambda-physenv home))
+         (physenv (lambda-physenv clambda)))
 
     (aver (not (eq home clambda)))
 
@@ -841,6 +843,11 @@
     (setf (lambda-home clambda) home)
     (setf (lambda-physenv clambda) home-physenv)
 
+    (when physenv
+      (setf (physenv-nlx-info home-physenv)
+            (nconc (physenv-nlx-info physenv)
+                   (physenv-nlx-info home-physenv))))
+
     ;; All of CLAMBDA's LETs belong to HOME now.
     (let ((lets (lambda-lets clambda)))
       (dolist (let lets)
@@ -853,10 +860,9 @@
 
     ;; HOME no longer calls CLAMBDA, and owns all of CLAMBDA's old
     ;; DFO dependencies.
-    (setf (lambda-calls-or-closes home)
-          (delete clambda
-                  (nunion (lambda-calls-or-closes clambda)
-                          (lambda-calls-or-closes home))))
+    (sset-union (lambda-calls-or-closes home)
+                (lambda-calls-or-closes clambda))
+    (sset-delete clambda (lambda-calls-or-closes home))
     ;; CLAMBDA no longer has an independent existence as an entity
     ;; which calls things or has DFO dependencies.
     (setf (lambda-calls-or-closes clambda) nil)
@@ -906,7 +912,7 @@
 ;;; the RETURN-RESULT, because the return might have been deleted (if
 ;;; all calls were TR.)
 (defun unconvert-tail-calls (fun call next-block)
-  (dolist (called (lambda-calls-or-closes fun))
+  (do-sset-elements (called (lambda-calls-or-closes fun))
     (when (lambda-p called)
       (dolist (ref (leaf-refs called))
         (let ((this-call (node-dest ref)))
@@ -1044,7 +1050,8 @@
 ;;; true if we converted.
 (defun maybe-let-convert (clambda)
   (declare (type clambda clambda))
-  (unless (declarations-suppress-let-conversion-p clambda)
+  (unless (or (declarations-suppress-let-conversion-p clambda)
+              (functional-has-external-references-p clambda))
     ;; We only convert to a LET when the function is a normal local
     ;; function, has no XEP, and is referenced in exactly one local
     ;; call. Conversion is also inhibited if the only reference is in
@@ -1160,7 +1167,8 @@
 (defun maybe-convert-to-assignment (clambda)
   (declare (type clambda clambda))
   (when (and (not (functional-kind clambda))
-             (not (functional-entry-fun clambda)))
+             (not (functional-entry-fun clambda))
+             (not (functional-has-external-references-p clambda)))
     (let ((outside-non-tail-call nil)
           (outside-call nil))
       (when (and (dolist (ref (leaf-refs clambda) t)