Commit 90d8b4b5 authored by Raymond Toy's avatar Raymond Toy

Bignum multiply without consing temp space

The current bignum multiplier creates temp space to hold the absolute
value of the bignums and then negates the result (in-place) at the
end.

Instead, use the algorithm from Hacker's Delight that pretends the
numbers are unsigned, does the unsigned multiply and finally corrects
the result.  No extra memory is needed for this.
parent 23e31483
Pipeline #300 passed with stage
in 21 minutes and 48 seconds
......@@ -916,6 +916,59 @@ down to individual words.")
(when negate-res (negate-bignum-in-place res))
(%normalize-bignum res len-res)))
;; Pretend the bignums are actually unsigned, do an unsigned multiply
;; and then correct the result. This is based on the algorithm in
;; Hacker's Delight.
(defun classical-multiply-bignum-hd (a b)
(declare (type bignum-type a b))
(let* ((len-a (%bignum-length a))
(len-b (%bignum-length b))
(len-res (+ len-a len-b))
(res (%allocate-bignum len-res)))
(negate-res (not (eq a-plusp b-plusp))))
(declare (type bignum-index len-a len-b len-res))
;; Unsigned multiply
(dotimes (i len-a)
(declare (type bignum-index i))
(let ((carry-digit 0)
(x (%bignum-ref a i))
(k i))
(declare (type bignum-index k)
(type bignum-element-type carry-digit x))
(dotimes (j len-b)
(multiple-value-bind (big-carry res-digit)
(%multiply-and-add x (%bignum-ref b j)
(%bignum-ref res k)
carry-digit)
(declare (type bignum-element-type big-carry res-digit))
(setf (%bignum-ref res k) res-digit)
(setf carry-digit big-carry)
(incf k)))
(setf (%bignum-ref res k) carry-digit)))
;; Apply corrections if either of the arguments is negative.
;; If a < 0, subtract b*2^M from the result
(unless(%bignum-0-or-plusp a)
(let ((borrow 1))
(dotimes (j len-b)
(let ((index (+ j len-a)))
(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)
(let ((borrow 1))
(dotimes (j len-a)
(let ((index (+ j len-b)))
(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)))))
(%normalize-bignum res len-res)))
(defparameter *min-karatsuba-bits* 512
"Use Karatsuba if the bignums have at least this many bits")
......
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