0.8.7.56:

	Fix for bug revealed by ITERATE on PPC
	... the powerpc backend has no branch delay slot, so putting the
		last defaulting operation after the branch doesn't work
		so well
	... neither does the alpha, so fix that too, even though with a
		higher REGISTER-ARG-COUNT value it's not exposed by
		ITERATE
	... cook up a test case that's likely to catch the problem
		elsewhere, if present

diff --git a/NEWS b/NEWS
index 860270f..f364f8b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2265,6 +2265,9 @@ changes in sbcl-0.8.8 relative to sbcl-0.8.7:
     recognized as being TYPEP their class.
   * bug fix: the PUSHNEW documentation string has been corrected.
     (thanks to Vincent Arkesteijn)
+  * bug fix: defaulting of the value for the last of an atypically
+    large number of multiple values being bound was not being
+    performed correctly on the Alpha or PPC platforms
   * optimization: implemented multiplication as a modular
     (UNSIGNED-BYTE 32) operation on the x86 backend.
   * optimization: SEARCH on simple-base-strings can now be open-coded.

diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp
index 14f1753..01c654d 100644 (file)
--- a/src/compiler/alpha/call.lisp
+++ b/src/compiler/alpha/call.lisp
@@ -322,9 +322,8 @@ default-value-8
                    ((null remaining))
                  (let ((def (car remaining)))
                    (emit-label (car def))
-                   (when (null (cdr remaining))
-                     (inst br zero-tn defaulting-done))
-                   (store-stack-tn (cdr def) null-tn)))))))
+                   (store-stack-tn (cdr def) null-tn)))
+               (inst br zero-tn defaulting-done)))))
 
        (when lra-label
          (inst compute-code-from-lra code-tn code-tn lra-label temp))))

diff --git a/src/compiler/ppc/call.lisp b/src/compiler/ppc/call.lisp
index fb9cd13..c99d1a0 100644 (file)
--- a/src/compiler/ppc/call.lisp
+++ b/src/compiler/ppc/call.lisp
@@ -317,9 +317,8 @@ default-value-8
                      ((null remaining))
                    (let ((def (car remaining)))
                      (emit-label (car def))
-                     (when (null (cdr remaining))
-                       (inst b defaulting-done))
                      (store-stack-tn (cdr def) null-tn)))
+                 (inst b defaulting-done)
                  (trace-table-entry trace-table-normal))))))
 
        (inst compute-code-from-lra code-tn code-tn lra-label temp)))

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index 2967dfc..e42ec62 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -340,5 +340,25 @@
              (DECLARE (IGNORE OTHER-1))))
     (continuation-1)))
 
+;;; reported by antifuchs/bdowning/etc on #lisp: ITERATE failure on
+;;; (iter (for i in '(1 2 3)) (+ i 50))
+(defun values-producer () (values 1 2 3 4 5 6 7))
+
+(defun values-consumer (fn)
+  (let (a b c d e f g h)
+    (multiple-value-bind (aa bb cc dd ee ff gg hh) (funcall fn)
+      (setq a aa)
+      (setq b bb)
+      (setq c cc)
+      (setq d dd)
+      (setq e ee)
+      (setq f ff)
+      (setq g gg)
+      (setq h hh)
+      (values a b c d e f g h))))
+
+(let ((list (multiple-value-list (values-consumer #'values-producer))))
+  (assert (= (length list) 8))
+  (assert (null (nth 7 list))))
 \f
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index a3322d6..f8bb7d6 100644 (file)
--- 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.7.55"
+"0.8.7.56"