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

Modified Files:
	typep.lisp 
Log Message:
Starting to add some bignum support.

Date: Mon May 24 10:59:02 2004
Author: ffjeld

Index: movitz/losp/muerte/typep.lisp
diff -u movitz/losp/muerte/typep.lisp:1.11 movitz/losp/muerte/typep.lisp:1.12
--- movitz/losp/muerte/typep.lisp:1.11	Mon Apr 19 15:51:01 2004
+++ movitz/losp/muerte/typep.lisp	Mon May 24 10:59:01 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.11 2004/04/19 19:51:01 ffjeld Exp $
+;;;; $Id: typep.lisp,v 1.12 2004/05/24 14:59:01 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -170,10 +170,22 @@
 		((t) 't)
 		((nil) 'nil)
 		(null `(not ,object))
-		((fixnum integer number)
+		((fixnum)
 		 `(with-inline-assembly (:returns :boolean-zf=1)
 		    (:compile-form (:result-mode :eax) ,object)
 		    (:testb ,movitz::+movitz-fixnum-zmask+ :al)))
+		((integer number rational)
+		 `(with-inline-assembly-case ()
+		    (do-case (t :boolean-zf=1 :labels (done))
+		      (:compile-form (:result-mode :eax) ,object)
+		      (:testb ,movitz:+movitz-fixnum-zmask+ :al)
+		      (:jz 'done)
+		      (:leal (:eax ,(- (movitz:tag :other))) :ecx)
+		      (:testb 7 :cl)
+		      (:jnz 'done)
+		      (:cmpb ,(movitz:tag :bignum)
+			     (:eax ,movitz:+other-type-offset+))
+		     done)))
 		(symbol
 		 `(with-inline-assembly (:returns :boolean-zf=1)
 		    (:compile-form (:result-mode :eax) ,object)
@@ -246,17 +258,59 @@
 		    ((integer)
 		     (destructuring-bind (&optional (lower-limit '*) (upper-limit '*))
 			 (cdr type)
-		       (let* ((min movitz:+movitz-most-negative-fixnum+)
-			      (max movitz:+movitz-most-positive-fixnum+)
-			      (lower-limit (if (eq lower-limit '*) min lower-limit))
-			      (upper-limit (if (eq upper-limit '*) max upper-limit)))
-			 (assert (<= lower-limit upper-limit) ()
-			   "The lower limit of an integer type must be smaller than the upper limit.")
+		       (let* ((lower-limit (if (eq lower-limit '*) nil lower-limit))
+			      (upper-limit (if (eq upper-limit '*) nil upper-limit)))
+			 (assert (or (null lower-limit)
+				     (null upper-limit)
+				     (<= lower-limit upper-limit)) ()
+			   "The lower limit must be smaller than the upper limit.")
+			 ;; (warn "upper: ~S, loweR: ~S" upper-limit lower-limit)
 			 (cond
-			  ((and (= lower-limit min) (= upper-limit max))
+			  ((and (null lower-limit) (null upper-limit))
 			   `(typep ,object 'integer))
+			  ((null lower-limit)
+			   `(let ((x ,object))
+			      (and (typep x 'integer) (<= x upper-limit))))
+			  ((and (null upper-limit)
+				(= (1+ movitz:+movitz-most-positive-fixnum+) lower-limit))
+			   `(with-inline-assembly-case ()
+			      (do-case (t :boolean-zf=1 :labels (plusp-ok))
+				(:compile-form (:result-mode :eax) ,object)
+				(:leal (:eax ,(- (movitz:tag :other))) :ecx)
+				(:testb 7 :cl)
+				(:jnz 'plusp-ok)
+				(:cmpw ,(movitz:tag :bignum 0)
+				       (:eax ,movitz:+other-type-offset+))
+			       plusp-ok)))
+			  ((and (null upper-limit) (= 0 lower-limit))
+			   `(with-inline-assembly-case ()
+			      (do-case (t :boolean-zf=1 :labels (plusp-ok))
+				(:compile-form (:result-mode :eax) ,object)
+				(:testl ,(logxor #xffffffff
+						 (ash movitz:+movitz-most-positive-fixnum+
+						      movitz:+movitz-fixnum-shift+))
+					:eax)
+				(:jz 'plusp-ok)
+				(:leal (:eax ,(- (movitz:tag :other))) :ecx)
+				(:testb 7 :cl)
+				(:jnz 'plusp-ok)
+				(:cmpw ,(movitz:tag :bignum 0)
+				       (:eax ,movitz:+other-type-offset+))
+			       plusp-ok)))
+			  ((null upper-limit)
+			   `(let ((x ,object))
+			      (and (typep x 'integer) (>= x ,lower-limit))))
 			  ((= lower-limit upper-limit)
 			   `(eql ,object ,lower-limit))
+			  ((or (not (<= movitz:+movitz-most-negative-fixnum+
+					upper-limit
+					movitz:+movitz-most-positive-fixnum+))
+			       (not (<= movitz:+movitz-most-negative-fixnum+
+					lower-limit
+					movitz:+movitz-most-positive-fixnum+)))
+			   `(let ((x ,object))
+			      (and (typep x 'integer)
+				   (<= ,lower-limit x ,upper-limit))))
 			  ((and (= lower-limit 0)
 				(= 1 (logcount (1+ upper-limit))))
 			   `(with-inline-assembly (:returns :boolean-zf=1)