X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Farith.lisp;h=af7da99188d9e2effe5ec8785be284865e1cad82;hb=11f02398a1a9ccbde847c82fd233e8378e45c29c;hp=934da0473af2944c1e29e6010cf2051651ad3004;hpb=3bc5fbfb7f1528cb2c2e49b2d15fcaa6c62f5b49;p=sbcl.git diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 934da04..af7da99 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -184,7 +184,6 @@ (define-binop logior 2 or) (define-binop logxor 2 xor)) - ;;; Special handling of add on the x86; can use lea to avoid a ;;; register load, otherwise it uses add. (define-vop (fast-+/fixnum=>fixnum fast-safe-arith-op) @@ -633,21 +632,20 @@ ;; The result-type ensures us that this shift will not overflow. (inst shl result :cl))) -(define-vop (fast-ash-c) +(define-vop (fast-ash-c/signed=>signed) (:translate ash) (:policy :fast-safe) - (:args (number :scs (signed-reg unsigned-reg) :target result - :load-if (not (and (sc-is number signed-stack unsigned-stack) - (sc-is result signed-stack unsigned-stack) + (:args (number :scs (signed-reg) :target result + :load-if (not (and (sc-is number signed-stack) + (sc-is result signed-stack) (location= number result))))) (:info amount) - (:arg-types (:or signed-num unsigned-num) (:constant integer)) - (:results (result :scs (signed-reg unsigned-reg) - :load-if (not - (and (sc-is number signed-stack unsigned-stack) - (sc-is result signed-stack unsigned-stack) - (location= number result))))) - (:result-types (:or signed-num unsigned-num)) + (:arg-types signed-num (:constant integer)) + (:results (result :scs (signed-reg) + :load-if (not (and (sc-is number signed-stack) + (sc-is result signed-stack) + (location= number result))))) + (:result-types signed-num) (:note "inline ASH") (:generator 3 (cond ((and (= amount 1) (not (location= number result))) @@ -658,54 +656,92 @@ (inst lea result (make-ea :dword :index number :scale 8))) (t (move result number) - (cond ((plusp amount) - ;; We don't have to worry about overflow because of the - ;; result type restriction. - (inst shl result amount)) - ((sc-is number signed-reg signed-stack) - ;; If the amount is greater than 31, only shift by 31. We - ;; have to do this because the shift instructions only look - ;; at the low five bits of the result. - (inst sar result (min 31 (- amount)))) - (t - (inst shr result (min 31 (- amount))))))))) + (cond ((plusp amount) (inst shl result amount)) + (t (inst sar result (min 31 (- amount))))))))) -(define-vop (fast-ash-left) +(define-vop (fast-ash-c/unsigned=>unsigned) (:translate ash) - (:args (number :scs (signed-reg unsigned-reg) :target result - :load-if (not (and (sc-is number signed-stack unsigned-stack) - (sc-is result signed-stack unsigned-stack) + (:policy :fast-safe) + (:args (number :scs (unsigned-reg) :target result + :load-if (not (and (sc-is number unsigned-stack) + (sc-is result unsigned-stack) + (location= number result))))) + (:info amount) + (:arg-types unsigned-num (:constant integer)) + (:results (result :scs (unsigned-reg) + :load-if (not (and (sc-is number unsigned-stack) + (sc-is result unsigned-stack) + (location= number result))))) + (:result-types unsigned-num) + (:note "inline ASH") + (:generator 3 + (cond ((and (= amount 1) (not (location= number result))) + (inst lea result (make-ea :dword :index number :scale 2))) + ((and (= amount 2) (not (location= number result))) + (inst lea result (make-ea :dword :index number :scale 4))) + ((and (= amount 3) (not (location= number result))) + (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)))))))) + +(define-vop (fast-ash-left/signed) + (:translate ash) + (:args (number :scs (signed-reg) :target result + :load-if (not (and (sc-is number signed-stack) + (sc-is result signed-stack) (location= number result)))) (amount :scs (unsigned-reg) :target ecx)) - (:arg-types (:or signed-num unsigned-num) positive-fixnum) + (:arg-types signed-num positive-fixnum) (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx) - (:results (result :scs (signed-reg unsigned-reg) :from (:argument 0) - :load-if (not - (and (sc-is number signed-stack unsigned-stack) - (sc-is result signed-stack unsigned-stack) - (location= number result))))) - (:result-types (:or signed-num unsigned-num)) + (:results (result :scs (signed-reg) :from (:argument 0) + :load-if (not (and (sc-is number signed-stack) + (sc-is result signed-stack) + (location= number result))))) + (:result-types signed-num) (:policy :fast-safe) (:note "inline ASH") (:generator 4 (move result number) (move ecx amount) - ;; The result-type ensures us that this shift will not overflow. (inst shl result :cl))) -(define-vop (fast-ash) +(define-vop (fast-ash-left/unsigned) (:translate ash) + (:args (number :scs (unsigned-reg) :target result + :load-if (not (and (sc-is number unsigned-stack) + (sc-is result unsigned-stack) + (location= number result)))) + (amount :scs (unsigned-reg) :target ecx)) + (:arg-types unsigned-num positive-fixnum) + (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx) + (:results (result :scs (unsigned-reg) :from (:argument 0) + :load-if (not (and (sc-is number unsigned-stack) + (sc-is result unsigned-stack) + (location= number result))))) + (:result-types unsigned-num) (:policy :fast-safe) - (:args (number :scs (signed-reg unsigned-reg) :target result) + (:note "inline ASH") + (:generator 4 + (move result number) + (move ecx amount) + (inst shl result :cl))) + +(define-vop (fast-ash/signed=>signed) + (:translate ash) + (:policy :fast-safe) + (:args (number :scs (signed-reg) :target result) (amount :scs (signed-reg) :target ecx)) - (:arg-types (:or signed-num unsigned-num) signed-num) - (:results (result :scs (signed-reg unsigned-reg) :from (:argument 0))) - (:result-types (:or signed-num unsigned-num)) + (:arg-types signed-num signed-num) + (:results (result :scs (signed-reg) :from (:argument 0))) + (:result-types signed-num) (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 1)) ecx) (:note "inline ASH") (:generator 5 (move result number) - (move ecx amount) + (move ecx amount) (inst or ecx ecx) (inst jmp :ns positive) (inst neg ecx) @@ -713,9 +749,7 @@ (inst jmp :be okay) (inst mov ecx 31) OKAY - (sc-case number - (signed-reg (inst sar result :cl)) - (unsigned-reg (inst shr result :cl))) + (inst sar result :cl) (inst jmp done) POSITIVE @@ -723,6 +757,70 @@ (inst shl result :cl) DONE)) + +(define-vop (fast-ash/unsigned=>unsigned) + (:translate ash) + (:policy :fast-safe) + (:args (number :scs (unsigned-reg) :target result) + (amount :scs (signed-reg) :target ecx)) + (:arg-types unsigned-num signed-num) + (:results (result :scs (unsigned-reg) :from (:argument 0))) + (:result-types unsigned-num) + (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 1)) ecx) + (:note "inline ASH") + (:generator 5 + (move result number) + (move ecx amount) + (inst or ecx ecx) + (inst jmp :ns positive) + (inst neg ecx) + (inst cmp ecx 31) + (inst jmp :be okay) + (inst xor result result) + (inst jmp done) + OKAY + (inst shr result :cl) + (inst jmp done) + + POSITIVE + ;; The result-type ensures us that this shift will not overflow. + (inst shl result :cl) + + DONE)) + +;;; 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 +;;; than the above version with branches. -- CSR, 2003-09-04 +(define-vop (fast-cmov-ash/unsigned=>unsigned) + (:translate ash) + (:policy :fast-safe) + (:args (number :scs (unsigned-reg) :target result) + (amount :scs (signed-reg) :target ecx)) + (:arg-types unsigned-num signed-num) + (:results (result :scs (unsigned-reg) :from (:argument 0))) + (:result-types unsigned-num) + (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 1)) ecx) + (:temporary (:sc any-reg :from (:eval 0) :to (:eval 1)) zero) + (:note "inline ASH") + (:guard (member :cmov *backend-subfeatures*)) + (:generator 4 + (move result number) + (move ecx amount) + (inst or ecx ecx) + (inst jmp :ns positive) + (inst neg ecx) + (inst xor zero zero) + (inst shr result :cl) + (inst cmp ecx 31) + (inst cmov :nbe result zero) + (inst jmp done) + + POSITIVE + ;; The result-type ensures us that this shift will not overflow. + (inst shl result :cl) + + DONE)) ;;; Note: documentation for this function is wrong - rtfm (define-vop (signed-byte-32-len) @@ -1071,6 +1169,23 @@ (define-vop (fast-logxor-mod32-c/unsigned=>unsigned fast-logxor-c/unsigned=>unsigned) (:translate logxor-mod32)) + +(define-source-transform logeqv (&rest args) + (if (oddp (length args)) + `(logxor ,@args) + `(lognot (logxor ,@args)))) +(define-source-transform logandc1 (x y) + `(logand (lognot ,x) ,y)) +(define-source-transform logandc2 (x y) + `(logand ,x (lognot ,y))) +(define-source-transform logorc1 (x y) + `(logior (lognot ,x) ,y)) +(define-source-transform logorc2 (x y) + `(logior ,x (lognot ,y))) +(define-source-transform lognor (x y) + `(lognot (logior ,x ,y))) +(define-source-transform lognand (x y) + `(lognot (logand ,x ,y))) ;;;; bignum stuff @@ -1383,12 +1498,12 @@ (foldable flushable)) (defoptimizer (%lea derive-type) ((base index scale disp)) - (when (and (constant-continuation-p scale) - (constant-continuation-p disp)) - (let ((scale (continuation-value scale)) - (disp (continuation-value disp)) - (base-type (continuation-type base)) - (index-type (continuation-type index))) + (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)) @@ -1530,7 +1645,7 @@ ((unsigned-byte 32) (constant-arg (unsigned-byte 32))) (unsigned-byte 32)) "recode as leas, shifts and adds" - (let ((y (continuation-value y))) + (let ((y (lvar-value y))) (cond ((= y (ash 1 (integer-length y))) ;; there's a generic transform for y = 2^k