(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
if INTEGER is negative."
(etypecase integer
(fixnum
- (logcount (truly-the (integer 0 #.(max most-positive-fixnum
- (lognot most-negative-fixnum)))
+ (logcount (truly-the (integer 0
+ #.(max sb!xc:most-positive-fixnum
+ (lognot sb!xc:most-negative-fixnum)))
(if (minusp (truly-the fixnum integer))
(lognot (truly-the fixnum integer))
integer))))
(defun logbitp (index integer)
#!+sb-doc
"Predicate returns T if bit index of integer is a 1."
- (logbitp index integer))
+ (number-dispatch ((index integer) (integer integer))
+ ((fixnum fixnum) (if (> index #.(- sb!vm:n-word-bits sb!vm:n-lowtag-bits))
+ (minusp integer)
+ (not (zerop (logand integer (ash 1 index))))))
+ ((fixnum bignum) (bignum-logbitp index integer))
+ ((bignum (foreach fixnum bignum)) (minusp integer))))
(defun ash (integer count)
#!+sb-doc
(defun two-arg-lcm (n m)
(declare (integer n m))
- (* (truncate (max n m) (gcd n m)) (min n m)))
+ (if (or (zerop n) (zerop m))
+ 0
+ ;; KLUDGE: I'm going to assume that it was written this way
+ ;; originally for a reason. However, this is a somewhat
+ ;; complicated way of writing the algorithm in the CLHS page for
+ ;; LCM, and I don't know why. To be investigated. -- CSR,
+ ;; 2003-09-11
+ (let ((m (abs m))
+ (n (abs n)))
+ (multiple-value-bind (max min)
+ (if (> m n)
+ (values m n)
+ (values n m))
+ (* (truncate max (gcd n m)) min)))))
;;; Do the GCD of two integer arguments. With fixnum arguments, we use the
;;; binary GCD algorithm from Knuth's seminumerical algorithms (slightly
;;; of 0 before the dispatch so that the bignum code doesn't have to worry
;;; about "small bignum" zeros.
(defun two-arg-gcd (u v)
- (cond ((eql u 0) v)
- ((eql v 0) u)
+ (cond ((eql u 0) (abs v))
+ ((eql v 0) (abs u))
(t
(number-dispatch ((u integer) (v integer))
((fixnum fixnum)