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