From 3dea8f8f53f81a1d15a55c9e3c87a7eade7ca273 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sat, 7 Jul 2018 23:42:10 -0600 Subject: [PATCH] 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 7ded8366e32..ac74ff5547f 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 63b057073d0..846e955d3af 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 4565cfb3877..2423d7a7098 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 -- 2.39.2