[Emacs-diffs] feature/bignum 3dea8f8 19/24: Make % and mod handle bignums

[Tom Tromey]

branch: feature/bignum
commit 3dea8f8f53f81a1d15a55c9e3c87a7eade7ca273
Author: Tom Tromey <address@hidden>
Commit: Tom Tromey <address@hidden>

    Make % and mod handle bignums
    
    * src/data.c (Frem, Fmod): Handle bignums.
    * src/lisp.h (CHECK_INTEGER_COERCE_MARKER): New macro.
    * test/src/data-tests.el (data-tests-check-sign)
    (data-tests-%-mod): New tests.
---
 src/data.c             | 112 ++++++++++++++++++++++++++++++++++++++++++-------
 src/lisp.h             |   8 ++++
 test/src/data-tests.el |  17 ++++++++
 3 files changed, 122 insertions(+), 15 deletions(-)

diff --git a/src/data.c b/src/data.c
index 7ded836..ac74ff5 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3073,13 +3073,47 @@ Both must be integers or markers.  */)
 {
   Lisp_Object val;
 
-  CHECK_FIXNUM_COERCE_MARKER (x);
-  CHECK_FIXNUM_COERCE_MARKER (y);
+  CHECK_INTEGER_COERCE_MARKER (x);
+  CHECK_INTEGER_COERCE_MARKER (y);
 
-  if (XINT (y) == 0)
+  /* Note that a bignum can never be 0, so we don't need to check that
+     case.  */
+  if (FIXNUMP (y) && XINT (y) == 0)
     xsignal0 (Qarith_error);
 
-  XSETINT (val, XINT (x) % XINT (y));
+  if (FIXNUMP (x) && FIXNUMP (y))
+    XSETINT (val, XINT (x) % XINT (y));
+  else
+    {
+      mpz_t xm, ym, *xmp, *ymp;
+      mpz_t result;
+
+      if (BIGNUMP (x))
+       xmp = &XBIGNUM (x)->value;
+      else
+       {
+         mpz_init_set_si (xm, XINT (x));
+         xmp = &xm;
+       }
+
+      if (BIGNUMP (y))
+       ymp = &XBIGNUM (y)->value;
+      else
+       {
+         mpz_init_set_si (ym, XINT (y));
+         ymp = &ym;
+       }
+
+      mpz_init (result);
+      mpz_tdiv_r (result, *xmp, *ymp);
+      val = make_number (result);
+      mpz_clear (result);
+
+      if (xmp == &xm)
+       mpz_clear (xm);
+      if (ymp == &ym)
+       mpz_clear (ym);
+    }
   return val;
 }
 
@@ -3092,25 +3126,73 @@ Both X and Y must be numbers or markers.  */)
   Lisp_Object val;
   EMACS_INT i1, i2;
 
-  CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (x);
-  CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (y);
+  CHECK_NUMBER_COERCE_MARKER (x);
+  CHECK_NUMBER_COERCE_MARKER (y);
+
+  /* Note that a bignum can never be 0, so we don't need to check that
+     case.  */
+  if (FIXNUMP (y) && XINT (y) == 0)
+    xsignal0 (Qarith_error);
 
   if (FLOATP (x) || FLOATP (y))
     return fmod_float (x, y);
 
-  i1 = XINT (x);
-  i2 = XINT (y);
+  if (FIXNUMP (x) && FIXNUMP (y))
+    {
+      i1 = XINT (x);
+      i2 = XINT (y);
 
-  if (i2 == 0)
-    xsignal0 (Qarith_error);
+      if (i2 == 0)
+       xsignal0 (Qarith_error);
 
-  i1 %= i2;
+      i1 %= i2;
 
-  /* If the "remainder" comes out with the wrong sign, fix it.  */
-  if (i2 < 0 ? i1 > 0 : i1 < 0)
-    i1 += i2;
+      /* If the "remainder" comes out with the wrong sign, fix it.  */
+      if (i2 < 0 ? i1 > 0 : i1 < 0)
+       i1 += i2;
+
+      XSETINT (val, i1);
+    }
+  else
+    {
+      mpz_t xm, ym, *xmp, *ymp;
+      mpz_t result;
+      int cmpr, cmpy;
+
+      if (BIGNUMP (x))
+       xmp = &XBIGNUM (x)->value;
+      else
+       {
+         mpz_init_set_si (xm, XINT (x));
+         xmp = &xm;
+       }
+
+      if (BIGNUMP (y))
+       ymp = &XBIGNUM (y)->value;
+      else
+       {
+         mpz_init_set_si (ym, XINT (y));
+         ymp = &ym;
+       }
+
+      mpz_init (result);
+      mpz_mod (result, *xmp, *ymp);
+
+      /* Fix the sign if needed.  */
+      cmpr = mpz_cmp_si (result, 0);
+      cmpy = mpz_cmp_si (*ymp, 0);
+      if (cmpy < 0 ? cmpr > 0 : cmpr < 0)
+       mpz_add (result, result, *ymp);
+
+      val = make_number (result);
+      mpz_clear (result);
+
+      if (xmp == &xm)
+       mpz_clear (xm);
+      if (ymp == &ym)
+       mpz_clear (ym);
+    }
 
-  XSETINT (val, i1);
   return val;
 }
 
diff --git a/src/lisp.h b/src/lisp.h
index 63b0570..846e955 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2958,6 +2958,14 @@ CHECK_INTEGER (Lisp_Object x)
       CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x);                        
\
   } while (false)
 
+#define CHECK_INTEGER_COERCE_MARKER(x)                                 \
+  do {                                                                 \
+    if (MARKERP (x))                                                   \
+      XSETFASTINT (x, marker_position (x));                            \
+    else                                                               \
+      CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x);               \
+  } while (false)
+
 /* Since we can't assign directly to the CAR or CDR fields of a cons
    cell, use these when checking that those fields contain numbers.  */
 INLINE void
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 4565cfb..2423d7a 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -597,4 +597,21 @@ comparing the subr with a much slower lisp implementation."
     (should (= (min a b c) a))
     (should (= (max a b c) b))))
 
+(defun data-tests-check-sign (x y)
+  (should (eq (cl-signum x) (cl-signum y))))
+
+(ert-deftest data-tests-%-mod ()
+  (let* ((b1 (+ most-positive-fixnum 1))
+         (nb1 (- b1))
+         (b3 (+ most-positive-fixnum 3))
+         (nb3 (- b3)))
+    (data-tests-check-sign (% 1 3) (% b1 b3))
+    (data-tests-check-sign (mod 1 3) (mod b1 b3))
+    (data-tests-check-sign (% 1 -3) (% b1 nb3))
+    (data-tests-check-sign (mod 1 -3) (mod b1 nb3))
+    (data-tests-check-sign (% -1 3) (% nb1 b3))
+    (data-tests-check-sign (mod -1 3) (mod nb1 b3))
+    (data-tests-check-sign (% -1 -3) (% nb1 nb3))
+    (data-tests-check-sign (mod -1 -3) (mod nb1 nb3))))
+
 ;;; data-tests.el ends here