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