-(in-package "SB!VM")
+;;;; generic type testing and checking apparatus
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+(in-package "SB!VM")
+\f
(defparameter *immediate-types*
- (list unbound-marker-widetag base-char-widetag))
+ (list unbound-marker-widetag character-widetag))
(defparameter *fun-header-widetags*
(list funcallable-instance-header-widetag
simple-fun-header-widetag
- closure-fun-header-widetag
closure-header-widetag))
(defun canonicalize-headers (headers)
(if (subsetp headers *fun-header-widetags*)
t
(error "can't test for mix of function subtypes ~
- and normal header types"))
+ and normal header types"))
nil)))
(unless type-codes
(error "At least one type must be supplied for TEST-TYPE."))
(lowtags
(when (cdr lowtags)
(error "can't test multiple lowtags at the same time"))
- (if headers
- `(%test-lowtag-and-headers
- ,value ,target ,not-p ,(car lowtags)
- ,function-p ',(canonicalize-headers headers)
- ,@other-args)
- `(%test-lowtag ,value ,target ,not-p ,(car lowtags)
- ,@other-args)))
+ (when headers
+ (error "can't test non-fixnum lowtags and headers at the same time"))
+ `(%test-lowtag ,value ,target ,not-p ,(car lowtags) ,@other-args))
(headers
`(%test-headers ,value ,target ,not-p ,function-p
',(canonicalize-headers headers)