From 94c2742698f7e27eabae90ad880c8734b776bd0e Mon Sep 17 00:00:00 2001 From: chiles <chiles> Date: Wed, 3 Oct 1990 11:38:03 +0000 Subject: [PATCH] William and Bill installed fixes to multiplication and the multiplication loop in truncation (trying a guess). We created a new primitive to multiply two digits and add three digits to support a more tense multiply loop. We also used this in fixnum X bignum. William fixed subtract by noticing a situation where the result needs to be one larger than the old assumption. --- code/bignum.lisp | 168 +++++++++++++++++++++++------------------------ 1 file changed, 83 insertions(+), 85 deletions(-) diff --git a/code/bignum.lisp b/code/bignum.lisp index d1863802e..067fe1794 100644 --- a/code/bignum.lisp +++ b/code/bignum.lisp @@ -182,6 +182,22 @@ (declare (type bignum-element-type x y)) (%multiply x y)) +;;; %MULTIPLY-AND-ADD -- Internal. +;;; +;;; This multiplies x-digit and y-digit, producing high and low digits +;;; manifesting the result. Then it adds the low digit, res-digit, and +;;; carry-in-digit. Any carries (note, you still have to add two digits at a +;;; time possibly producing two carries) from adding these three digits get +;;; added to the high digit from the multiply, producing the next carry digit. +;;; Res-digit is optional since two uses of this primitive multiplies a single +;;; digit bignum by a multiple digit bignum, and in this situation there is no +;;; need for a result buffer accumulating partial results which is where the +;;; res-digit comes from. +;;; +(defun %multiply-and-add (x-digit y-digit carry-in-digit &optional (res-digit 0)) + (declare (type bignum-element-type x-digit y-digit res-digit carry-in-digit)) + (%multiple-and-add x-digit y-digit carry-in-digit res-digit)) + ;;; %LOGNOT -- Internal. ;;; (defun %lognot (digit) @@ -402,7 +418,7 @@ (declare (type bignum-type a b)) (let* ((len-a (%bignum-length a)) (len-b (%bignum-length b)) - (len-res (max len-a len-b)) + (len-res (1+ (max len-a len-b))) (res (%allocate-bignum len-res))) (declare (type bignum-index len-a len-b len-res)) ;Test len-res for bounds? (subtract-bignum-loop a len-a b len-b res len-res %normalize-bignum))) @@ -466,26 +482,21 @@ (declare (type bignum-index len-a len-a-1 len-b len-res)) (dotimes (i len-a) (declare (type bignum-index i)) - (let ((carry 0) + (let ((carry-digit 0) (x (%bignum-ref a i)) (k i)) - (declare (type bignum-index k)) + (declare (type bignum-index k) + (type bignum-element-type carry-digit x)) (dotimes (j len-b (unless (= i len-a-1) - (setf (%bignum-ref res (1+ k)) carry))) - (multiple-value-bind (high-digit low-digit) - (%multiply x (%bignum-ref b j)) - (multiple-value-bind (res-low-digit temp-carry) - (%add-with-carry low-digit (%bignum-ref res k) - carry) - (setf (%bignum-ref res k) res-low-digit) - (incf k) - (multiple-value-bind (res-high-digit temp-carry) - (%add-with-carry high-digit - (%bignum-ref res k) - temp-carry) - (setf (%bignum-ref res k) res-high-digit) - (setf carry temp-carry))))))) + (setf (%bignum-ref res k) carry-digit))) + (multiple-value-bind (res-digit big-carry) + (%multiply-and-add x (%bignum-ref b j) + (%bignum-ref res k) + carry-digit) + (setf (%bignum-ref res k) final-low-digit) + (setf carry-digit big-carry) + (incf k))))) (when negate-res (negate-bignum-in-place res)) (%normalize-bignum res len-res))) @@ -497,28 +508,23 @@ (bignum-len (%bignum-length bignum)) (fixnum (%fixnum-to-digit (if fixnum-plus-p fixnum (- fixnum)))) (result (%allocate-bignum (1+ bignum-len))) - (carry 0)) + (carry-digit 0)) (declare (type bignum-type bignum result) (type bignum-index bignum-len) - (type bignum-element-type fixnum carry)) + (type bignum-element-type fixnum carry-digit)) (dotimes (index bignum-len) (declare (type bignum-index index)) (multiple-value-bind - (high low) - (%multiply (%bignum-ref bignum index) fixnum) - (declare (type bignum-element-type high low)) - (multiple-value-bind - (digit new-carry) - (%add-with-carry low carry 0) - (declare (type bignum-element-type digit new-carry)) - (setf (%bignum-ref result index) digit) - (setf carry (%add-with-carry high new-carry 0)))) - (setf (%bignum-ref result bignum-len) carry)) + (next-digit low) + (%multiply-and-add (%bignum-ref bignum index) fixnum carry-digit) + (declare (type bignum-element-type next-digit low)) + (setf carry-digit next-digit) + (setf (%bignum-ref result index) low))) + (setf (%bignum-ref result bignum-len) carry-digit) (unless (eq bignum-plus-p fixnum-plus-p) (negate-bignum-in-place result)) (%normalize-bignum result (1+ bignum-len)))) - (defun multiply-fixnums (a b) (declare (fixnum a b)) (let* ((a-minusp (minusp a)) @@ -539,6 +545,7 @@ (unless (eq a-minusp b-minusp) (negate-bignum-in-place res)) (%normalize-bignum res 2)))))) + ;;;; GCD. @@ -595,8 +602,12 @@ (defun bignum-gcd (a b) (declare (type bignum-type a b)) - (let* ((a (if (%bignum-0-or-plusp a (%bignum-length a)) a (negate-bignum a))) - (b (if (%bignum-0-or-plusp b (%bignum-length b)) b (negate-bignum b))) + (let* ((a (if (%bignum-0-or-plusp a (%bignum-length a)) + a + (negate-bignum a nil))) + (b (if (%bignum-0-or-plusp b (%bignum-length b)) + b + (negate-bignum b nil))) (len-a (%bignum-length a)) (len-b (%bignum-length b))) (declare (type bignum-index len-a len-b)) @@ -729,7 +740,12 @@ ) ;EVAL-WHEN -(defun negate-bignum (x) +;;; NEGATE-BIGNUM -- Public. +;;; +;;; Fully-normalize is an internal optional. It cause this to always return +;;; a bignum, without any extraneous digits, and it never returns a fixnum. +;;; +(defun negate-bignum (x &optional (fully-normalize t)) (declare (type bignum-type x)) (let* ((len-x (%bignum-length x)) (len-res (1+ len-x)) @@ -738,7 +754,9 @@ (let ((carry (bignum-negate-loop x len-x res))) (setf (%bignum-ref res len-x) (%add-with-carry (%lognot (%sign-digit x len-x)) 0 carry))) - (%normalize-bignum res len-res))) + (if fully-normalize + (%normalize-bignum res len-res) + (%mostly-normalize-bignum res len-res)))) ;;; NEGATE-BIGNUM-IN-PLACE -- Internal. ;;; @@ -1112,35 +1130,6 @@ ;;;; Integer length and logcount -#| Original Bill code: - -(defun bignum-integer-length (bignum) - (declare (type bignum-type bignum)) - (let* ((len (%bignum-length bignum)) - (len-1 (1- len)) - (plusp (%bignum-0-or-plusp bignum len))) - (if plusp - (let ((digit (%bignum-ref bignum len-1))) - (declare (type bignum-element-type digit)) - (if (zerop digit) - (* len-1 digit-size) - (+ (* len-1 digit-size) - (dotimes (i digit-size) - (when (zerop digit) (return i)) - (setf digit (ash digit -1)))))) - (multiple-value-bind (carry last-digit) - (bignum-negate-loop bignum len) - (declare (type bignum-element-type last-digit)) - (unless (zerop carry) - (error "Unexpected non-zero negation carry.")) - (+ (* len-1 digit-size) - (dotimes (i digit-size digit-size) - (when (zerop last-digit) (return i)) - (setf last-digit (ash last-digit -1)))))))) - - -|# - (defun bignum-integer-length (bignum) (declare (type bignum-type bignum)) (let* ((len (%bignum-length bignum)) @@ -1933,8 +1922,8 @@ (declare (type bignum-type x y)) (let* ((x-plusp (%bignum-0-or-plusp x (%bignum-length x))) (y-plusp (%bignum-0-or-plusp y (%bignum-length y))) - (x (if x-plusp x (negate-bignum x))) - (y (if y-plusp y (negate-bignum y))) + (x (if x-plusp x (negate-bignum x nil))) + (y (if y-plusp y (negate-bignum y nil))) (len-x (%bignum-length x)) (len-y (%bignum-length y))) (multiple-value-bind @@ -2058,33 +2047,26 @@ (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)) - (let ((carry 0) - (guess*y-hold 0) + (let ((carry-digit 0) (borrow 1) (i low-x-digit)) - (declare (type bignum-element-type guess*y-hold) + (declare (type bignum-element-type carry-digit) (type bignum-index i) - (fixnum carry borrow)) + (fixnum borrow)) ;; Multiply guess and divisor, subtracting from dividend simultaneously. (dotimes (j len-y) (multiple-value-bind (high-digit low-digit) - (%multiply guess (%bignum-ref *truncate-y* j)) + (%multiply-and-add guess (%bignum-ref *truncate-y* j) + carry-digit) (declare (type bignum-element-type high-digit low-digit)) - (multiple-value-bind (low-digit temp-carry) - (%add-with-carry low-digit guess*y-hold carry) - (declare (type bignum-element-type low-digit)) - (multiple-value-bind (high-digit temp-carry) - (%add-with-carry high-digit temp-carry 0) - (declare (type bignum-element-type high-digit)) - (setf guess*y-hold high-digit) - (setf carry temp-carry) - (multiple-value-bind (x temp-borrow) - (%subtract-with-borrow - (%bignum-ref *truncate-x* i) - low-digit borrow) - (declare (type bignum-element-type x)) - (setf (%bignum-ref *truncate-x* i) x) - (setf borrow temp-borrow))))) + (setf carry-digit high-digit) + (multiple-value-bind (x temp-borrow) + (%subtract-with-borrow (%bignum-ref *truncate-x* i) + low-digit borrow) + (declare (type bignum-element-type x) + (fixnum temp-borrow)) + (setf (%bignum-ref *truncate-x* i) x) + (setf borrow temp-borrow))) (incf i)) (setf (%bignum-ref *truncate-x* i) (%subtract-with-borrow (%bignum-ref *truncate-x* i) @@ -2556,3 +2538,19 @@ (%fixnum-digit-with-correct-sign digit) result)) result))) + +;;; %MOSTLY-NORMALIZE-BIGNUM -- Internal. +;;; +;;; This drops the last digit if it is unnecessary sign information. It +;;; repeats this as needed, possibly ending with a fixnum magnitude but never +;;; returning a fixnum. +;;; +(defun %mostly-normalize-bignum (result len) + (declare (type bignum-type result) + (type bignum-index len) + #+nil(inline %normalize-bignum-buffer)) + (let ((newlen (%normalize-bignum-buffer result len))) + (declare (type bignum-index newlen)) + (unless (= newlen len) + (%bignum-set-length result newlen)) + result)) -- GitLab