X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Farith.lisp;h=565a2e920e6fcdfd7f6b4e6617fe26bd6cfd6304;hb=20b2378572cf7378f3f267e2234c4234dacfbdc9;hp=39efee17bbe53d1df7550e44547300a65ae3a6a5;hpb=1e9966d5f24709d227e20911b4e1ddd27c87a00e;p=sbcl.git diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 39efee1..565a2e9 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1,4 +1,4 @@ -;;;; 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. @@ -683,9 +683,15 @@ (inst lea result (make-ea :dword :index number :scale 8))) (t (move result number) - (cond ((plusp amount) (inst shl result amount)) - ((< amount -31) (inst xor result result)) - (t (inst shr result (- amount)))))))) + (cond ((< -32 amount 32) + ;; this code is used both in ASH and ASH-MOD32, so + ;; be careful + (if (plusp amount) + (inst shl result amount) + (inst shr result (- amount)))) + (t (if (sc-is result unsigned-reg) + (inst xor result result) + (inst mov result 0)))))))) (define-vop (fast-ash-left/signed=>signed) (:translate ash) @@ -788,6 +794,82 @@ 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 @@ -1148,10 +1230,46 @@ (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) @@ -1199,21 +1317,21 @@ ;;;; 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) @@ -1229,7 +1347,7 @@ ;;; 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) @@ -1250,7 +1368,7 @@ ;;; 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) @@ -1269,7 +1387,7 @@ (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)) @@ -1291,7 +1409,7 @@ (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)) @@ -1317,7 +1435,7 @@ (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))) @@ -1336,10 +1454,10 @@ (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) @@ -1353,7 +1471,7 @@ (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) @@ -1374,7 +1492,7 @@ (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) @@ -1389,7 +1507,7 @@ (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)) @@ -1405,14 +1523,14 @@ (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) @@ -1500,84 +1618,6 @@ (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. @@ -1650,25 +1690,35 @@ (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.