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)