From 2ec04f327a665f5b6cd8193cba31ccfabde22759 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 4 Aug 2004 20:30:47 +0000 Subject: [PATCH] Port of Juho Snellman's faster bignum-gcd, which uses Euclid's algorithm to make the bignums roughly the same size before running binary gcd. --- code/bignum.lisp | 28 ++++++++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/code/bignum.lisp b/code/bignum.lisp index 91f3c7db4..d396d1294 100644 --- a/code/bignum.lisp +++ b/code/bignum.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bignum.lisp,v 1.36 2004/06/29 15:17:54 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bignum.lisp,v 1.37 2004/08/04 20:30:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1118,10 +1118,30 @@ down to individual words.") (negate-bignum a nil))) (b (if (%bignum-0-or-plusp b (%bignum-length b)) b - (negate-bignum b nil))) - (len-a (%bignum-length a)) + (negate-bignum b nil)))) + (declare (type bignum-type a b)) + (when (< a b) + (rotatef a b)) + ;; While the length difference of A and B is sufficiently large, + ;; reduce using MOD (slowish, but it should equalize the sizes of + ;; A and B pretty quickly). After that, use the binary GCD + ;; algorithm to handle the rest. This gives a very large speedup + ;; in cl-bench. + (loop until (and (= (%bignum-length b) 1) (zerop (%bignum-ref b 0))) do + (when (<= (%bignum-length a) (1+ (%bignum-length b))) + (return-from bignum-gcd (bignum-binary-gcd a b))) + (let ((rem (mod a b))) + (if (fixnump rem) + (setf a (make-small-bignum rem)) + (setf a rem)) + (rotatef a b))) + a)) + +(defun bignum-binary-gcd (a b) + (declare (type bignum-type a b)) + (let* ((len-a (%bignum-length a)) (len-b (%bignum-length b))) - (declare (type bignum-index len-a len-b)) + (declare (type bignum-index len-a len-b)) (with-bignum-buffers ((a-buffer len-a a) (b-buffer len-b b) (res-buffer (max len-a len-b))) -- GitLab