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

Modified Files:
	integers.lisp 
Log Message:
Two fixes: Comparison of bignums was flawed, because the bigits were
compared as signed values, while they in fact are unsigned. So <, >,
=, etc would return the wrong answer in 50% of the cases.
Secondly, added a linear-complexity algorithm for truncate, rather
than the idiotic quadratic one.

Date: Tue Jul 13 12:45:38 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.50 movitz/losp/muerte/integers.lisp:1.51
--- movitz/losp/muerte/integers.lisp:1.50	Tue Jul 13 07:17:05 2004
+++ movitz/losp/muerte/integers.lisp	Tue Jul 13 12:45:38 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.50 2004/07/13 14:17:05 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.51 2004/07/13 19:45:38 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -570,12 +570,22 @@
 	    (:cmpl :ecx
 		   (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
 	    (:je 'positive-compare-loop)
-	    (:ret)
-	   positive-compare-lsb		; it's down to the LSB bigits.
-	    (:movl (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))
-		   :ecx)
-	    (:cmpl :ecx
-		   (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
+	   positive-compare-lsb
+	    ;; Now make the compare unsigned..
+	    (:movzxw (:ebx :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
+		     :ecx)		; First compare upper 16 bits.
+	    (:locally (:movl :ecx (:edi (:edi-offset scratch0))))
+	    (:movzxw (:eax :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
+		     :ecx)
+	    (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx))
+	    (:jne 'upper-16-decisive)
+	    (:movzxw (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))
+		     :ecx)		; Then compare lower 16 bits.
+	    (:locally (:movl :ecx (:edi (:edi-offset scratch0))))
+	    (:movzxw (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))
+		     :ecx)		; Then compare lower 16 bits.
+	    (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx))
+	   upper-16-decisive
 	    (:ret)
 	    
 	   compare-negatives
@@ -1424,10 +1434,23 @@
 	 (cond
 	  ((= number divisor) (values 1 0))
 	  ((< number divisor) (values 0 number))
-	  (t (do ((q 0 (1+ q))
-		  (r number (- r divisor)))
-		 ((< r divisor) (values q r))))))
-	))))
+	  (t (let* ((msb-pos (1- (* 2 (%bignum-bigits divisor))))
+		    (msb (memref divisor -2 msb-pos :unsigned-byte16)))
+	       (when (= 0 msb)
+		 (decf msb-pos)
+		 (setf msb (memref divisor -2 msb-pos :unsigned-byte16))
+		 (assert (plusp msb)))
+	       (do ((msb+1 (1+ msb))
+		    (q 0) (r number))
+		   ((< r divisor) (values q r))
+		 (let ((guess (truncate r msb+1)))
+		   (dotimes (i msb-pos)
+		     (setf guess (truncate guess #x10000)))
+		   (if (= 0 guess)
+		       (setf q (1+ q)
+			     r (- r divisor))
+		     (setf q (+ q guess)
+			   r (- r (* divisor guess))))))))))))))
 
 (defun / (number &rest denominators)
   (declare (dynamic-extent denominators))