summaryrefslogtreecommitdiff
path: root/src/floatfns.c
diff options
context:
space:
mode:
authorPaul Eggert <eggert@cs.ucla.edu>2019-11-13 13:07:01 -0800
committerPaul Eggert <eggert@cs.ucla.edu>2019-11-13 13:10:09 -0800
commitbede5984246ba734c93fc28148b5f8e1b14d30c5 (patch)
treed5ec0482e1ed6b8dad42e65c9d9ea4eb2e2b75ff /src/floatfns.c
parent02e637ecca3b1419d2a6c433eca72c5728c65051 (diff)
downloademacs-bede5984246ba734c93fc28148b5f8e1b14d30c5.tar.gz
Fix double-rounding bug in ceiling etc.
This is doable now that we have bignums. * src/floatfns.c (integer_value): Remove; no longer used. (rescale_for_division): New function. (rounding_driver): Use it to divide properly (by using bignums) even when arguments are float, fixing a double-rounding FIXME. * src/lisp.h (LOG2_FLT_RADIX): Move here ... * src/timefns.c (frac_to_double): ... from here. * test/src/floatfns-tests.el (big-round): Add a test to catch the double-rounding bug.
Diffstat (limited to 'src/floatfns.c')
-rw-r--r--src/floatfns.c115
1 files changed, 50 insertions, 65 deletions
diff --git a/src/floatfns.c b/src/floatfns.c
index 7e77dbd16dc..a626845377a 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -335,19 +335,6 @@ This is the same as the exponent of a float. */)
return make_fixnum (value);
}
-/* True if A is exactly representable as an integer. */
-
-static bool
-integer_value (Lisp_Object a)
-{
- if (FLOATP (a))
- {
- double d = XFLOAT_DATA (a);
- return d == floor (d) && isfinite (d);
- }
- return true;
-}
-
/* Return the integer exponent E such that D * FLT_RADIX**E (i.e.,
scalbn (D, E)) is an integer that has precision equal to D and is
representable as a double.
@@ -371,70 +358,68 @@ double_integer_scale (double d)
&& (FP_ILOGB0 != INT_MIN || d != 0)))));
}
+/* Convert the Lisp number N to an integer and return a pointer to the
+ converted integer, represented as an mpz_t *. Use *T as a
+ temporary; the returned value might be T. Scale N by the maximum
+ of NSCALE and DSCALE while converting. If NSCALE is nonzero, N
+ must be a float; signal an overflow if NSCALE is greater than
+ DBL_MANT_DIG - DBL_MIN_EXP, otherwise scalbn (XFLOAT_DATA (N), NSCALE)
+ must return an integer value, without rounding or overflow. */
+
+static mpz_t const *
+rescale_for_division (Lisp_Object n, mpz_t *t, int nscale, int dscale)
+{
+ mpz_t const *pn;
+
+ if (FLOATP (n))
+ {
+ if (DBL_MANT_DIG - DBL_MIN_EXP < nscale)
+ overflow_error ();
+ mpz_set_d (*t, scalbn (XFLOAT_DATA (n), nscale));
+ pn = t;
+ }
+ else
+ pn = bignum_integer (t, n);
+
+ if (nscale < dscale)
+ {
+ emacs_mpz_mul_2exp (*t, *pn, (dscale - nscale) * LOG2_FLT_RADIX);
+ pn = t;
+ }
+ return pn;
+}
+
/* the rounding functions */
static Lisp_Object
-rounding_driver (Lisp_Object arg, Lisp_Object divisor,
+rounding_driver (Lisp_Object n, Lisp_Object d,
double (*double_round) (double),
void (*int_divide) (mpz_t, mpz_t const, mpz_t const),
EMACS_INT (*fixnum_divide) (EMACS_INT, EMACS_INT))
{
- CHECK_NUMBER (arg);
+ CHECK_NUMBER (n);
- double d;
- if (NILP (divisor))
- {
- if (! FLOATP (arg))
- return arg;
- d = XFLOAT_DATA (arg);
- }
- else
- {
- CHECK_NUMBER (divisor);
- if (integer_value (arg) && integer_value (divisor))
- {
- /* Divide as integers. Converting to double might lose
- info, even for fixnums; also see the FIXME below. */
-
- if (FLOATP (arg))
- arg = double_to_integer (XFLOAT_DATA (arg));
- if (FLOATP (divisor))
- divisor = double_to_integer (XFLOAT_DATA (divisor));
-
- if (FIXNUMP (divisor))
- {
- if (XFIXNUM (divisor) == 0)
- xsignal0 (Qarith_error);
- if (FIXNUMP (arg))
- return make_int (fixnum_divide (XFIXNUM (arg),
- XFIXNUM (divisor)));
- }
- int_divide (mpz[0],
- *bignum_integer (&mpz[0], arg),
- *bignum_integer (&mpz[1], divisor));
- return make_integer_mpz ();
- }
+ if (NILP (d))
+ return FLOATP (n) ? double_to_integer (double_round (XFLOAT_DATA (n))) : n;
- double f1 = XFLOATINT (arg);
- double f2 = XFLOATINT (divisor);
- if (! IEEE_FLOATING_POINT && f2 == 0)
- xsignal0 (Qarith_error);
- /* FIXME: This division rounds, so the result is double-rounded. */
- d = f1 / f2;
- }
+ CHECK_NUMBER (d);
- /* Round, coarsely test for fixnum overflow before converting to
- EMACS_INT (to avoid undefined C behavior), and then exactly test
- for overflow after converting (as FIXNUM_OVERFLOW_P is inaccurate
- on floats). */
- double dr = double_round (d);
- if (fabs (dr) < 2 * (MOST_POSITIVE_FIXNUM + 1))
+ if (FIXNUMP (d))
{
- EMACS_INT ir = dr;
- if (! FIXNUM_OVERFLOW_P (ir))
- return make_fixnum (ir);
+ if (XFIXNUM (d) == 0)
+ xsignal0 (Qarith_error);
+
+ /* Divide fixnum by fixnum specially, for speed. */
+ if (FIXNUMP (n))
+ return make_int (fixnum_divide (XFIXNUM (n), XFIXNUM (d)));
}
- return double_to_integer (dr);
+
+ int nscale = FLOATP (n) ? double_integer_scale (XFLOAT_DATA (n)) : 0;
+ int dscale = FLOATP (d) ? double_integer_scale (XFLOAT_DATA (d)) : 0;
+ int_divide (mpz[0],
+ *rescale_for_division (n, &mpz[0], nscale, dscale),
+ *rescale_for_division (d, &mpz[1], dscale, nscale));
+ return make_integer_mpz ();
}
static EMACS_INT