[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp

Frode Vatvedt Fjeld ffjeld at common-lisp.net
Tue Jul 13 13:41:17 UTC 2004

```Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv27082

Modified Files:
integers.lisp
Log Message:
Implement bignum multiplication with a linear rather than a quadratic
algorithm. Quite a bit faster..

Date: Tue Jul 13 06:41:17 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.48 movitz/losp/muerte/integers.lisp:1.49
--- movitz/losp/muerte/integers.lisp:1.48	Mon Jul 12 19:29:15 2004
+++ movitz/losp/muerte/integers.lisp	Tue Jul 13 06:41:17 2004
@@ -9,7 +9,7 @@
;;;; Created at:    Wed Nov  8 18:44:57 2000
;;;; Distribution:  See the accompanying file COPYING.
;;;;
-;;;; \$Id: integers.lisp,v 1.48 2004/07/13 02:29:15 ffjeld Exp \$
+;;;; \$Id: integers.lisp,v 1.49 2004/07/13 13:41:17 ffjeld Exp \$
;;;;
;;;;------------------------------------------------------------------

@@ -1231,6 +1231,7 @@
fixnum-done)))
(((eql 0) t) 0)
(((eql 1) t) y)
+		(((eql -1) t) (- y))
((t fixnum) (* y x))
((fixnum bignum)
(let (r)
@@ -1304,13 +1305,15 @@
positive-result
)))
((positive-bignum positive-bignum)
-		 (do ((mx (* most-positive-fixnum x))
-		      (f y)
-		      (r 0))
-		     ((typep f 'fixnum) (+ r (* f x)))
-		   (setf r (+ r mx))
-		   (setf f (- f most-positive-fixnum))))
-		)))
+		 (if (< x y)
+		     (* y x)
+		   ;; X is the biggest factor.
+		   (let ((r 0) (f 0))
+		     (dotimes (half-bigit (* 2 (%bignum-bigits y)))
+		       (incf r (ash (* (memref y -2 half-bigit :unsigned-byte16) x)
+				    f))
+		       (incf f 16))
+		     r))))))
(do-it)))
(t (&rest factors)
(declare (dynamic-extent factors))

```