Speed up add-bignums on x86-64.

Use a dedicated loop. That way the carry flag doesn't need to be put
into a register and then back.

2 files changed, 65 insertions, 13 deletions

diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp
index 53dacf178..26530f42a 100644
--- a/src/code/bignum.lisp
+++ b/src/code/bignum.lisp
@@ -314,19 +314,21 @@
             (values b len-b a len-a))
       (declare (bignum-index len-a))
       (let* ((len-res (1+ len-a))
-             (res (%allocate-bignum len-res))
-             (carry 0))
-        (dotimes (i len-b)
-          (setf (values (%bignum-ref res i) carry)
-                (%add-with-carry (%bignum-ref a i) (%bignum-ref b i) carry)))
-        (do ((sign-digit-b (%sign-digit b len-b))
-             (i len-b (1+ i)))
-            ((= i len-a)
-             (setf (%bignum-ref res len-a)
-                   (%add-with-carry (%sign-digit a len-a) sign-digit-b carry)))
-          (setf (values (%bignum-ref res i)
-                        carry)
-                (%add-with-carry (%bignum-ref a i) sign-digit-b carry)))
+             (res (%allocate-bignum len-res)))
+        (sb-c::if-vop-existsp (:named sb-vm::bignum-add-loop)
+          (sb-sys:%primitive sb-vm::bignum-add-loop a b len-a len-b res)
+          (let ((carry 0))
+            (dotimes (i len-b)
+              (setf (values (%bignum-ref res i) carry)
+                    (%add-with-carry (%bignum-ref a i) (%bignum-ref b i) carry)))
+            (do ((sign-digit-b (%sign-digit b len-b))
+                 (i len-b (1+ i)))
+                ((= i len-a)
+                 (setf (%bignum-ref res len-a)
+                       (%add-with-carry (%sign-digit a len-a) sign-digit-b carry)))
+              (setf (values (%bignum-ref res i)
+                            carry)
+                    (%add-with-carry (%bignum-ref a i) sign-digit-b carry)))))
         (%normalize-bignum res len-res)))))
 
 (defun add-bignum-fixnum (a b)
diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index 9b5c68a26..2ce51dc04 100644
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -3364,6 +3364,56 @@
      (inst set :c carry)
      (inst and :dword carry 1))))
 
+(define-vop (bignum-add-loop)
+  (:args (a :scs (descriptor-reg))
+         (b :scs (descriptor-reg))
+         (la :scs (unsigned-reg) :target remaining-length)
+         (lb :scs (unsigned-reg) :target length)
+         (r :scs (descriptor-reg)))
+  (:arg-types bignum bignum unsigned-num bignum unsigned-num)
+  (:temporary (:sc unsigned-reg :from (:argument 2)) length)
+  (:temporary (:sc unsigned-reg :from (:argument 3)) remaining-length)
+  (:temporary (:sc unsigned-reg) n index sign-digit-a sign-digit-b)
+  (:generator 10
+    (move length lb)
+    (move remaining-length la)
+    (inst mov sign-digit-a (ea (- #1=(- (* bignum-digits-offset n-word-bytes) other-pointer-lowtag) 8) a la 8))
+    (inst mov sign-digit-b (ea (- #1# 8) b lb 8))
+    (inst sar sign-digit-a 63)
+    (inst sar sign-digit-b 63)
+
+    (inst sub remaining-length length)
+    (inst inc remaining-length)
+
+    (zeroize index) ;; clears CF as well
+
+    LOOP-B
+    (inst mov n (ea #1# b index 8))
+    (inst adc n (ea #1# a index 8))
+    (inst mov (ea #1# r index 8) n)
+    (inst inc index)
+    (inst dec length)
+    (inst jmp :nz LOOP-B)
+
+    ;; Add the sign digit with carry to the remaining digits of the longest bignum
+    (move length remaining-length) ;; remaining length + 1
+    (inst dec length)
+    (inst jmp :z DONE)
+
+    LOOP-A
+    (inst mov n (ea #1# a index 8))
+    (inst adc n sign-digit-b)
+    (inst mov (ea #1# r index 8) n)
+
+    (inst inc index)
+    (inst dec length)
+
+    (inst jmp :nz LOOP-A)
+
+    DONE
+    (inst adc sign-digit-a sign-digit-b)
+    (inst mov :qword (ea #1# r index 8) sign-digit-a)))
+
 ;;; 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)