\f
(defoptimizer (mask-signed-field ir2-convert) ((width x) node block)
(block nil
+ (when (template-p (basic-combination-info node))
+ (ir2-convert-template node block)
+ (return))
(when (constant-lvar-p width)
(case (lvar-value width)
(#.(- sb!vm:n-word-bits sb!vm:n-fixnum-tag-bits)
(move result digit)
(move ecx count)
(inst shl result :cl)))
+
+;; Specialised mask-signed-field VOPs.
+(define-vop (mask-signed-field-word/c)
+ (:translate sb!c::mask-signed-field)
+ (:policy :fast-safe)
+ (:args (x :scs (signed-reg unsigned-reg) :target r))
+ (:arg-types (:constant (integer 0 64)) untagged-num)
+ (:results (r :scs (signed-reg)))
+ (:result-types signed-num)
+ (:info width)
+ (:generator 3
+ (cond ((zerop width)
+ (zeroize r))
+ ((= width 64)
+ (move r x))
+ ((member width '(32 16 8))
+ (inst movsx r (reg-in-size x (ecase width
+ (32 :dword)
+ (16 :word)
+ (8 :byte)))))
+ (t
+ (move r x)
+ (let ((delta (- n-word-bits width)))
+ (inst shl r delta)
+ (inst sar r delta))))))
+
+(define-vop (mask-signed-field-bignum/c)
+ (:translate sb!c::mask-signed-field)
+ (:policy :fast-safe)
+ (:args (x :scs (descriptor-reg) :target r))
+ (:arg-types (:constant (integer 0 64)) bignum)
+ (:results (r :scs (signed-reg)))
+ (:result-types signed-num)
+ (:info width)
+ (:generator 4
+ (cond ((zerop width)
+ (zeroize r))
+ ((member width '(8 16 32 64))
+ (ecase width
+ (64 (loadw r x bignum-digits-offset other-pointer-lowtag))
+ ((32 16 8)
+ (inst movsx r (make-ea (ecase width (32 :dword) (16 :word) (8 :byte))
+ :base x
+ :disp (- (* bignum-digits-offset n-word-bytes)
+ other-pointer-lowtag))))))
+ (t
+ (loadw r x bignum-digits-offset other-pointer-lowtag)
+ (let ((delta (- n-word-bits width)))
+ (inst shl r delta)
+ (inst sar r delta))))))
\f
;;;; static functions