Skip to content

Commit

Permalink
0.7.13.13:
Browse files Browse the repository at this point in the history
        * SIGNAL-BOUNDING-INDICES-BAD-ERROR accepts any bounding index
          designators;
        * fixed CEILING optimization for a divisor of form 2^k.
  • Loading branch information
Alexey Dejneka committed Mar 5, 2003
1 parent 1781286 commit 33b3c0e
Show file tree
Hide file tree
Showing 6 changed files with 25 additions and 9 deletions.
1 change: 1 addition & 0 deletions NEWS
Expand Up @@ -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
Expand Down
2 changes: 0 additions & 2 deletions src/code/seq.lisp
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion src/compiler/fndb.lisp
Expand Up @@ -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


Expand Down
12 changes: 7 additions & 5 deletions src/compiler/srctran.lisp
Expand Up @@ -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))
Expand All @@ -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))
Expand Down
14 changes: 14 additions & 0 deletions tests/arith.pure.lisp
Expand Up @@ -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))))))
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -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"

0 comments on commit 33b3c0e

Please sign in to comment.