diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp index 3072fc72f9d3ef58471a43f4dd22339caff09681..ae4c86afc8bd924e9f29a03ebf720d3943e6c683 100644 --- 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))))) diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 893b20194a15e73c1056f3b2cd6f76c996247ecf..2b541099129b719e81f76040f167a62fee6f735e 100644 --- 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. diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 002d4521f90306cdb42b2af375bcf4d6561ebf3c..174579ce6d2724ed238a2760444a0f7b5dc7a72b 100644 --- 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