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