(in-package "SB!VM")
\f
+
+;; A fixnum that can be represented in tagged form by a signed 32-bit
+;; value and that can therefore be used as an immediate argument of
+;; arithmetic machine instructions.
+(deftype short-tagged-num () '(signed-byte #.(- 32 n-fixnum-tag-bits)))
+
;;;; unary operations
(define-vop (fast-safe-arith-op)
(define-vop (fast-fixnum-binop-c fast-safe-arith-op)
(:args (x :target r :scs (any-reg)
- :load-if (or (not (typep y '(signed-byte 29)))
+ :load-if (or (not (typep y 'short-tagged-num))
(not (sc-is x any-reg control-stack)))))
(:info y)
(:arg-types tagged-num (:constant fixnum))
(:results (r :scs (any-reg)
:load-if (or (not (location= x r))
- (not (typep y '(signed-byte 29))))))
+ (not (typep y 'short-tagged-num)))))
(:result-types tagged-num)
(:note "inline fixnum arithmetic"))
(:translate ,translate)
(:generator 1
(move r x)
- (inst ,op r (if (typep y '(signed-byte 29))
+ (inst ,op r (if (typep y 'short-tagged-num)
(fixnumize y)
(register-inline-constant :qword (fixnumize y))))))
(define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED")
(define-vop (fast-+-c/fixnum=>fixnum fast-safe-arith-op)
(:translate +)
(:args (x :target r :scs (any-reg)
- :load-if (or (not (typep y '(signed-byte 29)))
+ :load-if (or (not (typep y 'short-tagged-num))
(not (sc-is x any-reg control-stack)))))
(:info y)
(:arg-types tagged-num (:constant fixnum))
(:results (r :scs (any-reg)
:load-if (or (not (location= x r))
- (not (typep y '(signed-byte 29))))))
+ (not (typep y 'short-tagged-num)))))
(:result-types tagged-num)
(:note "inline fixnum arithmetic")
(:generator 1
(cond ((and (sc-is x any-reg) (sc-is r any-reg) (not (location= x r))
- (typep y '(signed-byte 29)))
+ (typep y 'short-tagged-num))
(inst lea r (make-ea :qword :base x :disp (fixnumize y))))
- ((typep y '(signed-byte 29))
+ ((typep y 'short-tagged-num)
(move r x)
(inst add r (fixnumize y)))
(t
(inst idiv eax y)
(if (location= quo eax)
(inst shl eax n-fixnum-tag-bits)
- (inst lea quo (make-ea :qword :index eax
- :scale (ash 1 n-fixnum-tag-bits))))
+ (if (= n-fixnum-tag-bits 1)
+ (inst lea quo (make-ea :qword :base eax :index eax))
+ (inst lea quo (make-ea :qword :index eax
+ :scale (ash 1 n-fixnum-tag-bits)))))
(move rem edx)))
(define-vop (fast-truncate-c/fixnum=>fixnum fast-safe-arith-op)
(:generator 30
(move eax x)
(inst cqo)
- (if (typep y '(signed-byte 29))
+ (if (typep y 'short-tagged-num)
(inst mov y-arg (fixnumize y))
(setf y-arg (register-inline-constant :qword (fixnumize y))))
(inst idiv eax y-arg)
(if (location= quo eax)
(inst shl eax n-fixnum-tag-bits)
- (inst lea quo (make-ea :qword :index eax
- :scale (ash 1 n-fixnum-tag-bits))))
+ (if (= n-fixnum-tag-bits 1)
+ (inst lea quo (make-ea :qword :base eax :index eax))
+ (inst lea quo (make-ea :qword :index eax
+ :scale (ash 1 n-fixnum-tag-bits)))))
(move rem edx)))
(define-vop (fast-truncate/unsigned=>unsigned fast-safe-arith-op)
(:generator 5
(move result number)
(move ecx amount)
- (inst or ecx ecx)
+ (inst test ecx ecx)
(inst jmp :ns POSITIVE)
(inst neg ecx)
(inst cmp ecx 63)
(:generator 5
(move result number)
(move ecx amount)
- (inst or ecx ecx)
+ (inst test ecx ecx)
(inst jmp :ns POSITIVE)
(inst neg ecx)
(inst cmp ecx 63)
(:generator 4
(move result number)
(move ecx amount)
- (inst or ecx ecx)
+ (inst test ecx ecx)
(inst jmp :ns POSITIVE)
(inst neg ecx)
(zeroize zero)
(define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
(:args (x :scs (any-reg)
- :load-if (or (not (typep y '(signed-byte 29)))
+ :load-if (or (not (typep y 'short-tagged-num))
(not (sc-is x any-reg control-stack)))))
(:arg-types tagged-num (:constant fixnum))
(:info y))
(inst cmp x
,(case suffix
(-c/fixnum
- `(if (typep y '(signed-byte 29))
+ `(if (typep y 'short-tagged-num)
(fixnumize y)
(register-inline-constant
:qword (fixnumize y))))
(define-vop (fast-eql-c/fixnum fast-conditional/fixnum)
(:args (x :scs (any-reg)
- :load-if (or (not (typep y '(signed-byte 29)))
+ :load-if (or (not (typep y 'short-tagged-num))
(not (sc-is x any-reg descriptor-reg control-stack)))))
(:arg-types tagged-num (:constant fixnum))
(:info y)
(:generator 2
(cond ((and (sc-is x any-reg descriptor-reg) (zerop y))
(inst test x x)) ; smaller instruction
- ((typep y '(signed-byte 29))
+ ((typep y 'short-tagged-num)
(inst cmp x (fixnumize y)))
(t
(inst cmp x (register-inline-constant :qword (fixnumize y)))))))
(:arg-types unsigned-num)
(:conditional :ns)
(:generator 3
- (inst or digit digit)))
+ (inst test digit digit)))
;;; For add and sub with carry the sc of carry argument is any-reg so