0.8.21.1:

        * Fix inference of the upper bound of an iteration variable.
          (reported by Rajat Datta).
        * Fix MISC.549 and similar: in cast merging in IR1
          finalization set the node derived type directly, not through
          DERIVE-NODE-TYPE, which could try to optimize code.

diff --git a/NEWS b/NEWS
index d86d7e6..451b396 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,11 @@
+changes in sbcl-0.8.22 relative to sbcl-0.8.21:
+  * fixed inference of the upper bound of an iteration variable.
+    (reported by Rajat Datta).
+  * fixed some bugs revealed by Paul Dietz' test suite:
+    ** MISC.549 and similar: late transformation of unsafe type
+       assertions into derived types caused unexpected code
+       transformations.
+
 changes in sbcl-0.8.21 (0.9alpha.1?) relative to sbcl-0.8.20:
   * incompatible change: thread support for non-NPTL systems has
     been removed - locking is buggy and unreliable.  A threaded 

diff --git a/src/compiler/ir1final.lisp b/src/compiler/ir1final.lisp
index 4f79cf8..b2c55f0 100644 (file)
--- a/src/compiler/ir1final.lisp
+++ b/src/compiler/ir1final.lisp
@@ -117,14 +117,19 @@
         (cond ((and (cast-p dest)
                     (not (cast-type-check dest))
                     (immediately-used-p lvar node))
-               (when (values-types-equal-or-intersect
-                      (node-derived-type node)
-                      (cast-asserted-type dest))
-                 ;; FIXME: We do not perform pathwise CAST->type-error
-                 ;; conversion, and type errors can later cause
-                 ;; backend failures. On the other hand, this version
-                 ;; produces less efficient code.
-                 (derive-node-type node (cast-asserted-type dest))))
+               (let ((dtype (node-derived-type node))
+                     (atype (node-derived-type dest)))
+                 (when (values-types-equal-or-intersect
+                        dtype atype)
+                   ;; FIXME: We do not perform pathwise CAST->type-error
+                   ;; conversion, and type errors can later cause
+                   ;; backend failures. On the other hand, this version
+                   ;; produces less efficient code.
+                   ;;
+                   ;; This is sorta DERIVE-NODE-TYPE, but does not try
+                   ;; to optimize the node.
+                   (setf (node-derived-type node)
+                         (values-type-intersection dtype atype)))))
               ((and (cast-p node)
                     (eq (cast-type-check node) :external))
                (aver (basic-combination-p dest))

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index d35a1a2..6517d35 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1221,11 +1221,21 @@
                  (values (numeric-type-low initial-type)
                          (when (and (numeric-type-p set-type)
                                     (numeric-type-equal set-type initial-type))
-                           (numeric-type-high set-type))))
+                           (flet ((max* (i j)
+                                    (cond ((eq i nil) nil)
+                                          ((eq j nil) nil)
+                                          (t (max i j)))))
+                             (max* (numeric-type-high initial-type)
+                                   (numeric-type-high set-type))))))
                 ((csubtypep step-type (specifier-type '(real * 0)))
                  (values (when (and (numeric-type-p set-type)
                                     (numeric-type-equal set-type initial-type))
-                           (numeric-type-low set-type))
+                           (flet ((min* (i j)
+                                    (cond ((eq i nil) nil)
+                                          ((eq j nil) nil)
+                                          (t (min i j)))))
+                           (min* (numeric-type-low initial-type)
+                                 (numeric-type-low set-type))))
                          (numeric-type-high initial-type)))
                 (t
                  (values nil nil)))

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index 9a2d2f6..39c4d18 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -391,5 +391,22 @@
            (foo-b (z) (foo-a z)))
     (declare (inline foo-a))
     (foo-a x)))
+
+;;; broken inference of an upper bound of an iteration variable,
+;;; reported by Rajat Datta.
+(defun isieve (num)
+  (let ((vec (make-array num :initial-element 0))
+        (acc 0))
+    (do ((i 2 (+ i 1)))
+        ((>= i num) 'done)
+      (when (= (svref vec i) 0)
+        (do ((j (* i i) (+ j i)))
+            ((>= j num) 'done)
+          (setf (svref vec j) 1))
+        (incf acc)))
+    acc))
+
+(assert (= (isieve 46349) 4792))
+
 \f
 (sb-ext:quit :unix-status 104)

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index cf08c46..514ec6f 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1739,3 +1739,16 @@
   (compile nil '(lambda (x y)
                 (declare (type simple-bit-vector x y))
                 (equal x y))))
+
+;;; MISC.550: CAST merging in IR1 finalization caused unexpected
+;;; code transformations.
+(assert (eql (funcall
+  (compile
+   nil
+   '(lambda (p1 p2)
+     (declare (optimize (speed 3) (safety 2) (debug 3) (space 3))
+      (type atom p1)
+      (type symbol p2))
+     (or p1 (the (eql t) p2))))
+   nil t)
+  t))

diff --git a/version.lisp-expr b/version.lisp-expr
index 651560e..a88d819 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.21"
+"0.8.21.1"