Add bignum-negate-last-two-loop VOP.

3 files changed, 57 insertions, 13 deletions

diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp
index 029366068..baf633048 100644
--- a/src/code/bignum.lisp
+++ b/src/code/bignum.lisp
@@ -1301,19 +1301,22 @@
 
 (declaim (inline bignum-negate-last-two))
 (defun bignum-negate-last-two (bignum &optional (len (%bignum-length bignum)))
-  (let* ((last1 0)
-         (last2 0)
-         (carry 1)
-         (i 0))
-    (declare (type bit carry)
-             (type bignum-index i))
-    (loop (when (= i len)
-            (return))
-          (setf last1 last2)
-          (setf (values last2 carry)
-                (%add-with-carry (%lognot (%bignum-ref bignum i)) 0 carry))
-          (incf i))
-    (values last1 last2)))
+  (declare (bignum-length len))
+  (sb-c::if-vop-existsp (:named sb-vm::bignum-negate-last-two-loop)
+    (sb-sys:%primitive sb-vm::bignum-negate-last-two-loop bignum len)
+    (let* ((last1 0)
+           (last2 0)
+           (carry 1)
+           (i 0))
+      (declare (type bit carry)
+               (type bignum-index i))
+      (loop (setf last1 last2)
+            (setf (values last2 carry)
+                  (%add-with-carry (%lognot (%bignum-ref bignum i)) 0 carry))
+            (incf i)
+            (when (= i len)
+              (return)))
+      (values last1 last2))))
 
 ;;; Make a single or double float with the specified significand,
 ;;; exponent and sign.
diff --git a/src/compiler/arm64/arith.lisp b/src/compiler/arm64/arith.lisp
index ccfcfa964..da66dcf48 100644
--- a/src/compiler/arm64/arith.lisp
+++ b/src/compiler/arm64/arith.lisp
@@ -1600,6 +1600,26 @@
     (inst sub length length 1)
     (inst cbnz length LOOP)))
 
+(define-vop (bignum-negate-last-two-loop)
+  (:args (a* :scs (descriptor-reg) :to :save)
+         (l :scs (unsigned-reg) :target length))
+  (:arg-types bignum unsigned-num)
+  (:temporary (:sc unsigned-reg :from (:argument 1)) length)
+  (:temporary (:sc unsigned-reg) a)
+  (:results (last1 :scs (unsigned-reg))
+            (last2 :scs (unsigned-reg)))
+  (:result-types unsigned-num unsigned-num)
+  (:generator 10
+    (inst subs a a* (- other-pointer-lowtag (* bignum-digits-offset n-word-bytes))) ;; set carry
+    (move length l)
+    (inst mov last2 0)
+    LOOP
+    (move last1 last2)
+    (inst ldr last2 (@ a n-word-bytes :post-index))
+    (inst sbcs last2 zr-tn last2)
+    (inst sub length length 1)
+    (inst cbnz length LOOP)))
+
 (define-vop (sub-w/borrow)
   (:translate sb-bignum:%subtract-with-borrow)
   (:policy :fast-safe)
diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index a5d5040fd..4412ce921 100644
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -3491,6 +3491,27 @@
     (inst dec length)
     (inst jmp :nz LOOP)))
 
+(define-vop (bignum-negate-last-two-loop)
+  (:args (a :scs (descriptor-reg) :to :save)
+         (l :scs (unsigned-reg) :target length))
+  (:arg-types bignum unsigned-num)
+  (:temporary (:sc unsigned-reg :from (:argument 1)) length)
+  (:temporary (:sc unsigned-reg) index)
+  (:results (last1 :scs (unsigned-reg))
+            (last2 :scs (unsigned-reg)))
+  (:result-types unsigned-num unsigned-num)
+  (:generator 10
+    (zeroize last2)
+    (zeroize index)
+    (move length l)
+    LOOP
+    (move last1 last2)
+    (inst mov last2 0)
+    (inst sbb last2 (ea (- (* bignum-digits-offset n-word-bytes) other-pointer-lowtag) a index 8))
+    (inst inc index)
+    (inst dec length)
+    (inst jmp :nz LOOP)))
+
 ;;; Note: the borrow is 1 for no borrow and 0 for a borrow, the opposite
 ;;; of the x86-64 convention.
 (define-vop (sub-w/borrow)