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

Modified Files:
	integers.lisp 
Log Message:
Fixed a bug in fast-compare-two-reals for negative bignums. Improved
evenp and oddp, and gcd. Removed bogus compiler-macro for ash.

Date: Wed Jul 14 04:01:43 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.54 movitz/losp/muerte/integers.lisp:1.55
--- movitz/losp/muerte/integers.lisp:1.54	Wed Jul 14 03:03:44 2004
+++ movitz/losp/muerte/integers.lisp	Wed Jul 14 04:01:43 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.54 2004/07/14 10:03:44 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.55 2004/07/14 11:01:43 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -41,34 +41,23 @@
 (defun fixnump (x)
   (typep x 'fixnum))
 
-(defun evenp (x)
-  (macrolet
-      ((do-it ()
-	 `(with-inline-assembly (:returns :ebx)
-	    (:compile-form (:result-mode :eax) x)
-	    (:movl :eax :ecx)
-	    (:andl 7 :ecx)
-	    (:globally (:movl (:edi (:edi-offset t-symbol)) :ebx))
-	    (:cmpl ,(movitz:tag :even-fixnum) :ecx)
-	    (:je 'done)
-	    (:movl :edi :ebx)
-	    (:cmpl ,(movitz:tag :odd-fixnum) :ecx)
-	    (:je 'done)
-	    (:cmpl ,(movitz:tag :other) :ecx)
-	    (:jnz '(:sub-program (not-integer)
-		    (:int 107)))
-	    (:cmpb ,(movitz:tag :bignum) (:eax ,movitz:+other-type-offset+))
-	    (:jne 'not-integer)
-	    (:testb 1 (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
-	    (:jnz 'done)
-	    (:globally (:movl (:edi (:edi-offset t-symbol)) :ebx))
-	   done)))
-    (do-it)))
+(define-compiler-macro evenp (x)
+  `(with-inline-assembly (:returns :boolean-zf=1)
+     (:compile-form (:result-mode :eax) ,x)
+     (:call-global-constant unbox-u32)
+     (:testb 1 :cl)))
 
-(defun oddp (x)
-  (not (evenp x)))
+(defun evenp (x)
+  (evenp x))
 
+(define-compiler-macro oddp (x)
+  `(with-inline-assembly (:returns :boolean-zf=0)
+     (:compile-form (:result-mode :eax) ,x)
+     (:call-global-constant unbox-u32)
+     (:testb 1 :cl)))
 
+(defun oddp (x)
+  (oddp x))
 
 ;;; Types
 
@@ -469,6 +458,8 @@
 		 (+ (- subtrahend) minuend))
 		((fixnum bignum)
 		 (- (+ (- minuend) subtrahend)))
+		(((integer 0 *) (integer * -1))
+		 (+ minuend (- subtrahend)))
 		((positive-bignum positive-bignum)
 		 (cond
 		  ((= minuend subtrahend)
@@ -494,8 +485,7 @@
 			       (:eax :edx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
 			(:jc '(:sub-program (should-not-happen)
 			       (:int 107)))
-			)))))
-		)))
+			))))))))
 	(do-it)))
    (t (minuend &rest subtrahends)
       (declare (dynamic-extent subtrahends))
@@ -571,7 +561,8 @@
 		   (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
 	    (:je 'positive-compare-loop)
 	   positive-compare-lsb
-	    ;; Now make the compare unsigned..
+	    ;; Now we have to make the compare act as unsigned, which is why
+	    ;; we compare zero-extended 16-bit quantities.
 	    (: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))))
@@ -608,10 +599,22 @@
 	    (:je 'negative-compare-loop)
 	    (:ret)
 	   negative-compare-lsb		; it's down to the LSB bigits.
-	    (:movl (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))
-		   :ecx)
-	    (:cmpl :ecx
-		   (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
+	    ;; Now we have to make the compare act as unsigned, which is why
+	    ;; we compare zero-extended 16-bit quantities.
+	    (: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 :ecx (:edi (:edi-offset scratch0))))
+	    (:jne 'negative-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 :ecx (:edi (:edi-offset scratch0))))
+	   negative-upper-16-decisive
 	    (:ret))))
     (do-it)))
 
@@ -997,13 +1000,15 @@
 (define-compiler-macro ash (&whole form integer count &environment env)
   (if (not (movitz:movitz-constantp count env))
       form
-    (let ((count (movitz::movitz-eval count env)))
+    (let ((count (movitz:movitz-eval count env)))
       (cond
        ((movitz:movitz-constantp integer env)
 	(ash (movitz::movitz-eval integer env) count))
        ((= 0 count)
 	integer)
-       (t (let ((load-integer `((:compile-form (:result-mode :register) ,integer)
+       (t form
+	  #+igore
+	  (let ((load-integer `((:compile-form (:result-mode :register) ,integer)
 				(:testb ,movitz::+movitz-fixnum-zmask+ (:result-register-low8))
 				(:jnz '(:sub-program () (:int 107) (:jmp (:pc+ -4)))))))
 	    (cond
@@ -2267,9 +2272,9 @@
    (2 (u v)
       ;; Code borrowed from CMUCL.
       (do ((k 0 (1+ k))
-	   (u (abs u) (ash u -1))
-	   (v (abs v) (ash v -1)))
-	  ((oddp (logior u v))
+	   (u (abs u) (truncate u 2))
+	   (v (abs v) (truncate v 2)))
+	  ((or (oddp u) (oddp v))
 	   (do ((temp (if (oddp u) (- v) (ash u -1))
 		      (ash temp -1)))
 	       (nil)