procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make % and mod handle bignums

Browse source 
* 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.
This commit is contained in:
Tom Tromey 2018-07-07 23:42:10 -06:00
parent d0fac17abd
commit 3dea8f8f53
3 changed files with 122 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

112
src/data.c
View file

@ -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;
}

8
src/lisp.h
View file

@ -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

17
test/src/data-tests.el
View file

@ -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