0.8.10.36:

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

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index f370eb3..fa366db 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -186,7 +186,7 @@
   (with-ir1-environment-from-node (lambda-bind (main-entry fun))
     (let ((res (ir1-convert-lambda (make-xep-lambda-expression fun)
                                   :debug-name (debug-namify
-                                               "XEP for ~A"
+                                               "XEP for "
                                                (leaf-debug-name fun)))))
       (setf (functional-kind res) :external
            (leaf-ever-used res) t
@@ -281,7 +281,7 @@
        (return))
       (let ((kind (functional-kind functional)))
        (cond ((or (functional-somewhat-letlike-p functional)
-                  (eql kind :deleted))
+                  (memq kind '(:deleted :zombie)))
               (values)) ; nothing to do
              ((and (null (leaf-refs functional)) (eq kind nil)
                    (not (functional-entry-fun functional)))
@@ -345,7 +345,7 @@
                           (ir1-convert-lambda
                            (functional-inline-expansion original-functional)
                            :debug-name (debug-namify
-                                        "local inline ~A"
+                                        "local inline "
                                         (leaf-debug-name
                                          original-functional)))))))
           (cond (losing-local-functional
@@ -546,7 +546,7 @@
            `(lambda ,vars
               (declare (ignorable ,@ignores))
               (%funcall ,entry ,@args))
-           :debug-name (debug-namify "hairy function entry ~S"
+           :debug-name (debug-namify "hairy function entry "
                                      (lvar-fun-name
                                       (basic-combination-fun call)))))))
     (convert-call ref call new-fun)
@@ -632,7 +632,7 @@
                           (progn
                             (ignores dummy val)
                              (unless (eq name :allow-other-keys)
-                               (setq loser name))))
+                               (setq loser (list name)))))
                (let ((info (lambda-var-arg-info var)))
                  (when (eq (arg-info-key info) name)
                    (ignores dummy)
@@ -641,7 +641,7 @@
 
        (when (and loser (not (optional-dispatch-allowp fun)) (not allowp))
          (compiler-warn "function called with unknown argument keyword ~S"
-                        loser)
+                        (car loser))
          (setf (basic-combination-kind call) :error)
          (return-from convert-more-call)))
 
@@ -959,7 +959,11 @@
                          next-block)))
     (move-return-stuff fun call next-block)
     (merge-lets fun call)
-    (setf (node-tail-p call) nil)))
+    (setf (node-tail-p call) nil)
+    ;; If CALL has a derive type NIL, it means that "its return" is
+    ;; unreachable, but the next BIND is still reachable; in order to
+    ;; not confuse MAYBE-TERMINATE-BLOCK...
+    (setf (node-derived-type call) *wild-type*)))
 
 ;;; Reoptimize all of CALL's args and its result.
 (defun reoptimize-call (call)