-;;;; the VM definition arithmetic VOPs for the x86
+;;;; the VM definition of arithmetic VOPs for the x86
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
(if (plusp amount)
(inst shl result amount)
(inst shr result (- amount))))
- (t (inst xor result result)))))))
+ (t (if (sc-is result unsigned-reg)
+ (inst xor result result)
+ (inst mov result 0))))))))
(define-vop (fast-ash-left/signed=>signed)
(:translate ash)
DONE))
+(in-package "SB!C")
+
+(defknown %lea (integer integer (member 1 2 4 8) (signed-byte 32))
+ integer
+ (foldable flushable movable))
+
+(defoptimizer (%lea derive-type) ((base index scale disp))
+ (when (and (constant-lvar-p scale)
+ (constant-lvar-p disp))
+ (let ((scale (lvar-value scale))
+ (disp (lvar-value disp))
+ (base-type (lvar-type base))
+ (index-type (lvar-type index)))
+ (when (and (numeric-type-p base-type)
+ (numeric-type-p index-type))
+ (let ((base-lo (numeric-type-low base-type))
+ (base-hi (numeric-type-high base-type))
+ (index-lo (numeric-type-low index-type))
+ (index-hi (numeric-type-high index-type)))
+ (make-numeric-type :class 'integer
+ :complexp :real
+ :low (when (and base-lo index-lo)
+ (+ base-lo (* index-lo scale) disp))
+ :high (when (and base-hi index-hi)
+ (+ base-hi (* index-hi scale) disp))))))))
+
+(defun %lea (base index scale disp)
+ (+ base (* index scale) disp))
+
+(in-package "SB!VM")
+
+(define-vop (%lea/unsigned=>unsigned)
+ (:translate %lea)
+ (:policy :fast-safe)
+ (:args (base :scs (unsigned-reg))
+ (index :scs (unsigned-reg)))
+ (:info scale disp)
+ (:arg-types unsigned-num unsigned-num
+ (:constant (member 1 2 4 8))
+ (:constant (signed-byte 32)))
+ (:results (r :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:generator 5
+ (inst lea r (make-ea :dword :base base :index index
+ :scale scale :disp disp))))
+
+(define-vop (%lea/signed=>signed)
+ (:translate %lea)
+ (:policy :fast-safe)
+ (:args (base :scs (signed-reg))
+ (index :scs (signed-reg)))
+ (:info scale disp)
+ (:arg-types signed-num signed-num
+ (:constant (member 1 2 4 8))
+ (:constant (signed-byte 32)))
+ (:results (r :scs (signed-reg)))
+ (:result-types signed-num)
+ (:generator 4
+ (inst lea r (make-ea :dword :base base :index index
+ :scale scale :disp disp))))
+
+(define-vop (%lea/fixnum=>fixnum)
+ (:translate %lea)
+ (:policy :fast-safe)
+ (:args (base :scs (any-reg))
+ (index :scs (any-reg)))
+ (:info scale disp)
+ (:arg-types tagged-num tagged-num
+ (:constant (member 1 2 4 8))
+ (:constant (signed-byte 32)))
+ (:results (r :scs (any-reg)))
+ (:result-types tagged-num)
+ (:generator 3
+ (inst lea r (make-ea :dword :base base :index index
+ :scale scale :disp disp))))
+
;;; FIXME: before making knowledge of this too public, it needs to be
;;; fixed so that it's actually _faster_ than the non-CMOV version; at
;;; least on my Celeron-XXX laptop, this version is marginally slower
(define-vop (fast---mod32-c/unsigned=>unsigned fast---c/unsigned=>unsigned)
(:translate --mod32))
+(define-modular-fun *-mod32 (x y) * 32)
+(define-vop (fast-*-mod32/unsigned=>unsigned fast-*/unsigned=>unsigned)
+ (:translate *-mod32))
+;;; (no -C variant as x86 MUL instruction doesn't take an immediate)
+
(define-vop (fast-ash-left-mod32-c/unsigned=>unsigned
fast-ash-c/unsigned=>unsigned)
(:translate ash-left-mod32))
+(in-package "SB!C")
+
+(defknown sb!vm::%lea-mod32 (integer integer (member 1 2 4 8) (signed-byte 32))
+ (unsigned-byte 32)
+ (foldable flushable movable))
+
+(define-modular-fun-optimizer %lea ((base index scale disp) :width width)
+ (when (and (<= width 32)
+ (constant-lvar-p scale)
+ (constant-lvar-p disp))
+ (cut-to-width base width)
+ (cut-to-width index width)
+ 'sb!vm::%lea-mod32))
+
+#+sb-xc-host
+(defun sb!vm::%lea-mod32 (base index scale disp)
+ (ldb (byte 32 0) (%lea base index scale disp)))
+#-sb-xc-host
+(defun sb!vm::%lea-mod32 (base index scale disp)
+ (let ((base (logand base #xffffffff))
+ (index (logand index #xffffffff)))
+ ;; can't use modular version of %LEA, as we only have VOPs for
+ ;; constant SCALE and DISP.
+ (ldb (byte 32 0) (+ base (* index scale) disp))))
+
+(in-package "SB!VM")
+
+(define-vop (%lea-mod32/unsigned=>unsigned
+ %lea/unsigned=>unsigned)
+ (:translate %lea-mod32))
+
;;; logical operations
(define-modular-fun lognot-mod32 (x) lognot 32)
(define-vop (lognot-mod32/unsigned=>unsigned)
;;;; bignum stuff
(define-vop (bignum-length get-header-data)
- (:translate sb!bignum::%bignum-length)
+ (:translate sb!bignum:%bignum-length)
(:policy :fast-safe))
(define-vop (bignum-set-length set-header-data)
- (:translate sb!bignum::%bignum-set-length)
+ (:translate sb!bignum:%bignum-set-length)
(:policy :fast-safe))
(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag
- (unsigned-reg) unsigned-num sb!bignum::%bignum-ref)
+ (unsigned-reg) unsigned-num sb!bignum:%bignum-ref)
(define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag
- (unsigned-reg) unsigned-num sb!bignum::%bignum-set)
+ (unsigned-reg) unsigned-num sb!bignum:%bignum-set)
(define-vop (digit-0-or-plus)
- (:translate sb!bignum::%digit-0-or-plusp)
+ (:translate sb!bignum:%digit-0-or-plusp)
(:policy :fast-safe)
(:args (digit :scs (unsigned-reg)))
(:arg-types unsigned-num)
;;; 4. This is easy to deal with and may save a fixnum-word
;;; conversion.
(define-vop (add-w/carry)
- (:translate sb!bignum::%add-with-carry)
+ (:translate sb!bignum:%add-with-carry)
(:policy :fast-safe)
(:args (a :scs (unsigned-reg) :target result)
(b :scs (unsigned-reg unsigned-stack) :to :eval)
;;; Note: the borrow is the oppostite of the x86 convention - 1 for no
;;; borrow and 0 for a borrow.
(define-vop (sub-w/borrow)
- (:translate sb!bignum::%subtract-with-borrow)
+ (:translate sb!bignum:%subtract-with-borrow)
(:policy :fast-safe)
(:args (a :scs (unsigned-reg) :to :eval :target result)
(b :scs (unsigned-reg unsigned-stack) :to :result)
(define-vop (bignum-mult-and-add-3-arg)
- (:translate sb!bignum::%multiply-and-add)
+ (:translate sb!bignum:%multiply-and-add)
(:policy :fast-safe)
(:args (x :scs (unsigned-reg) :target eax)
(y :scs (unsigned-reg unsigned-stack))
(move lo eax)))
(define-vop (bignum-mult-and-add-4-arg)
- (:translate sb!bignum::%multiply-and-add)
+ (:translate sb!bignum:%multiply-and-add)
(:policy :fast-safe)
(:args (x :scs (unsigned-reg) :target eax)
(y :scs (unsigned-reg unsigned-stack))
(define-vop (bignum-mult)
- (:translate sb!bignum::%multiply)
+ (:translate sb!bignum:%multiply)
(:policy :fast-safe)
(:args (x :scs (unsigned-reg) :target eax)
(y :scs (unsigned-reg unsigned-stack)))
(move lo eax)))
(define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned)
- (:translate sb!bignum::%lognot))
+ (:translate sb!bignum:%lognot))
(define-vop (fixnum-to-digit)
- (:translate sb!bignum::%fixnum-to-digit)
+ (:translate sb!bignum:%fixnum-to-digit)
(:policy :fast-safe)
(:args (fixnum :scs (any-reg control-stack) :target digit))
(:arg-types tagged-num)
(inst sar digit 2)))
(define-vop (bignum-floor)
- (:translate sb!bignum::%floor)
+ (:translate sb!bignum:%floor)
(:policy :fast-safe)
(:args (div-high :scs (unsigned-reg) :target edx)
(div-low :scs (unsigned-reg) :target eax)
(move rem edx)))
(define-vop (signify-digit)
- (:translate sb!bignum::%fixnum-digit-with-correct-sign)
+ (:translate sb!bignum:%fixnum-digit-with-correct-sign)
(:policy :fast-safe)
(:args (digit :scs (unsigned-reg unsigned-stack) :target res))
(:arg-types unsigned-num)
(inst shl res 2))))
(define-vop (digit-ashr)
- (:translate sb!bignum::%ashr)
+ (:translate sb!bignum:%ashr)
(:policy :fast-safe)
(:args (digit :scs (unsigned-reg unsigned-stack) :target result)
(count :scs (unsigned-reg) :target ecx))
(inst sar result :cl)))
(define-vop (digit-lshr digit-ashr)
- (:translate sb!bignum::%digit-logical-shift-right)
+ (:translate sb!bignum:%digit-logical-shift-right)
(:generator 1
(move result digit)
(move ecx count)
(inst shr result :cl)))
(define-vop (digit-ashl digit-ashr)
- (:translate sb!bignum::%ashl)
+ (:translate sb!bignum:%ashl)
(:generator 1
(move result digit)
(move ecx count)
(in-package "SB!C")
-(defknown %lea ((or (signed-byte 32) (unsigned-byte 32))
- (or (signed-byte 32) (unsigned-byte 32))
- (member 1 2 4 8) (signed-byte 32))
- (or (signed-byte 32) (unsigned-byte 32))
- (foldable flushable))
-
-(defoptimizer (%lea derive-type) ((base index scale disp))
- (when (and (constant-lvar-p scale)
- (constant-lvar-p disp))
- (let ((scale (lvar-value scale))
- (disp (lvar-value disp))
- (base-type (lvar-type base))
- (index-type (lvar-type index)))
- (when (and (numeric-type-p base-type)
- (numeric-type-p index-type))
- (let ((base-lo (numeric-type-low base-type))
- (base-hi (numeric-type-high base-type))
- (index-lo (numeric-type-low index-type))
- (index-hi (numeric-type-high index-type)))
- (make-numeric-type :class 'integer
- :complexp :real
- :low (when (and base-lo index-lo)
- (+ base-lo (* index-lo scale) disp))
- :high (when (and base-hi index-hi)
- (+ base-hi (* index-hi scale) disp))))))))
-
-(defun %lea (base index scale disp)
- (+ base (* index scale) disp))
-
-(in-package "SB!VM")
-
-(define-vop (%lea/unsigned=>unsigned)
- (:translate %lea)
- (:policy :fast-safe)
- (:args (base :scs (unsigned-reg))
- (index :scs (unsigned-reg)))
- (:info scale disp)
- (:arg-types unsigned-num unsigned-num
- (:constant (member 1 2 4 8))
- (:constant (signed-byte 32)))
- (:results (r :scs (unsigned-reg)))
- (:result-types unsigned-num)
- (:generator 5
- (inst lea r (make-ea :dword :base base :index index
- :scale scale :disp disp))))
-
-(define-vop (%lea/signed=>signed)
- (:translate %lea)
- (:policy :fast-safe)
- (:args (base :scs (signed-reg))
- (index :scs (signed-reg)))
- (:info scale disp)
- (:arg-types signed-num signed-num
- (:constant (member 1 2 4 8))
- (:constant (signed-byte 32)))
- (:results (r :scs (signed-reg)))
- (:result-types signed-num)
- (:generator 4
- (inst lea r (make-ea :dword :base base :index index
- :scale scale :disp disp))))
-
-(define-vop (%lea/fixnum=>fixnum)
- (:translate %lea)
- (:policy :fast-safe)
- (:args (base :scs (any-reg))
- (index :scs (any-reg)))
- (:info scale disp)
- (:arg-types tagged-num tagged-num
- (:constant (member 1 2 4 8))
- (:constant (signed-byte 32)))
- (:results (r :scs (any-reg)))
- (:result-types tagged-num)
- (:generator 3
- (inst lea r (make-ea :dword :base base :index index
- :scale scale :disp disp))))
-
-(in-package "SB!C")
-
;;; This is essentially a straight implementation of the algorithm in
;;; "Strength Reduction of Multiplications by Integer Constants",
;;; Youfeng Wu, ACM SIGPLAN Notices, Vol. 30, No.2, February 1995.
(t (incf count)))))
(decompose-multiplication arg x n-bits condensed)))
+(defun *-transformer (y)
+ (cond
+ ((= y (ash 1 (integer-length y)))
+ ;; there's a generic transform for y = 2^k
+ (give-up-ir1-transform))
+ ((member y '(3 5 9))
+ ;; we can do these multiplications directly using LEA
+ `(%lea x x ,(1- y) 0))
+ ((member :pentium4 *backend-subfeatures*)
+ ;; the pentium4's multiply unit is reportedly very good
+ (give-up-ir1-transform))
+ ;; FIXME: should make this more fine-grained. If nothing else,
+ ;; there should probably be a cutoff of about 9 instructions on
+ ;; pentium-class machines.
+ (t (optimize-multiply 'x y))))
+
(deftransform * ((x y)
((unsigned-byte 32) (constant-arg (unsigned-byte 32)))
(unsigned-byte 32))
"recode as leas, shifts and adds"
(let ((y (lvar-value y)))
- (cond
- ((= y (ash 1 (integer-length y)))
- ;; there's a generic transform for y = 2^k
- (give-up-ir1-transform))
- ((member y '(3 5 9))
- ;; we can do these multiplications directly using LEA
- `(%lea x x ,(1- y) 0))
- ((member :pentium4 *backend-subfeatures*)
- ;; the pentium4's multiply unit is reportedly very good
- (give-up-ir1-transform))
- ;; FIXME: should make this more fine-grained. If nothing else,
- ;; there should probably be a cutoff of about 9 instructions on
- ;; pentium-class machines.
- (t (optimize-multiply 'x y)))))
+ (*-transformer y)))
+
+(deftransform sb!vm::*-mod32
+ ((x y) ((unsigned-byte 32) (constant-arg (unsigned-byte 32)))
+ (unsigned-byte 32))
+ "recode as leas, shifts and adds"
+ (let ((y (lvar-value y)))
+ (*-transformer y)))
;;; FIXME: we should also be able to write an optimizer or two to
;;; convert (+ (* x 2) 17), (- (* x 9) 5) to a %LEA.