:disp (- other-pointer-lowtag)))
(inst test al-tn lowtag-mask)
(inst jmp :ne nope)
- (loadw eax-tn value 0 other-pointer-lowtag)
- (inst cmp eax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
+ (inst cmp (make-ea-for-object-slot value 0 other-pointer-lowtag)
+ (+ (ash 1 n-widetag-bits) bignum-widetag))
(inst jmp (if not-p :ne :e) target))
NOT-TARGET))
:disp (- other-pointer-lowtag)))
(inst test al-tn lowtag-mask)
(inst jmp :ne nope)
- (loadw eax-tn value 0 other-pointer-lowtag)
- (inst cmp eax-tn (+ (ash 1 n-widetag-bits) bignum-widetag))
+ (inst cmp (make-ea-for-object-slot value 0 other-pointer-lowtag)
+ (+ (ash 1 n-widetag-bits) bignum-widetag))
(inst jmp :ne nope))
YEP
(move result value)))
;; Get the second digit.
(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 test eax-tn eax-tn)
(inst jmp :z yep)
(inst jmp nope)
;; positive implies (unsigned-byte 32).
(emit-label fixnum)
- (inst or eax-tn eax-tn)
+ (inst test eax-tn eax-tn)
(inst jmp (if not-p :s :ns) target)
(emit-label not-target)))))
;; Get the second digit.
(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 test eax-tn eax-tn)
(inst jmp :z yep)
(inst jmp nope)
;; positive implies (unsigned-byte 32).
(emit-label fixnum)
- (inst or eax-tn eax-tn)
+ (inst test eax-tn eax-tn)
(inst jmp :s nope)
(emit-label yep)
(move result value))))
+
+(define-vop (check-mod-fixnum check-type)
+ (:info type)
+ (:temporary (:sc any-reg) temp)
+ (:generator 30
+ (let* ((low (numeric-type-low type))
+ (hi (fixnumize (numeric-type-high type)))
+ (error (gen-label)))
+ ;; FIXME: abstract
+ (assemble (*elsewhere*)
+ (emit-label error)
+ (inst mov temp hi)
+ (emit-error-break vop error-trap
+ (error-number-or-lose 'object-not-mod-error)
+ (list value temp)))
+ (aver (zerop low))
+ (cond
+ ;; Handle powers of two specially
+ ;; The higher bits and the fixnum tag can be tested in one go
+ ((= (logcount (1+ hi)) 1)
+ (inst test value (lognot hi))
+ (inst jmp :ne error))
+ (t
+ (generate-fixnum-test value)
+ (inst jmp :ne error)
+ (inst cmp value hi)
+ (inst jmp :a error)))
+ (move result value))))
+
\f
;;;; list/symbol types
;;;