From 5f07d8690bec4b0d020cfa68a93bafef321a192a Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 4 Aug 2004 12:18:12 +0000 Subject: [PATCH] 0.8.13.24: MORE FASTER BIGNUMS ... merge Juho Snellman's bignum-gcd improvement (sbcl-devel 2004-08-02) ... don't wait for sparc numbers since accidents occurred with source trees. --- NEWS | 4 ++++ src/code/bignum.lisp | 33 +++++++++++++++++++++++++++++---- version.lisp-expr | 2 +- 3 files changed, 34 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 9b5326a..93611aa 100644 --- a/NEWS +++ b/NEWS @@ -15,6 +15,10 @@ changes in sbcl-0.8.14 relative to sbcl-0.8.13: left shifts. * bug fix: provide default methods for INPUT-STREAM-P and OUTPUT-STREAM-P specialized on SB-GRAY:FUNDAMENTAL-STREAM. + * optimization: in taking the GCD of bignums, reduce the two bignums + to approximately the same size (using Euclid's algorithm) before + applying the more sophisticated binary GCD. (thanks to Juho + Snellman) changes in sbcl-0.8.13 relative to sbcl-0.8.12: * new feature: SB-PACKAGE-LOCKS. See the "Package Locks" section of diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp index c188965..df1d328 100644 --- a/src/code/bignum.lisp +++ b/src/code/bignum.lisp @@ -540,16 +540,41 @@ (declare (type (mod 32) j)))))))) (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 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. The initial reduction using MOD + ;; is sufficient to get rid of the embarrasing order of magnitude + ;; difference in GCD/LCM performance between SBCL and most other + ;; lisps. + ;; + ;; FIXME: Using a better algorithm (for example Weber's accelerated + ;; integer GCD) would be nice. + ;; -- JES, 2004-07-31 + (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))) diff --git a/version.lisp-expr b/version.lisp-expr index e815118..34d5b6d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.13.23" +"0.8.13.24" -- 1.7.10.4