Commit 228359b6 authored by Raymond Toy's avatar Raymond Toy

Refactor common code into a routine

The code for applying the correction is pretty much identical for each
negative operant, so add a routine to do that.
parent 0f0ac0b6
Pipeline #306 failed with stage
in 24 minutes and 53 seconds
......@@ -963,31 +963,29 @@ down to individual words.")
(setf carry-digit big-carry)
(incf k)))
(setf (%bignum-ref res k) carry-digit)))
;; Apply corrections if either of the arguments is negative.
(unless (%bignum-0-or-plusp a len-a)
(let ((borrow 1))
(dotimes (j len-b)
(declare (type bignum-index j))
(let ((index (+ j len-a)))
(declare (type bignum-index index))
(multiple-value-bind (d borrow-out)
(%subtract-with-borrow (%bignum-ref res index)
(%bignum-ref b j)
borrow)
(setf (%bignum-ref res index) d)
(setf borrow borrow-out))))))
(unless (%bignum-0-or-plusp b len-b)
(let ((borrow 1))
(dotimes (j len-a)
(declare (type bignum-index j))
(let ((index (+ j len-b)))
(declare (type bignum-index index))
(multiple-value-bind (d borrow-out)
(%subtract-with-borrow (%bignum-ref res index)
(%bignum-ref a j)
borrow)
(setf (%bignum-ref res index) d)
(setf borrow borrow-out))))))
(flet ((apply-correction (neg-arg neg-len pos-arg pos-len)
;; Applies the correction by basically subtracting out
;; 2^M*b where M is the length (in bits) of b and b is
;; the positive term in pos-arg. neg-arg is the negative
;; arg.
(let ((borrow 1))
(dotimes (j pos-len)
(declare (type bignum-index j))
(let ((index (+ j neg-len)))
(declare (type bignum-index index))
(multiple-value-bind (d borrow-out)
(%subtract-with-borrow (%bignum-ref res index)
(%bignum-ref pos-arg j)
borrow)
(setf (%bignum-ref res index) d)
(setf borrow borrow-out)))))))
;; Apply corrections if either of the arguments is negative.
(unless (%bignum-0-or-plusp a len-a)
;; A is negative
(apply-correction a len-a b len-b))
(unless (%bignum-0-or-plusp b len-b)
;; B is negative
(apply-correction b len-b a len-a)))
(%normalize-bignum res len-res)))
(defparameter *min-karatsuba-bits* 512
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment