Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv6630/src/code
Modified Files:
numbers.lisp
Log Message:
0.8.3.19:
Fix bug in ROUND/FROUND revealed by PFD
... after cmucl-imp/sbcl-devel 2003-08-xx
Remove last vestiges of *GC-NOTIFY-STREAM*
Index: numbers.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/numbers.lisp,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- numbers.lisp 19 Aug 2003 15:42:42 -0000 1.20
+++ numbers.lisp 1 Sep 2003 12:51:08 -0000 1.21
@@ -654,19 +654,21 @@
(if (eql divisor 1)
(round number)
(multiple-value-bind (tru rem) (truncate number divisor)
- (let ((thresh (/ (abs divisor) 2)))
- (cond ((or (> rem thresh)
- (and (= rem thresh) (oddp tru)))
- (if (minusp divisor)
- (values (- tru 1) (+ rem divisor))
- (values (+ tru 1) (- rem divisor))))
- ((let ((-thresh (- thresh)))
- (or (< rem -thresh)
- (and (= rem -thresh) (oddp tru))))
- (if (minusp divisor)
- (values (+ tru 1) (- rem divisor))
- (values (- tru 1) (+ rem divisor))))
- (t (values tru rem)))))))
+ (if (zerop rem)
+ (values tru rem)
+ (let ((thresh (/ (abs divisor) 2)))
+ (cond ((or (> rem thresh)
+ (and (= rem thresh) (oddp tru)))
+ (if (minusp divisor)
+ (values (- tru 1) (+ rem divisor))
+ (values (+ tru 1) (- rem divisor))))
+ ((let ((-thresh (- thresh)))
+ (or (< rem -thresh)
+ (and (= rem -thresh) (oddp tru))))
+ (if (minusp divisor)
+ (values (+ tru 1) (- rem divisor))
+ (values (- tru 1) (+ rem divisor))))
+ (t (values tru rem))))))))
(defun rem (number divisor)
#!+sb-doc
|