[movitz-cvs] CVS update: movitz/losp/muerte/typep.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv16256

Modified Files:
	typep.lisp 
Log Message:
More bignum work.

Date: Sun Jul 18 17:54:34 2004
Author: ffjeld

Index: movitz/losp/muerte/typep.lisp
diff -u movitz/losp/muerte/typep.lisp:1.26 movitz/losp/muerte/typep.lisp:1.27
--- movitz/losp/muerte/typep.lisp:1.26	Wed Jul 14 03:53:24 2004
+++ movitz/losp/muerte/typep.lisp	Sun Jul 18 17:54:34 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Fri Dec  8 11:07:53 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: typep.lisp,v 1.26 2004/07/14 10:53:24 ffjeld Exp $
+;;;; $Id: typep.lisp,v 1.27 2004/07/19 00:54:34 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -69,30 +69,35 @@
 	      (:compile-form (:result-mode :eax) ,object)
 	      (:leal (:eax ,(cl:- (movitz:tag tag-name))) :ecx)
 	      (:testb 7 :cl)))
-	 (make-other-typep (tag-name)
-	   `(with-inline-assembly-case ()
-	      (do-case (:boolean-branch-on-false)
-		(:compile-form (:result-mode :eax) ,object)
-		(:leal (:eax ,(cl:- (movitz:tag :other))) :ecx)
-		(:testb 7 :cl)
-		(:branch-when :boolean-zf=0)
-		(:cmpb ,(movitz:tag tag-name) (:eax ,movitz:+other-type-offset+))
-		(:branch-when :boolean-zf=0))
-	      (do-case (:boolean-branch-on-true :same :labels (other-typep-failed))
-		(:compile-form (:result-mode :eax) ,object)
-		(:leal (:eax ,(cl:- (movitz:tag :other))) :ecx)
-		(:testb 7 :cl)
-		(:jnz 'other-typep-failed)
-		(:cmpb ,(movitz:tag tag-name) (:eax ,movitz:+other-type-offset+))
-		(:branch-when :boolean-zf=1)
-		other-typep-failed)
-	      (do-case (t :boolean-zf=1 :labels (other-typep-failed))
-		(:compile-form (:result-mode :eax) ,object)
-		(:leal (:eax ,movitz:+other-type-offset+) :ecx)
-		(:testb 7 :cl)
-		(:jnz 'other-typep-failed)
-		(:cmpb ,(movitz:tag tag-name) (:eax ,movitz:+other-type-offset+))
-	       other-typep-failed)))
+	 (make-other-typep (tag-name &optional hi-byte)
+	   (let ((cmp (if (not hi-byte)
+			  `(:cmpb ,(movitz:tag tag-name)
+				  (:eax ,movitz:+other-type-offset+))
+			`(:cmpw ,(dpb hi-byte (byte 8 8) (movitz:tag tag-name))
+				(:eax ,movitz:+other-type-offset+)))))
+	     `(with-inline-assembly-case ()
+		(do-case (:boolean-branch-on-false)
+		  (:compile-form (:result-mode :eax) ,object)
+		  (:leal (:eax ,(cl:- (movitz:tag :other))) :ecx)
+		  (:testb 7 :cl)
+		  (:branch-when :boolean-zf=0)
+		  ,cmp
+		  (:branch-when :boolean-zf=0))
+		(do-case (:boolean-branch-on-true :same :labels (other-typep-failed))
+		  (:compile-form (:result-mode :eax) ,object)
+		  (:leal (:eax ,(cl:- (movitz:tag :other))) :ecx)
+		  (:testb 7 :cl)
+		  (:jnz 'other-typep-failed)
+		  ,cmp
+		  (:branch-when :boolean-zf=1)
+		 other-typep-failed)
+		(do-case (t :boolean-zf=1 :labels (other-typep-failed))
+		  (:compile-form (:result-mode :eax) ,object)
+		  (:leal (:eax ,movitz:+other-type-offset+) :ecx)
+		  (:testb 7 :cl)
+		  (:jnz 'other-typep-failed)
+		  ,cmp
+		 other-typep-failed))))
 	 (make-basic-vector-typep (element-type)
 	   (assert (= 1 (- (bt:slot-offset 'movitz::movitz-basic-vector 'movitz::element-type)
 			   (bt:slot-offset 'movitz::movitz-basic-vector 'movitz::type))))
@@ -170,6 +175,10 @@
 		    (:testb ,movitz::+movitz-fixnum-zmask+ :al)))
 		((bignum)
 		 (make-other-typep :bignum))
+		((positive-bignum)
+		 (make-other-typep :bignum 0))
+		((negative-bignum)
+		 (make-other-typep :bignum #xff))
 		((integer number rational)
 		 `(with-inline-assembly-case ()
 		    (do-case (t :boolean-zf=1 :labels (done))