X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=be089db61406e8b64a483702e5891d0820887f23;hb=51cf665f514935c8067f86f3850fd917731cada0;hp=3e4ceaf9a70a2119e8943e10ab13d8a90dd814b1;hpb=05525d3a5906d7a89fcb689c26177732493c40ce;p=sbcl.git

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 3e4ceaf..be089db 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -34,17 +34,14 @@
 ;;; continuations.
 (defun propagate-to-args (call fun)
   (declare (type combination call) (type clambda fun))
-  (do ((args (basic-combination-args call) (cdr args))
-       (vars (lambda-vars fun) (cdr vars)))
-      ((null args))
-    (let ((arg (car args))
-	  (var (car vars)))
-      (cond ((leaf-refs var)
-	     (assert-continuation-type arg (leaf-type var)
-                                       (lexenv-policy (node-lexenv call))))
-	    (t
-	     (flush-dest arg)
-	     (setf (car args) nil)))))
+  (loop with policy = (lexenv-policy (node-lexenv call))
+        for args on (basic-combination-args call)
+        and var in (lambda-vars fun)
+        for arg =  (assert-continuation-type (car args)
+                                             (leaf-type var) policy)
+        do (unless (leaf-refs var)
+             (flush-dest (car args))
+             (setf (car args) nil)))
 
   (values))
 
@@ -147,11 +144,12 @@
 	    (n-supplied (gensym))
 	    (temps (make-gensym-list max)))
        (collect ((entries))
-	 (do ((eps (optional-dispatch-entry-points fun) (rest eps))
-	      (n min (1+ n)))
-	     ((null eps))
-	   (entries `((= ,n-supplied ,n)
-		      (%funcall ,(first eps) ,@(subseq temps 0 n)))))
+         ;; Force convertion of all entries
+         (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)
+                             (%funcall ,(force ep) ,@(subseq temps 0 n)))))
 	 `(lambda (,n-supplied ,@temps)
 	    ;; FIXME: Make sure that INDEX type distinguishes between
 	    ;; target and host. (Probably just make the SB!XC:DEFTYPE
@@ -176,7 +174,7 @@
 ;;; then associate this lambda with FUN as its XEP. After the
 ;;; conversion, we iterate over the function's associated lambdas,
 ;;; redoing local call analysis so that the XEP calls will get
-;;; converted. 
+;;; converted.
 ;;;
 ;;; We set REANALYZE and REOPTIMIZE in the component, just in case we
 ;;; discover an XEP after the initial local call analyze pass.
@@ -199,7 +197,7 @@
 	 (locall-analyze-fun-1 fun))
 	(optional-dispatch
 	 (dolist (ep (optional-dispatch-entry-points fun))
-	   (locall-analyze-fun-1 ep))
+	   (locall-analyze-fun-1 (force ep)))
 	 (when (optional-dispatch-more-entry fun)
 	   (locall-analyze-fun-1 (optional-dispatch-more-entry fun)))))
       res)))
@@ -318,7 +316,8 @@
 	 ;; COMPONENT is the only one here. Let's make that explicit.
 	 (aver (= 1 (length (functional-components clambda))))
 	 (aver (eql component (first (functional-components clambda))))
-	 (when (component-new-functionals component)
+	 (when (or (component-new-functionals component)
+                   (component-reanalyze-functionals component))
 	   (setf did-something t)
 	   (locall-analyze-component component))))
      (unless did-something
@@ -348,9 +347,9 @@
 				       original-functional)))))))
 	(cond (losing-local-functional
 	       (let ((*compiler-error-context* call))
-		 (compiler-note "couldn't inline expand because expansion ~
-		                 calls this LET-converted local function:~
-		                 ~%  ~S"
+		 (compiler-notify "couldn't inline expand because expansion ~
+		                   calls this LET-converted local function:~
+		                   ~%  ~S"
 				(leaf-debug-name losing-local-functional)))
 	       original-functional)
 	      (t
@@ -434,7 +433,10 @@
 	     (not (functional-entry-fun fun))
 	     (= (length (leaf-refs fun)) 1)
 	     (= (length (basic-combination-args call)) 1))
-    (let ((ep (car (last (optional-dispatch-entry-points fun)))))
+    (let* ((*current-component* (node-component ref))
+           (ep (optional-dispatch-entry-point-fun
+                fun (optional-dispatch-max-args fun))))
+      (aver (= (optional-dispatch-min-args fun) 0))
       (setf (basic-combination-kind call) :local)
       (pushnew ep (lambda-calls-or-closes (node-home-lambda call)))
       (merge-tail-sets call ep)
@@ -501,8 +503,9 @@
 	   (setf (basic-combination-kind call) :error))
 	  ((<= call-args max-args)
 	   (convert-call ref call
-			 (elt (optional-dispatch-entry-points fun)
-			      (- call-args min-args))))
+                         (let ((*current-component* (node-component ref)))
+                           (optional-dispatch-entry-point-fun
+                            fun (- call-args min-args)))))
 	  ((optional-dispatch-more-entry fun)
 	   (convert-more-call ref call fun))
 	  (t
@@ -599,7 +602,7 @@
 	  (let ((cont (first key)))
 	    (unless (constant-continuation-p cont)
 	      (when flame
-		(compiler-note "non-constant keyword in keyword call"))
+		(compiler-notify "non-constant keyword in keyword call"))
 	      (setf (basic-combination-kind call) :error)
 	      (return-from convert-more-call))
 
@@ -613,7 +616,7 @@
                          (setq allow-found t
                                allowp (continuation-value val)))
                         (t (when flame
-                             (compiler-note "non-constant :ALLOW-OTHER-KEYS value"))
+                             (compiler-notify "non-constant :ALLOW-OTHER-KEYS value"))
                            (setf (basic-combination-kind call) :error)
                            (return-from convert-more-call)))))
 	      (dolist (var (key-vars)