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.

diff --git a/NEWS b/NEWS
index 9b5326a..93611aa 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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"