From 0b36041d2a528419982a19940573783ff318c0d4 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 22 Sep 2018 08:59:06 -0700 Subject: [PATCH] Round bignums consistently with other integers * src/bignum.c (mpz_bufsize): New function. (bignum_bufsize): Use it. (mpz_get_d_rounded): New function. (bignum_to_double): Use it. * src/bignum.c (bignum_to_double): * src/data.c (bignum_arith_driver): When converting bignums to double, round instead of truncating, to be consistent with what happens with fixnums. * test/src/floatfns-tests.el (bignum-to-float): Test rounding. --- src/bignum.c | 34 +++++++++++++++++++++++++++++++--- src/bignum.h | 1 + src/data.c | 2 +- test/src/floatfns-tests.el | 6 ++++++ 4 files changed, 39 insertions(+), 4 deletions(-) diff --git a/src/bignum.c b/src/bignum.c index 5e86c404b70..1e78d981b7d 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -62,7 +62,7 @@ init_bignum (void) double bignum_to_double (Lisp_Object n) { - return mpz_get_d (XBIGNUM (n)->value); + return mpz_get_d_rounded (XBIGNUM (n)->value); } /* Return D, converted to a Lisp integer. Discard any fraction. @@ -251,12 +251,40 @@ bignum_to_uintmax (Lisp_Object x) } /* Yield an upper bound on the buffer size needed to contain a C - string representing the bignum NUM in base BASE. This includes any + string representing the NUM in base BASE. This includes any preceding '-' and the terminating null. */ +static ptrdiff_t +mpz_bufsize (mpz_t const num, int base) +{ + return mpz_sizeinbase (num, base) + 2; +} ptrdiff_t bignum_bufsize (Lisp_Object num, int base) { - return mpz_sizeinbase (XBIGNUM (num)->value, base) + 2; + return mpz_bufsize (XBIGNUM (num)->value, base); +} + +/* Convert NUM to a nearest double, as opposed to mpz_get_d which + truncates toward zero. */ +double +mpz_get_d_rounded (mpz_t const num) +{ + ptrdiff_t size = mpz_bufsize (num, 10); + + /* Use mpz_get_d as a shortcut for a bignum so small that rounding + errors cannot occur, which is possible if EMACS_INT (not counting + sign) has fewer bits than a double significand. */ + if (! ((FLT_RADIX == 2 && DBL_MANT_DIG <= FIXNUM_BITS - 1) + || (FLT_RADIX == 16 && DBL_MANT_DIG * 4 <= FIXNUM_BITS - 1)) + && size <= DBL_DIG + 2) + return mpz_get_d (num); + + USE_SAFE_ALLOCA; + char *buf = SAFE_ALLOCA (size); + mpz_get_str (buf, 10, num); + double result = strtod (buf, NULL); + SAFE_FREE (); + return result; } /* Store into BUF (of size SIZE) the value of NUM as a base-BASE string. diff --git a/src/bignum.h b/src/bignum.h index 65515493436..e9cd5c07635 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -46,6 +46,7 @@ extern mpz_t mpz[4]; extern void init_bignum (void); extern Lisp_Object make_integer_mpz (void); extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1)); +extern double mpz_get_d_rounded (mpz_t const); INLINE_HEADER_BEGIN diff --git a/src/data.c b/src/data.c index cc080372d8b..750d494b83a 100644 --- a/src/data.c +++ b/src/data.c @@ -2921,7 +2921,7 @@ bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, CHECK_NUMBER_COERCE_MARKER (val); if (FLOATP (val)) return float_arith_driver (code, nargs, args, argnum, - mpz_get_d (*accum), val); + mpz_get_d_rounded (*accum), val); } } diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 14576b603c0..61b1c25743d 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -35,6 +35,12 @@ (should-error (fround 0) :type 'wrong-type-argument)) (ert-deftest bignum-to-float () + ;; 122 because we want to go as big as possible to provoke a rounding error, + ;; but not too big: 2**122 < 10**37 < 2**123, and the C standard says + ;; 10**37 <= DBL_MAX so 2**122 cannot overflow as a double. + (let ((a (1- (ash 1 122)))) + (should (or (eql a (1- (floor (float a)))) + (eql a (floor (float a)))))) (should (eql (float (+ most-positive-fixnum 1)) (+ (float most-positive-fixnum) 1)))) -- 2.39.2