;;; bignum-logical-and bignum-logical-ior bignum-logical-xor
;;; bignum-logical-not bignum-load-byte bignum-deposit-byte
;;; bignum-truncate bignum-plus-p bignum-compare make-small-bignum
-;;; bignum-logcount
+;;; bignum-logbitp bignum-logcount
;;; These symbols define the interface to the compiler:
;;; bignum-type bignum-element-type bignum-index %allocate-bignum
;;; %bignum-length %bignum-set-length %bignum-ref %bignum-set
(logand x (1- (ash 1 digit-size))))
#!-32x16-divide
-;;; This takes three digits and returns the FLOOR'ed result of dividing the
-;;; first two as a 64-bit integer by the third.
+;;; This takes three digits and returns the FLOOR'ed result of
+;;; dividing the first two as a 64-bit integer by the third.
;;;
-;;; DO WEIRD let AND setq STUFF TO SLIME THE COMPILER INTO ALLOWING THE %FLOOR
-;;; TRANSFORM TO EXPAND INTO PSEUDO-ASSEMBLER FOR WHICH THE COMPILER CAN LATER
-;;; CORRECTLY ALLOCATE REGISTERS.
+;;; Do weird LET and SETQ stuff to bamboozle the compiler into allowing
+;;; the %FLOOR transform to expand into pseudo-assembler for which the
+;;; compiler can later correctly allocate registers.
(defun %floor (a b c)
(let ((a a) (b b) (c c))
(declare (type bignum-element-type a b c))
\f
;;;; GCD
+;;; I'm not sure why I need this FTYPE declaration. Compiled by the
+;;; target compiler, it can deduce the return type fine, but without
+;;; it, we pay a heavy price in BIGNUM-GCD when compiled by the
+;;; cross-compiler. -- CSR, 2004-07-19
+(declaim (ftype (sfunction (bignum-type bignum-index bignum-type bignum-index)
+ (unsigned-byte 29))
+ bignum-factors-of-two))
+(defun bignum-factors-of-two (a len-a b len-b)
+ (declare (type bignum-index len-a len-b) (type bignum-type a b))
+ (do ((i 0 (1+ i))
+ (end (min len-a len-b)))
+ ((= i end) (error "Unexpected zero bignums?"))
+ (declare (type bignum-index i end))
+ (let ((or-digits (%logior (%bignum-ref a i) (%bignum-ref b i))))
+ (unless (zerop or-digits)
+ (return (do ((j 0 (1+ j))
+ (or-digits or-digits (%ashr or-digits 1)))
+ ((oddp or-digits) (+ (* i digit-size) j))
+ (declare (type (mod 32) j))))))))
+
(defun bignum-gcd (a b)
(declare (type bignum-type a b))
(let* ((a (if (%bignum-0-or-plusp a (%bignum-length a))
(bignum-buffer-ashift-right a len-a
(+ (* index digit-size)
increment)))))))
-
-(defun bignum-factors-of-two (a len-a b len-b)
- (declare (type bignum-index len-a len-b) (type bignum-type a))
- (do ((i 0 (1+ i))
- (end (min len-a len-b)))
- ((= i end) (error "Unexpected zero bignums?"))
- (declare (type bignum-index i end))
- (let ((or-digits (%logior (%bignum-ref a i) (%bignum-ref b i))))
- (unless (zerop or-digits)
- (return (do ((j 0 (1+ j))
- (or-digits or-digits (%ashr or-digits 1)))
- ((oddp or-digits) (+ (* i digit-size) j))
- (declare (type (mod 32) j))))))))
\f
;;;; negation
(%normalize-bignum res res-len))
res)))))
((> count bignum-len)
- 0)
+ (if (%bignum-0-or-plusp bignum bignum-len) 0 -1))
;; Since a FIXNUM should be big enough to address anything in
;; memory, including arrays of bits, and since arrays of bits
;; take up about the same space as corresponding fixnums, there
;; should be no way that we fall through to this case: any shift
;; right by a bignum should give zero. But let's check anyway:
- (t (error "bignum overflow: can't shift right by ~S")))))
+ (t (error "bignum overflow: can't shift right by ~S" count)))))
(defun bignum-ashift-right-digits (bignum digits)
(declare (type bignum-type bignum)
(bignum-ashift-left-unaligned bignum digits n-bits res-len))))
;; Left shift by a number too big to be represented as a fixnum
;; would exceed our memory capacity, since a fixnum is big enough
- ;; index any array, including a bit array.
+ ;; to index any array, including a bit array.
(error "can't represent result of left shift")))
(defun bignum-ashift-left-digits (bignum bignum-len digits)
(declare (type bignum-index len))
(let ((exp (+ exp bias)))
(when (> exp max)
- (error "Too large to be represented as a ~S:~% ~S"
- format x))
+ ;; Why a SIMPLE-TYPE-ERROR? Well, this is mainly
+ ;; called by COERCE, which requires an error of
+ ;; TYPE-ERROR if the conversion can't happen
+ ;; (except in certain circumstances when we are
+ ;; coercing to a FUNCTION) -- CSR, 2002-09-18
+ (error 'simple-type-error
+ :format-control "Too large to be represented as a ~S:~% ~S"
+ :format-arguments (list format x)
+ :expected-type format
+ :datum x))
exp)))
(cond
(t
(round-up))))))
\f
-;;;; integer length and logcount
+;;;; integer length and logbitp/logcount
(defun bignum-integer-length (bignum)
(declare (type bignum-type bignum))
(+ (integer-length (%fixnum-digit-with-correct-sign digit))
(* len-1 digit-size))))
+(defun bignum-logbitp (index bignum)
+ (declare (type bignum-type bignum))
+ (let ((len (%bignum-length bignum)))
+ (declare (type bignum-index len))
+ (multiple-value-bind (word-index bit-index)
+ (floor index digit-size)
+ (if (>= word-index len)
+ (not (bignum-plus-p bignum))
+ (not (zerop (logand (%bignum-ref bignum word-index)
+ (ash 1 bit-index))))))))
+
(defun bignum-logcount (bignum)
(declare (type bignum-type bignum))
(let* ((length (%bignum-length bignum))
(defvar *truncate-x*)
(defvar *truncate-y*)
-;;; This divides x by y returning the quotient and remainder. In the general
-;;; case, we shift y to setup for the algorithm, and we use two buffers to save
-;;; consing intermediate values. X gets destructively modified to become the
-;;; remainder, and we have to shift it to account for the initial Y shift.
-;;; After we multiple bind q and r, we first fix up the signs and then return
-;;; the normalized results.
+;;; Divide X by Y returning the quotient and remainder. In the
+;;; general case, we shift Y to set up for the algorithm, and we use
+;;; two buffers to save consing intermediate values. X gets
+;;; destructively modified to become the remainder, and we have to
+;;; shift it to account for the initial Y shift. After we multiple
+;;; bind q and r, we first fix up the signs and then return the
+;;; normalized results.
(defun bignum-truncate (x y)
(declare (type bignum-type x y))
(let* ((x-plusp (%bignum-0-or-plusp x (%bignum-length x)))
(*truncate-y* (1+ len-y)))
(let ((y-shift (shift-y-for-truncate y)))
(shift-and-store-truncate-buffers x len-x y len-y y-shift)
- (values (do-truncate len-x+1 len-y)
- ;; DO-TRUNCATE must execute first.
+ (values (return-quotient-leaving-remainder len-x+1 len-y)
+ ;; Now that RETURN-QUOTIENT-LEAVING-REMAINDER
+ ;; has executed, we just tidy up the remainder
+ ;; (in *TRUNCATE-X*) and return it.
(cond
((zerop y-shift)
(let ((res (%allocate-bignum len-y)))
rem
(%normalize-bignum rem (%bignum-length rem))))))))
-;;; This divides x by y when y is a single bignum digit. BIGNUM-TRUNCATE fixes
-;;; up the quotient and remainder with respect to sign and normalization.
+;;; Divide X by Y when Y is a single bignum digit. BIGNUM-TRUNCATE
+;;; fixes up the quotient and remainder with respect to sign and
+;;; normalization.
;;;
-;;; We don't have to worry about shifting y to make its most significant digit
-;;; sufficiently large for %FLOOR to return 32-bit quantities for the q-digit
-;;; and r-digit. If y is a single digit bignum, it is already large enough
-;;; for %FLOOR. That is, it has some bits on pretty high in the digit.
+;;; We don't have to worry about shifting Y to make its most
+;;; significant digit sufficiently large for %FLOOR to return 32-bit
+;;; quantities for the q-digit and r-digit. If Y is a single digit
+;;; bignum, it is already large enough for %FLOOR. That is, it has
+;;; some bits on pretty high in the digit.
(defun bignum-truncate-single-digit (x len-x y)
(declare (type bignum-index len-x))
(let ((q (%allocate-bignum len-x))
(setf (%bignum-ref rem 0) r)
(values q rem))))
-;;; This divides *truncate-x* by *truncate-y*, and len-x and len-y tell us how
-;;; much of the buffers we care about. TRY-BIGNUM-TRUNCATE-GUESS modifies
-;;; *truncate-x* on each interation, and this buffer becomes our remainder.
+;;; a helper function for BIGNUM-TRUNCATE
+;;;
+;;; Divide *TRUNCATE-X* by *TRUNCATE-Y*, returning the quotient
+;;; and destructively modifying *TRUNCATE-X* so that it holds
+;;; the remainder.
+;;;
+;;; LEN-X and LEN-Y tell us how much of the buffers we care about.
;;;
-;;; *truncate-x* definitely has at least three digits, and it has one more than
-;;; *truncate-y*. This keeps i, i-1, i-2, and low-x-digit happy. Thanks to
-;;; SHIFT-AND-STORE-TRUNCATE-BUFFERS.
-(defun do-truncate (len-x len-y)
+;;; *TRUNCATE-X* definitely has at least three digits, and it has one
+;;; more than *TRUNCATE-Y*. This keeps i, i-1, i-2, and low-x-digit
+;;; happy. Thanks to SHIFT-AND-STORE-TRUNCATE-BUFFERS.
+(defun return-quotient-leaving-remainder (len-x len-y)
(declare (type bignum-index len-x len-y))
(let* ((len-q (- len-x len-y))
;; Add one for extra sign digit in case high bit is on.
(loop
(setf (%bignum-ref q k)
(try-bignum-truncate-guess
- ;; This modifies *truncate-x*. Must access elements each pass.
+ ;; This modifies *TRUNCATE-X*. Must access elements each pass.
(bignum-truncate-guess y1 y2
(%bignum-ref *truncate-x* i)
(%bignum-ref *truncate-x* i-1)
(shiftf i i-1 i-2 (1- i-2)))))
q))
-;;; This takes a digit guess, multiplies it by *truncate-y* for a result one
-;;; greater in length than len-y, and subtracts this result from *truncate-x*.
-;;; Low-x-digit is the first digit of x to start the subtraction, and we know x
-;;; is long enough to subtract a len-y plus one length bignum from it. Next we
-;;; check the result of the subtraction, and if the high digit in x became
-;;; negative, then our guess was one too big. In this case, return one less
-;;; than guess passed in, and add one value of y back into x to account for
-;;; subtracting one too many. Knuth shows that the guess is wrong on the order
-;;; of 3/b, where b is the base (2 to the digit-size power) -- pretty rarely.
+;;; This takes a digit guess, multiplies it by *TRUNCATE-Y* for a
+;;; result one greater in length than LEN-Y, and subtracts this result
+;;; from *TRUNCATE-X*. LOW-X-DIGIT is the first digit of X to start
+;;; the subtraction, and we know X is long enough to subtract a LEN-Y
+;;; plus one length bignum from it. Next we check the result of the
+;;; subtraction, and if the high digit in X became negative, then our
+;;; guess was one too big. In this case, return one less than GUESS
+;;; passed in, and add one value of Y back into X to account for
+;;; subtracting one too many. Knuth shows that the guess is wrong on
+;;; the order of 3/b, where b is the base (2 to the digit-size power)
+;;; -- pretty rarely.
(defun try-bignum-truncate-guess (guess len-y low-x-digit)
(declare (type bignum-index low-x-digit len-y)
(type bignum-element-type guess))
projects / sbcl.git / blobdiff