-(defun test-type-aux (reg temp target not-target not-p lowtags immed hdrs
- function-p)
- (let* ((fixnump (and (member even-fixnum-lowtag lowtags :test #'eql)
- (member odd-fixnum-lowtag lowtags :test #'eql)))
- (lowtags (sort (if fixnump
- (delete even-fixnum-lowtag
- (remove odd-fixnum-lowtag lowtags
- :test #'eql)
- :test #'eql)
- (copy-list lowtags))
- #'<))
- (lowtag (if function-p
- fun-pointer-lowtag
- other-pointer-lowtag))
- (hdrs (sort (copy-list hdrs) #'<))
- (immed (sort (copy-list immed) #'<)))
- (append
- (when immed
- `((inst and ,temp ,reg widetag-mask)
- ,@(if (or fixnump lowtags hdrs)
- (let ((fall-through (gensym)))
- `((let (,fall-through (gen-label))
- ,@(gen-other-immediate-test
- temp (if not-p not-target target)
- fall-through nil immed)
- (emit-label ,fall-through))))
- (gen-other-immediate-test temp target not-target not-p immed))))
- (when fixnump
- `((inst andcc zero-tn ,reg fixnum-tag-mask)
- ,(if (or lowtags hdrs)
- `(inst b :eq ,(if not-p not-target target)
- #!+sparc-v9 ,(if not-p :pn :pt))
- `(inst b ,(if not-p :ne :eq) ,target
- #!+sparc-v9 ,(if not-p :pn :pt)))))
- (when (or lowtags hdrs)
- `((inst and ,temp ,reg lowtag-mask)))
- (when lowtags
- (if hdrs
- (let ((fall-through (gensym)))
- `((let ((,fall-through (gen-label)))
- ,@(gen-range-test temp (if not-p not-target target)
- fall-through nil
- 0 1 (1- lowtag-limit) lowtags)
- (emit-label ,fall-through))))
- (gen-range-test temp target not-target not-p 0 1
- (1- lowtag-limit) lowtags)))
- (when hdrs
- `((inst cmp ,temp ,lowtag)
- (inst b :ne ,(if not-p target not-target)
- #!+sparc-v9 ,(if not-p :pn :pt))
- (inst nop)
- (load-type ,temp ,reg (- ,lowtag))
- ,@(gen-other-immediate-test temp target not-target not-p hdrs))))))