Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31870
Modified Files: integers.lisp Log Message: Fixed bug in ldb%byte that would erroneously return 0 for byte-positions above #x4000.
Date: Sat Sep 17 00:05:46 2005 Author: ffjeld
Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.110 movitz/losp/muerte/integers.lisp:1.111 --- movitz/losp/muerte/integers.lisp:1.110 Thu Sep 1 00:34:14 2005 +++ movitz/losp/muerte/integers.lisp Sat Sep 17 00:05:46 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.110 2005/08/31 22:34:14 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.111 2005/09/16 22:05:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -1053,6 +1053,10 @@ (i 0 (+ i 29))) ((>= i length) (bignum-canonicalize r)) (bignum-set-zerof tmp) + (when (get 'foo 'foo) + (format t "~&i: ~D, y: #x~X ~S/~S~%" i (ldb (byte 29 i) y) + (integer-length x) + (integer-length y))) (bignum-addf r (bignum-shift-leftf (bignum-mulf (bignum-addf tmp x) (ldb (byte 29 i) y)) i))) @@ -1797,7 +1801,8 @@ (:sarl 5 :ecx) (:andl -4 :ecx) (:addl 4 :ecx) - (:cmpl #x4000 :ecx) + (:cmpl ,(* #x4000 movitz:+movitz-fixnum-factor+) + :ecx) (:jae 'position-outside-integer) (:cmpw :cx (:ebx (:offset movitz-bignum length))) (:jc '(:sub-program (position-outside-integer) @@ -2173,7 +2178,14 @@
(defun expt (base-number power-number) "Take base-number to the power-number." - (do ((i 0 (1+ i)) - (r 1 (* r base-number))) - ((>= i power-number) r))) + (etypecase power-number + (positive-fixnum + (do ((i 0 (1+ i)) + (r 1 (* r base-number))) + ((>= i power-number) r) + (declare (index i)))) + (positive-bignum + (do ((i 0 (1+ i)) + (r 1 (* r base-number))) + ((>= i power-number) r)))))