[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-serv30017

Modified Files:
	integers.lisp 
Log Message:
Fixed a braino in bignum addition; sometimes carry wasn't propagated
right. I'll have to do the same fix to -.

Date: Wed Jul 14 09:17:58 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.61 movitz/losp/muerte/integers.lisp:1.62
--- movitz/losp/muerte/integers.lisp:1.61	Wed Jul 14 06:53:16 2004
+++ movitz/losp/muerte/integers.lisp	Wed Jul 14 09:17:57 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.61 2004/07/14 13:53:16 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.62 2004/07/14 16:17:57 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -283,7 +283,6 @@
 		   ;; Assume x is smallest.
 		   (with-inline-assembly (:returns :eax :labels (retry-not-size1
 								 not-size1
-								 term-zero
 								 copy-bignum-loop
 								 add-bignum-loop
 								 add-bignum-done
@@ -339,8 +338,14 @@
 			     (:jmp 'add-bignum-done)))
 		     (:addl (:ebx :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))
 			    :ecx)
-		    term-zero
-		     (:adcl :ecx (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
+		     (:jc '(:sub-program (term1-carry)
+			    ;; The digit + carry carried over, ECX = 0
+			    (:movl 1 :ecx)
+			    (:addl 4 :edx)
+			    (:cmpw :dx (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)))
+			    (:jae 'add-bignum-loop)
+			    (:jmp 'add-bignum-done)))
+		     (:addl :ecx (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
 		     (:sbbl :ecx :ecx)
 		     (:negl :ecx)	; ECX = Add's Carry.
 		     (:addl 4 :edx)
@@ -478,7 +483,10 @@
 		       sub-loop
 			(:addl (:ebx :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))
 			       :ecx)
-			(:sbbl :ecx
+			(:jc '(:sub-program (carry-overflow)
+			       ;;
+			       (:break)))
+			(:subl :ecx
 			       (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
 			(:sbbl :ecx :ecx)
 			(:negl :ecx)
@@ -1287,8 +1295,8 @@
 		   ;; 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))
+		       (setf r (+ r (ash (* (memref y -2 half-bigit :unsigned-byte16) x)
+					  f)))
 		       (incf f 16))
 		     r))))))
 	(do-it)))