Raymond Toy pushed to branch master at cmucl / cmucl Commits: ddc980d5 by Raymond Toy at 2016-01-16T14:34:19Z Add bignum::%shld and bignum::%shrd These are useful for multi-precision shifts. For x86, we can use the shld and shrd instructions. For others, we just use basic logical operations. - - - - - 3 changed files: - src/code/bignum.lisp - src/compiler/generic/vm-fndb.lisp - src/compiler/x86/arith.lisp Changes: ===================================== src/code/bignum.lisp ===================================== --- a/src/code/bignum.lisp +++ b/src/code/bignum.lisp @@ -3697,3 +3697,29 @@ friends is working. (unless (= newlen len) (%bignum-set-length result newlen)) result)) + +;; Shift X left by Shift bits, shifting in bits from Carry-in. +;; Basically treat x:carry-in as a 64-bit value and shift it left, +;; returning the top bignum-type bits. +(defun %shld (x carry-in shift) + (declare (type bignum-element-type x carry-in) + (type (unsigned-byte 5) shift)) + #+x86 + (%shld x carry-in shift) + #-x86 + (ldb (byte vm:word-bits 0) + (logior (ash x shift) + (ash carry-in (- shift vm:word-bits))))) + +;; Shift X right by Shift bits, shifting in bits from Carry-in. +;; Basically treat carry-in:x as a 64-bit value and shift it right, +;; returning the low bignum-type bits. +(defun %shrd (x carry-in shift) + (declare (type bignum-element-type x carry-in) + (type (unsigned-byte 5) shift)) + #+x86 + (%shrd x carry-in shift) + #-x86 + (ldb (byte vm:word-bits 0) + (logior (ash x (- shift)) + (ash carry-in (- vm:word-bits shift))))) ===================================== src/compiler/generic/vm-fndb.lisp ===================================== --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -288,6 +288,13 @@ (bignum-element-type (mod #+amd64 64 #-amd64 32)) bignum-element-type (foldable flushable movable)) + +#+x86 +(defknown (bignum::%shld bignum::%shrd) + (bignum-element-type bignum-element-type (unsigned-byte 5)) + bignum-element-type + (foldable flushable movable)) +  ;;;; Bit-bashing routines. ===================================== src/compiler/x86/arith.lisp ===================================== --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1579,6 +1579,86 @@ (inst mov tmp y) (inst shr tmp 18) (inst xor y tmp))) + +(define-vop (bignum-shld) + (:policy :fast-safe) + (:translate bignum::%shld) + (:args (x :scs (unsigned-reg) :target r) + (shift-in :scs (unsigned-reg)) + (amount :scs (unsigned-reg) :target cl)) + (:arg-types unsigned-num unsigned-num unsigned-num) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num) + (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) + (:temporary (:sc unsigned-reg :offset ecx-offset + :from (:argument 2) :to (:result 0)) cl) + (:generator 4 + (move cl amount) + (cond ((location= x r) + (inst shld x shift-in :cl)) + (t + (move temp x) + (inst shld temp shift-in :cl) + (move r temp))))) + +(define-vop (bignum-shld-c) + (:policy :fast-safe) + (:translate bignum::%shld) + (:args (x :scs (unsigned-reg) :target r) + (shift-in :scs (unsigned-reg))) + (:info shift) + (:arg-types unsigned-num unsigned-num (:constant (unsigned-byte 5))) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num) + (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) + (:generator 3 + (cond ((location= x r) + (inst shld x shift-in shift)) + (t + (move temp x) + (inst shld temp shift-in shift) + (move r temp))))) + +(define-vop (bignum-shrd) + (:policy :fast-safe) + (:translate bignum::%shrd) + (:args (x :scs (unsigned-reg) :target r) + (shift-in :scs (unsigned-reg)) + (amount :scs (unsigned-reg) :target cl)) + (:arg-types unsigned-num unsigned-num unsigned-num) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num) + (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) + (:temporary (:sc unsigned-reg :offset ecx-offset + :from (:argument 2) :to (:result 0)) cl) + (:generator 4 + (move cl amount) + (cond ((location= x r) + (inst shrd x shift-in :cl)) + (t + (move temp x) + (inst shrd temp shift-in :cl) + (move r temp))))) + +(define-vop (bignum-shrd-c) + (:policy :fast-safe) + (:translate bignum::%shrd) + (:args (x :scs (unsigned-reg)) + (shift-in :scs (unsigned-reg))) + (:info shift) + (:arg-types unsigned-num unsigned-num (:constant (unsigned-byte 5))) + (:results (r :scs (unsigned-reg))) + (:result-types unsigned-num) + (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp) + (:generator 3 + (cond ((location= x r) + (inst shrd x shift-in shift)) + (t + (move temp x) + (inst shrd temp shift-in shift) + (move r temp))))) + +  ;;; Modular arithmetic ;;; logical operations View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/ddc980d5637cb21305e35c1a97...