Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv17823
Modified Files:
typep.lisp
Log Message:
Added a type pointer, which is approximately (not (or character fixnum null)).
Date: Wed Mar 24 06:24:53 2004
Author: ffjeld
Index: movitz/losp/muerte/typep.lisp
diff -u movitz/losp/muerte/typep.lisp:1.3 movitz/losp/muerte/typep.lisp:1.4
--- movitz/losp/muerte/typep.lisp:1.3 Thu Feb 26 08:43:00 2004
+++ movitz/losp/muerte/typep.lisp Wed Mar 24 06:24:52 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.3 2004/02/26 13:43:00 ffjeld Exp $
+;;;; $Id: typep.lisp,v 1.4 2004/03/24 11:24:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -187,6 +187,15 @@
(tag4 (make-tag-typep :tag4))
(tag5 (make-tag-typep :null))
(tag6 (make-tag-typep :other))
+ (pointer
+ `(with-inline-assembly-case ()
+ (do-case (t :boolean-zf=0 :labels (done))
+ (:compile-form (:result-mode :eax) ,object)
+ (:testb ,movitz::+movitz-fixnum-zmask+ :al)
+ (:jz 'done)
+ (:leal (:eax 6) :ecx) ; => cons:7, other:4, symbol:5, fixnum:6
+ (:testb #b100 :cl)
+ done)))
(std-instance
(make-other-typep :std-instance)
#+ignore (make-tag-typep :std-instance))
@@ -205,7 +214,7 @@
(character
`(with-inline-assembly (:returns :boolean-zf=1)
(:compile-form (:result-mode :eax) ,object)
- (:cmpb ,(movitz::tag :character) :al)))
+ (:cmpb ,(movitz:tag :character) :al)))
((function compiled-function)
(make-other-typep :funobj))
((vector array)
@@ -327,10 +336,14 @@
(define-simple-typep (cons consp) (obj)
(typep obj 'cons))
+(define-simple-typep (pointer pointerp) (obj)
+ (typep obj 'pointer))
+
(define-typep cons (x &optional (car '*) (cdr '*))
(and (typep x 'cons)
(or (eq '* car) (typep (car x) car))
(or (eq '* cdr) (typep (cdr x) cdr))))
+
(define-simple-typep (atom atom) (x)
(typep x 'atom))