0.7.13.13:

        * SIGNAL-BOUNDING-INDICES-BAD-ERROR accepts any bounding index
          designators;
        * fixed CEILING optimization for a divisor of form 2^k.

diff --git a/NEWS b/NEWS
index fe3d9b2..df41ba2 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1589,6 +1589,7 @@ changes in sbcl-0.7.14 relative to sbcl-0.7.13:
        types got intertwined, has been fixed;
     ** the type system is now able to reason about the interaction
        between INTEGER and RATIO types more completely;
+  * fixed CEILING optimization for a divisor of form 2^k.
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 43bccfd..a2c9d66 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -203,8 +203,6 @@
                              ;; This seems silly, is there something better?
                              '(integer 0 (0))))))
 
-(declaim (ftype (function (sequence index index) nil)
-               signal-bounding-indices-bad-error))
 (defun signal-bounding-indices-bad-error (sequence start end)
   (let ((length (length sequence)))
     (error 'bounding-indices-bad-error

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index eee8310..255bc7e 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1352,7 +1352,8 @@
 ;;; get efficient compilation of the inline expansion of
 ;;; %FIND-POSITION-IF, so it should maybe be in a more
 ;;; compiler-friendly package (SB-INT?)
-(defknown sb!impl::signal-bounding-indices-bad-error (sequence index index)
+(defknown sb!impl::signal-bounding-indices-bad-error
+    (sequence index sequence-end)
   nil) ; never returns
   
 

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 158b276..b78913a 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -2589,7 +2589,8 @@
     (or result 0)))
 
 ;;; If arg is a constant power of two, turn FLOOR into a shift and
-;;; mask. If CEILING, add in (1- (ABS Y)) and then do FLOOR.
+;;; mask. If CEILING, add in (1- (ABS Y)), do FLOOR and correct a
+;;; remainder.
 (flet ((frob (y ceil-p)
         (unless (constant-continuation-p y)
           (give-up-ir1-transform))
@@ -2599,13 +2600,14 @@
           (unless (= y-abs (ash 1 len))
             (give-up-ir1-transform))
           (let ((shift (- len))
-                (mask (1- y-abs)))
-            `(let ,(when ceil-p `((x (+ x ,(1- y-abs)))))
+                (mask (1- y-abs))
+                 (delta (if ceil-p (* (signum y) (1- y-abs)) 0)))
+            `(let ((x (+ x ,delta)))
                ,(if (minusp y)
                     `(values (ash (- x) ,shift)
-                             (- (logand (- x) ,mask)))
+                             (- (- (logand (- x) ,mask)) ,delta))
                     `(values (ash x ,shift)
-                             (logand x ,mask))))))))
+                             (- (logand x ,mask) ,delta))))))))
   (deftransform floor ((x y) (integer integer) *)
     "convert division by 2^k to shift"
     (frob y nil))

diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp
index bef097c..db7cbe5 100644 (file)
--- a/tests/arith.pure.lisp
+++ b/tests/arith.pure.lisp
@@ -73,3 +73,17 @@ ASSERTion fails, probably in something related to bug #194.
 (assert (null (ignore-errors (max 3 #'max))))
 (assert (= (max -3 0) 0))
 ||#
+
+;;; (CEILING x 2^k) was optimized incorrectly
+(loop for divisor in '(-4 4)
+   for ceiler = (compile nil `(lambda (x)
+                                (declare (fixnum x))
+                                (declare (optimize (speed 3)))
+                                (ceiling x ,divisor)))
+   do (loop for i from -5 to 5
+         for exact-q = (/ i divisor)
+         do (multiple-value-bind (q r)
+                (funcall ceiler i)
+              (assert (= (+ (* q divisor) r) i))
+              (assert (<= exact-q q))
+              (assert (< q (1+ exact-q))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 40c387f..a2acd7f 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".)
 
-"0.7.13.12"
+"0.7.13.13"