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)