(defparameter *immediate-types*
(list unbound-marker-type base-char-type))
-(defparameter *function-header-types*
+(defparameter *fun-header-types*
(list funcallable-instance-header-type
- function-header-type
- closure-function-header-type
+ simple-fun-header-type
+ closure-fun-header-type
closure-header-type))
(defun canonicalize-headers (headers)
(collect ((results))
(let ((start nil)
(prev nil)
- (delta (- other-immediate-1-type other-immediate-0-type)))
+ (delta (- other-immediate-1-lowtag other-immediate-0-lowtag)))
(flet ((emit-test ()
(results (if (= start prev)
start
(macrolet ((test-type (value target not-p &rest type-codes)
;; Determine what interesting combinations we need to test for.
(let* ((type-codes (mapcar #'eval type-codes))
- (fixnump (and (member even-fixnum-type type-codes)
- (member odd-fixnum-type type-codes)
+ (fixnump (and (member even-fixnum-lowtag type-codes)
+ (member odd-fixnum-lowtag type-codes)
t))
(lowtags (remove lowtag-limit type-codes :test #'<))
(extended (remove lowtag-limit type-codes :test #'>))
(immediates (intersection extended *immediate-types* :test #'eql))
(headers (set-difference extended *immediate-types* :test #'eql))
- (function-p (if (intersection headers *function-header-types*)
- (if (subsetp headers *function-header-types*)
+ (function-p (if (intersection headers *fun-header-types*)
+ (if (subsetp headers *fun-header-types*)
t
(error "can't test for mix of function subtypes ~
and normal header types"))
(cond
(fixnump
(when (remove-if #'(lambda (x)
- (or (= x even-fixnum-type)
- (= x odd-fixnum-type)))
+ (or (= x even-fixnum-lowtag)
+ (= x odd-fixnum-lowtag)))
lowtags)
(error "can't mix fixnum testing with other lowtags"))
(when function-p
(defun %test-headers (value target not-p function-p headers
&optional (drop-through (gen-label)) al-loaded)
- (let ((lowtag (if function-p function-pointer-type other-pointer-type)))
+ (let ((lowtag (if function-p fun-pointer-lowtag other-pointer-lowtag)))
(multiple-value-bind (equal less-or-equal when-true when-false)
;; EQUAL and LESS-OR-EQUAL are the conditions for branching to TARGET.
;; WHEN-TRUE and WHEN-FALSE are the labels to branch to when we know
#+nil
(defun %test-headers (value target not-p function-p headers
&optional (drop-through (gen-label)) al-loaded)
- (let ((lowtag (if function-p function-pointer-type other-pointer-type)))
+ (let ((lowtag (if function-p fun-pointer-lowtag other-pointer-lowtag)))
(multiple-value-bind (equal less-or-equal when-true when-false)
;; EQUAL and LESS-OR-EQUAL are the conditions for branching to TARGET.
;; WHEN-TRUE and WHEN-FALSE are the labels to branch to when we know
`((primitive-type-vop ,check-name (:check) ,ptype))))))
(def-simple-type-vops fixnump check-fixnum fixnum object-not-fixnum-error
- even-fixnum-type odd-fixnum-type)
+ even-fixnum-lowtag odd-fixnum-lowtag)
(def-type-vops functionp check-function function
- object-not-function-error function-pointer-type)
+ object-not-function-error fun-pointer-lowtag)
(def-type-vops listp check-list list object-not-list-error
- list-pointer-type)
+ list-pointer-lowtag)
(def-type-vops %instancep check-instance instance object-not-instance-error
- instance-pointer-type)
+ instance-pointer-lowtag)
(def-type-vops bignump check-bignum bignum
object-not-bignum-error bignum-type)
simple-array-type complex-string-type complex-bit-vector-type
complex-vector-type complex-array-type)
-(def-type-vops nil check-function-or-symbol nil
- object-not-function-or-symbol-error
- function-pointer-type symbol-header-type)
-
(def-type-vops stringp check-string nil object-not-string-error
simple-string-type complex-string-type)
complex-array-type)
(def-type-vops numberp check-number nil object-not-number-error
- even-fixnum-type odd-fixnum-type bignum-type ratio-type
+ even-fixnum-lowtag odd-fixnum-lowtag bignum-type ratio-type
single-float-type double-float-type #!+long-float long-float-type complex-type
complex-single-float-type complex-double-float-type
#!+long-float complex-long-float-type)
(def-type-vops rationalp check-rational nil object-not-rational-error
- even-fixnum-type odd-fixnum-type ratio-type bignum-type)
+ even-fixnum-lowtag odd-fixnum-lowtag ratio-type bignum-type)
(def-type-vops integerp check-integer nil object-not-integer-error
- even-fixnum-type odd-fixnum-type bignum-type)
+ even-fixnum-lowtag odd-fixnum-lowtag bignum-type)
(def-type-vops floatp check-float nil object-not-float-error
single-float-type double-float-type #!+long-float long-float-type)
(def-type-vops realp check-real nil object-not-real-error
- even-fixnum-type odd-fixnum-type ratio-type bignum-type
+ even-fixnum-lowtag odd-fixnum-lowtag ratio-type bignum-type
single-float-type double-float-type #!+long-float long-float-type)
\f
;;;; other integer ranges
(inst jmp :e yep)
(move eax-tn value)
(inst and al-tn lowtag-mask)
- (inst cmp al-tn other-pointer-type)
+ (inst cmp al-tn other-pointer-lowtag)
(inst jmp :ne nope)
- (loadw eax-tn value 0 other-pointer-type)
+ (loadw eax-tn value 0 other-pointer-lowtag)
(inst cmp eax-tn (+ (ash 1 type-bits) bignum-type))
(inst jmp (if not-p :ne :e) target))
NOT-TARGET))
(inst jmp :e yep)
(move eax-tn value)
(inst and al-tn lowtag-mask)
- (inst cmp al-tn other-pointer-type)
+ (inst cmp al-tn other-pointer-lowtag)
(inst jmp :ne nope)
- (loadw eax-tn value 0 other-pointer-type)
+ (loadw eax-tn value 0 other-pointer-lowtag)
(inst cmp eax-tn (+ (ash 1 type-bits) bignum-type))
(inst jmp :ne nope))
YEP
;; If not, is it an other pointer?
(inst and al-tn lowtag-mask)
- (inst cmp al-tn other-pointer-type)
+ (inst cmp al-tn other-pointer-lowtag)
(inst jmp :ne nope)
;; Get the header.
- (loadw eax-tn value 0 other-pointer-type)
+ (loadw eax-tn value 0 other-pointer-lowtag)
;; Is it one?
(inst cmp eax-tn (+ (ash 1 type-bits) bignum-type))
(inst jmp :e single-word)
(inst cmp eax-tn (+ (ash 2 type-bits) bignum-type))
(inst jmp :ne nope)
;; Get the second digit.
- (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-type)
+ (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-lowtag)
;; All zeros, its an (unsigned-byte 32).
(inst or eax-tn eax-tn)
(inst jmp :z yep)
(emit-label single-word)
;; Get the single digit.
- (loadw eax-tn value bignum-digits-offset other-pointer-type)
+ (loadw eax-tn value bignum-digits-offset other-pointer-lowtag)
;; positive implies (unsigned-byte 32).
(emit-label fixnum)
;; If not, is it an other pointer?
(inst and al-tn lowtag-mask)
- (inst cmp al-tn other-pointer-type)
+ (inst cmp al-tn other-pointer-lowtag)
(inst jmp :ne nope)
;; Get the header.
- (loadw eax-tn value 0 other-pointer-type)
+ (loadw eax-tn value 0 other-pointer-lowtag)
;; Is it one?
(inst cmp eax-tn (+ (ash 1 type-bits) bignum-type))
(inst jmp :e single-word)
(inst cmp eax-tn (+ (ash 2 type-bits) bignum-type))
(inst jmp :ne nope)
;; Get the second digit.
- (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-type)
+ (loadw eax-tn value (1+ bignum-digits-offset) other-pointer-lowtag)
;; All zeros, its an (unsigned-byte 32).
(inst or eax-tn eax-tn)
(inst jmp :z yep)
(emit-label single-word)
;; Get the single digit.
- (loadw eax-tn value bignum-digits-offset other-pointer-type)
+ (loadw eax-tn value bignum-digits-offset other-pointer-lowtag)
;; positive implies (unsigned-byte 32).
(emit-label fixnum)
(let ((is-not-cons-label (if not-p target drop-thru)))
(inst cmp value nil-value)
(inst jmp :e is-not-cons-label)
- (test-type value target not-p list-pointer-type))
+ (test-type value target not-p list-pointer-lowtag))
DROP-THRU))
(define-vop (check-cons check-type)
(let ((error (generate-error-code vop object-not-cons-error value)))
(inst cmp value nil-value)
(inst jmp :e error)
- (test-type value error t list-pointer-type)
+ (test-type value error t list-pointer-lowtag)
(move result value))))
\f
) ; MACROLET
projects / sbcl.git / blobdiff