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

Modified Files:
	integers.lisp 
Log Message:
New and improved EQL. Now it's simply a primitive-function.

Date: Tue Jun  8 18:16:56 2004
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.27 movitz/losp/muerte/integers.lisp:1.28
--- movitz/losp/muerte/integers.lisp:1.27	Tue Jun  8 16:30:24 2004
+++ movitz/losp/muerte/integers.lisp	Tue Jun  8 18:16:56 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.27 2004/06/08 23:30:24 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.28 2004/06/09 01:16:56 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -376,6 +376,41 @@
 		   :ecx)
 	    (:cmpl :ecx
 		   (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
+	    (:ret))))
+    (do-it)))
+
+(define-primitive-function fast-eql (x y)
+  "Compare EAX and EBX under EQL, result in ZF.
+Preserve EAX and EBX."
+  (macrolet
+      ((do-it ()
+	 `(with-inline-assembly (:returns :nothing) ; unspecified
+	    (:cmpl :eax :ebx)		; EQ?
+	    (:je 'done)
+	    (:leal (:eax ,(- (movitz:tag :other))) :ecx)
+	    (:testb 7 :cl)
+	    (:jne 'done)
+	    (:leal (:ebx ,(- (movitz:tag :other))) :ecx)
+	    (:testb 7 :cl)
+	    (:jne 'done)
+	    (:movl (:eax ,movitz:+other-type-offset+) :ecx)
+	    (:cmpb ,(movitz:tag :bignum) :cl)
+	    (:jne 'done)
+	    (:cmpl :ecx (:ebx ,movitz:+other-type-offset+))
+	    (:jne 'done)
+	    ;; Ok.. we have two bignums of identical sign and size.
+	    (:shrl 16 :ecx)
+	    (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) ,movitz:+movitz-fixnum-factor+)
+		   :edx)		; counter
+	   compare-loop
+	    (:subl ,movitz:+movitz-fixnum-factor+ :edx)
+	    (:jz 'done)
+	    (:movl (:eax :edx ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
+		   :ecx)
+	    (:cmpl :ecx
+		   (:ebx :edx ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))))
+	    (:je 'compare-loop)
+	   done
 	    (:ret))))
     (do-it)))