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

Modified Files:
	integers.lisp 
Log Message:
Improved support for ratios in compare (i.e. <, <=, >, etc).

Date: Fri Jul 30 14:06:27 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.87 movitz/losp/muerte/integers.lisp:1.88
--- movitz/losp/muerte/integers.lisp:1.87	Tue Jul 27 15:05:14 2004
+++ movitz/losp/muerte/integers.lisp	Fri Jul 30 14:06:27 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.87 2004/07/27 22:05:14 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.88 2004/07/30 21:06:27 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -47,11 +47,12 @@
 	    ;; Check that both numbers are bignums, and compare them.
 	    (:leal (:eax ,(- (movitz:tag :other))) :ecx)
 	    (:testb 7 :cl)
-	    (:jnz '(:sub-program (n1-not-bignum)
-		    (:int 64)))
+	    (:jnz '(:sub-program (go-complicated)
+		    (:globally (:movl (:edi (:edi-offset complicated-compare)) :esi))
+		    (:jmp (:esi (:offset movitz-funobj code-vector%2op)))))
 	    (:movl (:eax ,movitz:+other-type-offset+) :ecx)
 	    (:cmpb ,(movitz:tag :bignum) :cl)
-	    (:jne 'n1-not-bignum)
+	    (:jne 'go-complicated)
 
 	    (:cmpl :eax :ebx)		; If they are EQ, they are certainly =
 	    (:je '(:sub-program (n1-and-n2-are-eq)
@@ -59,12 +60,10 @@
 
 	    (:leal (:ebx ,(- (movitz:tag :other))) :ecx)
 	    (:testb 7 :cl)
-	    (:jnz '(:sub-program (n2-not-bignum)
-		    (:movl :ebx :eax)
-		    (:int 64)))
+	    (:jnz 'go-complicated)
 	    (:movl (:ebx ,movitz:+other-type-offset+) :ecx)
 	    (:cmpb ,(movitz:tag :bignum) :cl)
-	    (:jne 'n2-not-bignum)
+	    (:jne 'go-complicated)
 
 	    (:cmpb :ch (:eax (:offset movitz-bignum sign)))
 	    (:jne '(:sub-program (different-signs)
@@ -184,9 +183,9 @@
 	   n2-not-fixnum
 	    (:leal (:ebx ,(- (movitz:tag :other))) :ecx)
 	    (:testb 7 :cl)
-	    (:jnz '(:sub-program (not-integer)
-		    (:movl :ebx :eax)
-		    (:int 64)))
+	    (:jnz '(:sub-program (go-complicated)
+		    (:globally (:movl (:edi (:edi-offset complicated-compare)) :esi))
+		    (:jmp (:esi (:offset movitz-funobj code-vector%2op)))))
 	    (:movl (:ebx ,movitz:+other-type-offset+) :ecx)
 	    (:cmpw ,(movitz:tag :bignum 0) :cx)
 	    (:jne 'not-plusbignum)
@@ -195,7 +194,7 @@
 	    (:ret)
 	   not-plusbignum
 	    (:cmpw ,(movitz:tag :bignum #xff) :cx)
-	    (:jne 'not-integer)
+	    (:jne 'go-complicated)
 	    ;; compare ebx with something bigger
 	    (:cmpl #x-10000000 :edi)
 	    (:ret))))
@@ -211,8 +210,9 @@
    not-fixnum
     (:leal (:eax #.(cl:- (movitz:tag :other))) :ecx)
     (:testb 7 :cl)
-    (:jnz '(:sub-program (not-integer)
-	    (:int 64)))
+    (:jnz '(:sub-program (go-complicated)
+	    (:globally (:movl (:edi (:edi-offset complicated-compare)) :esi))
+	    (:jmp (:esi (:offset movitz-funobj code-vector%2op)))))
     (:movl (:eax #.movitz:+other-type-offset+) :ecx)
     (:cmpw #.(movitz:tag :bignum 0) :cx)
     (:jne 'not-plusbignum)
@@ -221,10 +221,19 @@
     (:ret)
    not-plusbignum
     (:cmpw #.(movitz:tag :bignum #xff) :cx)
-    (:jne 'not-integer)
+    (:jne 'go-complicated)
     ;; compare ebx with something bigger
     (:cmpl #x10000000 :edi)
     (:ret)))
+
+(defun complicated-compare (x y)
+  (let ((ix (* (numerator x) (denominator y)))
+	(iy (* (numerator y) (denominator x))))
+    (with-inline-assembly (:returns :multiple-values)
+      (:compile-two-forms (:eax :ebx) ix iy)
+      (:call-global-pf fast-compare-two-reals)
+      (:movl 1 :ecx)			; The real result is in EFLAGS.
+      (:movl :edi :eax))))
 
 ;;;