| ... |
... |
@@ -963,31 +963,29 @@ down to individual words.") |
|
963
|
963
|
(setf carry-digit big-carry)
|
|
964
|
964
|
(incf k)))
|
|
965
|
965
|
(setf (%bignum-ref res k) carry-digit)))
|
|
966
|
|
- ;; Apply corrections if either of the arguments is negative.
|
|
967
|
|
- (unless (%bignum-0-or-plusp a len-a)
|
|
968
|
|
- (let ((borrow 1))
|
|
969
|
|
- (dotimes (j len-b)
|
|
970
|
|
- (declare (type bignum-index j))
|
|
971
|
|
- (let ((index (+ j len-a)))
|
|
972
|
|
- (declare (type bignum-index index))
|
|
973
|
|
- (multiple-value-bind (d borrow-out)
|
|
974
|
|
- (%subtract-with-borrow (%bignum-ref res index)
|
|
975
|
|
- (%bignum-ref b j)
|
|
976
|
|
- borrow)
|
|
977
|
|
- (setf (%bignum-ref res index) d)
|
|
978
|
|
- (setf borrow borrow-out))))))
|
|
979
|
|
- (unless (%bignum-0-or-plusp b len-b)
|
|
980
|
|
- (let ((borrow 1))
|
|
981
|
|
- (dotimes (j len-a)
|
|
982
|
|
- (declare (type bignum-index j))
|
|
983
|
|
- (let ((index (+ j len-b)))
|
|
984
|
|
- (declare (type bignum-index index))
|
|
985
|
|
- (multiple-value-bind (d borrow-out)
|
|
986
|
|
- (%subtract-with-borrow (%bignum-ref res index)
|
|
987
|
|
- (%bignum-ref a j)
|
|
988
|
|
- borrow)
|
|
989
|
|
- (setf (%bignum-ref res index) d)
|
|
990
|
|
- (setf borrow borrow-out))))))
|
|
|
966
|
+ (flet ((apply-correction (neg-arg neg-len pos-arg pos-len)
|
|
|
967
|
+ ;; Applies the correction by basically subtracting out
|
|
|
968
|
+ ;; 2^M*b where M is the length (in bits) of b and b is
|
|
|
969
|
+ ;; the positive term in pos-arg. neg-arg is the negative
|
|
|
970
|
+ ;; arg.
|
|
|
971
|
+ (let ((borrow 1))
|
|
|
972
|
+ (dotimes (j pos-len)
|
|
|
973
|
+ (declare (type bignum-index j))
|
|
|
974
|
+ (let ((index (+ j neg-len)))
|
|
|
975
|
+ (declare (type bignum-index index))
|
|
|
976
|
+ (multiple-value-bind (d borrow-out)
|
|
|
977
|
+ (%subtract-with-borrow (%bignum-ref res index)
|
|
|
978
|
+ (%bignum-ref pos-arg j)
|
|
|
979
|
+ borrow)
|
|
|
980
|
+ (setf (%bignum-ref res index) d)
|
|
|
981
|
+ (setf borrow borrow-out)))))))
|
|
|
982
|
+ ;; Apply corrections if either of the arguments is negative.
|
|
|
983
|
+ (unless (%bignum-0-or-plusp a len-a)
|
|
|
984
|
+ ;; A is negative
|
|
|
985
|
+ (apply-correction a len-a b len-b))
|
|
|
986
|
+ (unless (%bignum-0-or-plusp b len-b)
|
|
|
987
|
+ ;; B is negative
|
|
|
988
|
+ (apply-correction b len-b a len-a)))
|
|
991
|
989
|
(%normalize-bignum res len-res)))
|
|
992
|
990
|
|
|
993
|
991
|
(defparameter *min-karatsuba-bits* 512
|