Raymond Toy pushed to branch master at cmucl / cmucl
Commits: 7a1457da by Raymond Toy at 2015-12-11T19:25:30Z New implementation of the digit shifters.
Define new vops for the digit shifters that take a constant (unsigned-byte 5) value. The previous version, while correct, still causes the ecx register to spill because it was a temporary. This doens't cause the compiler to spill ecx unnecessarily anymore.
- - - - -
1 changed file:
- src/compiler/x86/arith.lisp
Changes:
===================================== src/compiler/x86/arith.lisp ===================================== --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1445,7 +1445,7 @@ (:translate bignum::%ashr) (:policy :fast-safe) (:args (digit :scs (unsigned-reg unsigned-stack) :target result) - (count :scs (unsigned-reg immediate))) + (count :scs (unsigned-reg))) (: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) @@ -1454,53 +1454,52 @@ (:result-types unsigned-num) (:generator 2 (move result digit) - (sc-case count - (unsigned-reg - (move ecx count) - (inst sar result :cl)) - (immediate - (let ((amount (tn-value count))) - ;; If the amount is greater than 31, it's the same as - ;; shifting by 31, leaving just the sign bit. - (inst sar result (if (>= amount vm:word-bits) - (1- vm:word-bits) - amount))))))) + (move ecx count) + (inst sar result :cl))) + +(define-vop (digit-ashr-c) + (:translate bignum::%ashr) + (:policy :fast-safe) + (:args (digit :scs (unsigned-reg unsigned-stack) :target result)) + (:info count) + (:arg-types unsigned-num (:constant (unsigned-byte #.(1- (integer-length vm:word-bits))))) + (:results (result :scs (unsigned-reg) :from (:argument 0) + :load-if (not (and (sc-is result unsigned-stack) + (location= digit result))))) + (:result-types unsigned-num) + (:generator 1 + (move result digit) + ;; If the count is greater than 31, it's the same as + ;; shifting by 31, leaving just the sign bit. + (inst sar result count)))
(define-vop (digit-lshr digit-ashr) (:translate bignum::%digit-logical-shift-right) (:generator 2 - (sc-case count - (unsigned-reg - (move result digit) - (move ecx count) - (inst shr result :cl)) - (immediate - (let ((amount (tn-value count))) - ;; If the amount is greater than 31, the result is 0 because - ;; all the bits get shifted right and out. - (cond ((>= amount vm:word-bits) - (inst mov result 0)) - (t - (move result digit) - (inst shr result count)))))))) + (move result digit) + (move ecx count) + (inst shr result :cl))) + +(define-vop (digit-lshr-c digit-ashr-c) + (:translate bignum::%digit-logical-shift-right) + (:generator 1 + (move result digit) + (inst shr result count)))
(define-vop (digit-ashl digit-ashr) (:translate bignum::%ashl) (:generator 2 - (sc-case count - (unsigned-reg - (move result digit) - (move ecx count) - (inst shl result :cl)) - (immediate - (let ((amount (tn-value count))) - ;; If the amount is greater than 31, the result is 0 because - ;; all the bits get shifted left and out. - (cond ((>= amount vm:word-bits) - (inst mov result 0)) - (t - (move result digit) - (inst shl result amount)))))))) + (move result digit) + (move ecx count) + (inst shl result :cl))) + +(define-vop (digit-ashl-c digit-ashr-c) + (:translate bignum::%ashl) + (:generator 1 + (move result digit) + (inst shl result count))) + +
;;;; Static functions.
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/7a1457da0f9169bcd0007a7ac8...