(:translate ,translate)
(:generator ,untagged-penalty
(move r x)
- (inst ,op r y))))))
-
- ;;(define-binop + 4 add)
+ ,(if (eq translate 'logand)
+ ;; for the -C/UNSIGNED=>UNSIGNED VOP, this case
+ ;; is optimized away as an identity somewhere
+ ;; along the lines. However, this VOP is used in
+ ;; -C/SIGNED=>UNSIGNED, below, when the
+ ;; higher-level lisp code can't optimize away the
+ ;; non-trivial identity.
+ `(unless (= y #.(1- (ash 1 n-word-bits)))
+ (inst ,op r y))
+ `(inst ,op r y)))))))
(define-binop - 4 sub)
(define-binop logand 2 and)
(define-binop logior 2 or)
(move r x)
(inst add r y)))))
-
;;;; Special logand cases: (logand signed unsigned) => unsigned
(define-vop (fast-logand/signed-unsigned=>unsigned
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
(move result prev)
(inst shrd result next :cl)))
-(define-source-transform 32bit-logical-not (x)
+(define-source-transform word-logical-not (x)
`(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32))))
-(deftransform 32bit-logical-and ((x y))
+(deftransform word-logical-and ((x y))
'(logand x y))
-(define-source-transform 32bit-logical-nand (x y)
- `(32bit-logical-not (32bit-logical-and ,x ,y)))
+(define-source-transform word-logical-nand (x y)
+ `(word-logical-not (word-logical-and ,x ,y)))
-(deftransform 32bit-logical-or ((x y))
+(deftransform word-logical-or ((x y))
'(logior x y))
-(define-source-transform 32bit-logical-nor (x y)
- `(32bit-logical-not (32bit-logical-or ,x ,y)))
+(define-source-transform word-logical-nor (x y)
+ `(word-logical-not (word-logical-or ,x ,y)))
-(deftransform 32bit-logical-xor ((x y))
+(deftransform word-logical-xor ((x y))
'(logxor x y))
-(define-source-transform 32bit-logical-eqv (x y)
- `(32bit-logical-not (32bit-logical-xor ,x ,y)))
+(define-source-transform word-logical-eqv (x y)
+ `(word-logical-not (word-logical-xor ,x ,y)))
-(define-source-transform 32bit-logical-orc1 (x y)
- `(32bit-logical-or (32bit-logical-not ,x) ,y))
+(define-source-transform word-logical-orc1 (x y)
+ `(word-logical-or (word-logical-not ,x) ,y))
-(define-source-transform 32bit-logical-orc2 (x y)
- `(32bit-logical-or ,x (32bit-logical-not ,y)))
+(define-source-transform word-logical-orc2 (x y)
+ `(word-logical-or ,x (word-logical-not ,y)))
-(define-source-transform 32bit-logical-andc1 (x y)
- `(32bit-logical-and (32bit-logical-not ,x) ,y))
+(define-source-transform word-logical-andc1 (x y)
+ `(word-logical-and (word-logical-not ,x) ,y))
-(define-source-transform 32bit-logical-andc2 (x y)
- `(32bit-logical-and ,x (32bit-logical-not ,y)))
+(define-source-transform word-logical-andc2 (x y)
+ `(word-logical-and ,x (word-logical-not ,y)))
;;; Only the lower 5 bits of the shift amount are significant.
(define-vop (shift-towards-someplace)
(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)
(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.
projects / sbcl.git / blobdiff