From: Alexey Dejneka <adejneka@comail.ru>
Date: Sun, 26 Oct 2003 11:36:24 +0000 (+0000)
Subject: 0.8.5.5:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=140791a0479787eaca83bea2355c15b65259a823;p=sbcl.git

0.8.5.5:
        * Fix bug reported by Brian Downing: do not perform
          MV-LET-convertion, if the last optional entry has
          references.
        ... new consistency condition: function in a local
            mv-combination must be of kind MV-LET.
---

diff --git a/NEWS b/NEWS
index f5bbce8..ebf76c7 100644
--- a/NEWS
+++ b/NEWS
@@ -2173,6 +2173,8 @@ changes in sbcl-0.8.6 relative to sbcl-0.8.5:
     that the various BOOLE-related constants have the same value in
     host and target lisps.  (noted by Paul Dietz' test suite on an
     SBCL binary built from CLISP)
+  * fixed a compiler bug: MV-LET convertion did not check references
+    to the "max args" entry point.  (reported by Brian Downing)
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles
diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index 9be0b07..ac06242 100644
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -466,6 +466,18 @@
 	     (check-fun-reached leaf node)))))
     (basic-combination
      (check-dest (basic-combination-fun node) node)
+     (when (and (mv-combination-p node)
+                (eq (basic-combination-kind node) :local))
+       (let ((fun-lvar (basic-combination-fun node)))
+         (unless (ref-p (lvar-uses fun-lvar))
+           (barf "function in a local mv-combination is not a LEAF: ~S" node))
+         (let ((fun (ref-leaf (lvar-use fun-lvar))))
+           (unless (lambda-p fun)
+             (barf "function ~S in a local mv-combination ~S is not local"
+                   fun node))
+           (unless (eq (functional-kind fun) :mv-let)
+             (barf "function ~S in a local mv-combination ~S is not of kind :MV-LET"
+                   fun node)))))
      (dolist (arg (basic-combination-args node))
        (cond
          (arg (check-dest arg node))
diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index a4bf8fa..3239cd3 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -438,22 +438,23 @@
 (defun convert-mv-call (ref call fun)
   (declare (type ref ref) (type mv-combination call) (type functional fun))
   (when (and (looks-like-an-mv-bind fun)
-	     (not (functional-entry-fun fun))
 	     (singleton-p (leaf-refs fun))
 	     (singleton-p (basic-combination-args call)))
     (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)
-      (change-ref-leaf ref ep)
+      (when (null (leaf-refs ep))
+        (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)))
+        (merge-tail-sets call ep)
+        (change-ref-leaf ref ep)
 
-      (assert-lvar-type
-       (first (basic-combination-args call))
-       (make-short-values-type (mapcar #'leaf-type (lambda-vars ep)))
-       (lexenv-policy (node-lexenv call)))))
+        (assert-lvar-type
+         (first (basic-combination-args call))
+         (make-short-values-type (mapcar #'leaf-type (lambda-vars ep)))
+         (lexenv-policy (node-lexenv call))))))
   (values))
 
 ;;; Attempt to convert a call to a lambda. If the number of args is
diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index 531f1b6..2967dfc 100644
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -325,5 +325,20 @@
   (dotimes (k n)
     (princ k)))
 
+;;; bug reported by Brian Downing: incorrect detection of MV-LET
+(DEFUN #:failure-testcase (SESSION)
+  (LABELS ((CONTINUATION-1 ()
+             (PROGN
+               (IF (foobar-1 SESSION)
+                   (CONTINUATION-2))
+               (LET ((CONTINUATION-3
+                      #'(LAMBDA ()
+                          (MULTIPLE-VALUE-CALL #'CONTINUATION-2
+                            (CONTINUATION-1)))))
+                 (foobar-2 CONTINUATION-3))))
+           (CONTINUATION-2 (&REST OTHER-1)
+             (DECLARE (IGNORE OTHER-1))))
+    (continuation-1)))
+
 
 (sb-ext:quit :unix-status 104)
diff --git a/version.lisp-expr b/version.lisp-expr
index 4455e27..ab40d4c 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.5.4"
+"0.8.5.5"