0.7.13.4:

        Fix the bug 239.

diff --git a/BUGS b/BUGS
index ca1de10..1b6c039 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1273,27 +1273,6 @@ WORKAROUND:
   compiler gets its hands on the code needing compilation from the REPL,
   it has been macroexpanded several times.
 
   compiler gets its hands on the code needing compilation from the REPL,
   it has been macroexpanded several times.
 

-239:
-  Since 0.7.0:
-  (defun foo (bit-array-2 &optional result-bit-array)
-    (declare (type (array bit) bit-array-2)
-             (type (or (array bit) (member t nil)) result-bit-array))
-    (unless (simple-bit-vector-p bit-array-2)
-      (multiple-value-call
-          (lambda (data1 start1)
-            (multiple-value-call
-                (lambda (data2 start2)
-                  (multiple-value-call
-                      (lambda (data3 start3)
-                        (declare (ignore start3))
-                        (print (list data1 data2)))
-                    (values 0 0)))
-              (values bit-array-2 0)))
-        (values 444 0))))
-
-  Then (foo (make-array 4 :element-type 'bit :adjustable t) nil)
-  must return the same value as it prints, but it returns random garbage.
-

 240:
   "confused lexical/special warnings in MULTIPLE-VALUE-BIND"
   (from tonyms on #lisp IRC 2003-02-25)
 240:
   "confused lexical/special warnings in MULTIPLE-VALUE-BIND"
   (from tonyms on #lisp IRC 2003-02-25)

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index 9c84d29..5f2c6e1 100644 (file)
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -963,7 +963,8 @@
            (ref (print-leaf (ref-leaf node)))
            (basic-combination
             (let ((kind (basic-combination-kind node)))
            (ref (print-leaf (ref-leaf node)))
            (basic-combination
             (let ((kind (basic-combination-kind node)))

-              (format t "~(~A ~A~) c~D"
+              (format t "~(~A~A ~A~) c~D"
+                      (if (node-tail-p node) "tail " "")

                       (if (fun-info-p kind) "known" kind)
                       (type-of node)
                       (cont-num (basic-combination-fun node)))
                       (if (fun-info-p kind) "known" kind)
                       (type-of node)
                       (cont-num (basic-combination-fun node)))

@@ -981,7 +982,9 @@
             (print-continuation (block-start (if-alternative node))))
            (bind
             (write-string "bind ")
             (print-continuation (block-start (if-alternative node))))
            (bind
             (write-string "bind ")

-            (print-leaf (bind-lambda node)))
+            (print-leaf (bind-lambda node))
+            (when (functional-kind (bind-lambda node))
+              (format t " ~S ~S" :kind (functional-kind (bind-lambda node)))))

            (creturn
             (format t "return c~D " (cont-num (return-result node)))
             (print-leaf (return-lambda node)))
            (creturn
             (format t "return c~D " (cont-num (return-result node)))
             (print-leaf (return-lambda node)))

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 0257739..ae4ad08 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -944,12 +944,21 @@
     (cond ((not return))
          ((or next-block call-return)
           (unless (block-delete-p (node-block return))
     (cond ((not return))
          ((or next-block call-return)
           (unless (block-delete-p (node-block return))

+             (when (and (node-tail-p call)
+                        call-return
+                        (not (eq (node-cont call)
+                                 (return-result call-return))))
+               ;; We do not care to give a meaningful continuation to
+               ;; a tail combination, but here we need it.
+               (delete-continuation-use call)
+               (add-continuation-use call (return-result call-return)))

             (move-return-uses fun call
                               (or next-block (node-block call-return)))))
          (t
           (aver (node-tail-p call))
           (setf (lambda-return call-fun) return)
             (move-return-uses fun call
                               (or next-block (node-block call-return)))))
          (t
           (aver (node-tail-p call))
           (setf (lambda-return call-fun) return)

-          (setf (return-lambda return) call-fun))))
+          (setf (return-lambda return) call-fun)
+           (setf (lambda-return fun) nil))))

   (move-let-call-cont fun)
   (values))
 
   (move-let-call-cont fun)
   (values))
 

diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp
index a608dc8..eea3feb 100644 (file)
--- a/tests/compiler-1.impure-cload.lisp
+++ b/tests/compiler-1.impure-cload.lisp
@@ -202,4 +202,27 @@
 (assert (raises-error? (bug231b 0 1.5) type-error))
 (assert (raises-error? (bug231b 0 0) type-error))
 
 (assert (raises-error? (bug231b 0 1.5) type-error))
 (assert (raises-error? (bug231b 0 0) type-error))
 

+;;; A bug appeared in flaky7_branch. Python got lost in unconverting
+;;; embedded tail calls during let-convertion.
+(defun bug239 (bit-array-2 &optional result-bit-array)
+  (declare (type (array bit) bit-array-2)
+           (type (or (array bit) (member t nil)) result-bit-array))
+  (unless (simple-bit-vector-p bit-array-2)
+    (multiple-value-call
+        (lambda (data1 start1)
+          (multiple-value-call
+              (lambda (data2 start2)
+                (multiple-value-call
+                    (lambda (data3 start3)
+                      (declare (ignore start3))
+                      (print (list data1 data2)))
+                  (values 0 0)))
+            (values bit-array-2 0)))
+      (values 444 0))))
+(assert (equal (bug239 (make-array 4 :element-type 'bit
+                                   :adjustable t
+                                   :initial-element 0)
+                       nil)
+               '(444 #*0000)))
+

 (sb-ext:quit :unix-status 104) ; success
 (sb-ext:quit :unix-status 104) ; success

diff --git a/version.lisp-expr b/version.lisp-expr
index 3747e0c..60e97b7 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 

-"0.7.13.3"
+"0.7.13.4"