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))))

;;;