(%test-headers value target not-p nil headers drop-through))
(defun %test-lowtag (value target not-p lowtag)
- (move-qword-to-eax value)
- (inst and al-tn lowtag-mask)
- (inst cmp al-tn lowtag)
- (inst jmp (if not-p :ne :e) target))
+ (inst lea eax-tn (make-ea :dword :base value :disp (- lowtag)))
+ (inst test al-tn lowtag-mask)
+ (inst jmp (if not-p :nz :z) target))
(defun %test-headers (value target not-p function-p headers
&optional (drop-through (gen-label)))
(if not-p
(values not-target target)
(values target not-target))
- (generate-fixnum-test value)
- (inst jmp :e yep)
(move-qword-to-eax value)
+ (inst test al-tn fixnum-tag-mask)
+ (inst jmp :e yep)
+
(inst and al-tn lowtag-mask)
(inst cmp al-tn other-pointer-lowtag)
(inst jmp :ne nope)
(values not-target target)
(values target not-target))
;; Is it a fixnum?
- (generate-fixnum-test value)
(move rax-tn value)
+ (inst test al-tn fixnum-tag-mask)
(inst jmp :e fixnum)
;; If not, is it an other pointer?
(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
- (constantize (lognot hi)))
- (inst jmp :ne error))
- (t
- (generate-fixnum-test value)
- (inst jmp :ne error)
- (inst cmp value (constantize hi))
- (inst jmp :a error)))
- (move result value))))
+(defun power-of-two-limit-p (x)
+ (and (fixnump x)
+ (= (logcount (1+ x)) 1)))
+
+(define-vop (test-fixnum-mod-power-of-two)
+ (:args (value :scs (any-reg descriptor-reg
+ unsigned-reg signed-reg
+ immediate)))
+ (:arg-types *
+ (:constant (satisfies power-of-two-limit-p)))
+ (:translate fixnum-mod-p)
+ (:conditional :e)
+ (:info hi)
+ (:save-p :compute-only)
+ (:policy :fast-safe)
+ (:generator 4
+ (aver (not (sc-is value immediate)))
+ (let* ((fixnum-hi (if (sc-is value unsigned-reg signed-reg)
+ hi
+ (fixnumize hi))))
+ (inst test value (constantize (lognot fixnum-hi))))))
+
+(define-vop (test-fixnum-mod-tagged-unsigned)
+ (:args (value :scs (any-reg descriptor-reg
+ unsigned-reg signed-reg
+ immediate)))
+ (:arg-types (:or tagged-num unsigned-num signed-num)
+ (:constant fixnum))
+ (:translate fixnum-mod-p)
+ (:conditional :be)
+ (:info hi)
+ (:save-p :compute-only)
+ (:policy :fast-safe)
+ (:generator 5
+ (aver (not (sc-is value immediate)))
+ (let ((fixnum-hi (if (sc-is value unsigned-reg signed-reg)
+ hi
+ (fixnumize hi))))
+ (inst cmp value (constantize fixnum-hi)))))
+(define-vop (test-fixnum-mod-*)
+ (:args (value :scs (any-reg descriptor-reg)))
+ (:arg-types * (:constant fixnum))
+ (:translate fixnum-mod-p)
+ (:conditional)
+ (:info target not-p hi)
+ (:save-p :compute-only)
+ (:policy :fast-safe)
+ (:generator 6
+ (let* ((fixnum-hi (fixnumize hi))
+ (skip (gen-label)))
+ (generate-fixnum-test value)
+ (inst jmp :ne (if not-p target skip))
+ (inst cmp value (constantize fixnum-hi))
+ (inst jmp (if not-p :a :be) target)
+ (emit-label skip))))
\f
;;;; list/symbol types
;;;