3 (defparameter *immediate-types*
4 (list unbound-marker-widetag base-char-widetag))
6 (defparameter *fun-header-widetags*
7 (list funcallable-instance-header-widetag
8 simple-fun-header-widetag
9 closure-fun-header-widetag
10 closure-header-widetag))
12 (defun canonicalize-headers (headers)
16 (delta (- other-immediate-1-lowtag other-immediate-0-lowtag)))
18 (results (if (= start prev)
21 (dolist (header (sort headers #'<))
25 ((= header (+ prev delta))
34 (defmacro test-type (value target not-p &rest type-codes)
35 ;; Determine what interesting combinations we need to test for.
36 (let* ((type-codes (mapcar #'eval type-codes))
37 (fixnump (and (member even-fixnum-lowtag type-codes)
38 (member odd-fixnum-lowtag type-codes)
40 (lowtags (remove lowtag-limit type-codes :test #'<))
41 (extended (remove lowtag-limit type-codes :test #'>))
42 (immediates (intersection extended *immediate-types* :test #'eql))
43 (headers (set-difference extended *immediate-types* :test #'eql))
44 (function-p (if (intersection headers *fun-header-widetags*)
45 (if (subsetp headers *fun-header-widetags*)
47 (error "can't test for mix of function subtypes ~
48 and normal header types"))
51 (error "At least one type must be supplied for TEST-TYPE."))
54 (when (remove-if (lambda (x)
55 (or (= x even-fixnum-lowtag)
56 (= x odd-fixnum-lowtag)))
58 (error "can't mix fixnum testing with other lowtags"))
60 (error "can't mix fixnum testing with function subtype testing"))
62 (error "can't mix fixnum testing with other immediates"))
64 `(%test-fixnum-and-headers ,value ,target ,not-p
65 ',(canonicalize-headers headers))
66 `(%test-fixnum ,value ,target ,not-p)))
69 (error "can't mix testing of immediates with testing of headers"))
71 (error "can't mix testing of immediates with testing of lowtags"))
72 (when (cdr immediates)
73 (error "can't test multiple immediates at the same time"))
74 `(%test-immediate ,value ,target ,not-p ,(car immediates)))
77 (error "can't test multiple lowtags at the same time"))
79 `(%test-lowtag-and-headers
80 ,value ,target ,not-p ,(car lowtags)
81 ,function-p ',(canonicalize-headers headers))
82 `(%test-lowtag ,value ,target ,not-p ,(car lowtags))))
84 `(%test-headers ,value ,target ,not-p ,function-p
85 ',(canonicalize-headers headers)))
87 (error "nothing to test?")))))