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

[Frode Vatvedt Fjeld]

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))