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))
- (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))))
+ (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
#.
(collect ((forms))
(flet ((definition (name lambda-list width pattern)
- ;; We rely on (SUBTYPEP `(UNSIGNED-BYTE ,WIDTH)
- ;; 'BIGNUM-ELEMENT-TYPE)
`(defun ,name ,lambda-list
(flet ((prepare-argument (x)
(declare (integer x))
(etypecase x
((unsigned-byte ,width) x)
- (bignum-element-type (logand x ,pattern))
(fixnum (logand x ,pattern))
- (bignum (logand (%bignum-ref x 0) ,pattern)))))
+ (bignum (logand x ,pattern)))))
(,name ,@(loop for arg in lambda-list
collect `(prepare-argument ,arg)))))))
(loop for infos being each hash-value of sb!c::*modular-funs*