From: Paul Eggert Date: Thu, 23 Aug 2018 02:30:24 +0000 (-0700) Subject: Fix bugs when rounding to bignums X-Git-Tag: emacs-27.0.90~4519 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ee641b87cf220250ba89f219fb47a4406a05deb7;p=emacs.git Fix bugs when rounding to bignums Also, since Emacs historically reported a range error when rounding operations overflowed, do that consistently for all bignum overflows. * doc/lispref/errors.texi (Standard Errors): * doc/lispref/numbers.texi (Integer Basics): Document range errors. * src/alloc.c (range_error): Rename from integer_overflow. All uses changed. * src/floatfns.c (rounding_driver): When the result of a floating point rounding operation does not fit into a fixnum, put it into a bignum instead of always signaling an range error. * test/src/floatfns-tests.el (divide-extreme-sign): These tests now return the mathematically-correct answer instead of signaling an error. (bignum-round): Check that integers round to themselves. --- diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index a0e32c5631c..e61ea98e210 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -159,6 +159,11 @@ The message is @samp{No catch for tag}. @xref{Catch and Throw}. The message is @samp{Attempt to modify a protected file}. @end ignore +@item range-error +The message is @code{Arithmetic range error}. +This can happen with integers exceeding the @code{integer-width} limit. +@xref{Integer Basics}. + @item scan-error The message is @samp{Scan error}. This happens when certain syntax-parsing functions find invalid syntax or mismatched @@ -223,9 +228,6 @@ The message is @samp{Arithmetic domain error}. The message is @samp{Arithmetic overflow error}. This is a subcategory of @code{domain-error}. -@item range-error -The message is @code{Arithmetic range error}. - @item singularity-error The message is @samp{Arithmetic singularity error}. This is a subcategory of @code{domain-error}. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index a8150478613..d03113674f5 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -201,7 +201,7 @@ range are limited to absolute values less than @math{2^{n}}, @end tex where @var{n} is this variable's value. Attempts to create bignums outside -this range result in an integer overflow error. Setting this variable +this range signal a range error. Setting this variable to zero disables creation of bignums; setting it to a large number can cause Emacs to consume large quantities of memory if a computation creates huge integers. diff --git a/src/alloc.c b/src/alloc.c index 24a24aab96b..cdcd465ac5a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3771,7 +3771,7 @@ make_number (mpz_t value) /* The documentation says integer-width should be nonnegative, so a single comparison suffices even though 'bits' is unsigned. */ if (integer_width < bits) - integer_overflow (); + range_error (); struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, PVEC_BIGNUM); @@ -7203,9 +7203,9 @@ verify_alloca (void) /* Memory allocation for GMP. */ void -integer_overflow (void) +range_error (void) { - error ("Integer too large to be represented"); + xsignal0 (Qrange_error); } static void * diff --git a/src/data.c b/src/data.c index 08c7271dd79..170a74a6589 100644 --- a/src/data.c +++ b/src/data.c @@ -2406,7 +2406,7 @@ static void emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2) { if (NLIMBS_LIMIT - emacs_mpz_size (op1) < emacs_mpz_size (op2)) - integer_overflow (); + range_error (); mpz_mul (rop, op1, op2); } @@ -2420,7 +2420,7 @@ emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, mp_bitcnt_t op2) mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS; if (lim - emacs_mpz_size (op1) < op2limbs) - integer_overflow (); + range_error (); mpz_mul_2exp (rop, op1, op2); } @@ -2434,7 +2434,7 @@ emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp) int nbase = emacs_mpz_size (base), n; if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n) - integer_overflow (); + range_error (); mpz_pow_ui (rop, base, exp); } @@ -3398,7 +3398,7 @@ expt_integer (Lisp_Object x, Lisp_Object y) && mpz_fits_ulong_p (XBIGNUM (y)->value)) exp = mpz_get_ui (XBIGNUM (y)->value); else - integer_overflow (); + range_error (); mpz_t val; mpz_init (val); diff --git a/src/floatfns.c b/src/floatfns.c index c09fe9d6a5b..e7884864eef 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -410,7 +410,12 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, if (! FIXNUM_OVERFLOW_P (ir)) return make_fixnum (ir); } - xsignal2 (Qrange_error, build_string (name), arg); + mpz_t drz; + mpz_init (drz); + mpz_set_d (drz, dr); + Lisp_Object rounded = make_number (drz); + mpz_clear (drz); + return rounded; } static void @@ -501,13 +506,20 @@ systems, but 2 on others. */) return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, "round"); } +/* Since rounding_driver truncates anyway, no need to call 'trunc'. */ +static double +identity (double x) +{ + return x; +} + DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, doc: /* Truncate a floating point number to an int. Rounds ARG toward zero. With optional DIVISOR, truncate ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, trunc, mpz_tdiv_q, "truncate"); + return rounding_driver (arg, divisor, identity, mpz_tdiv_q, "truncate"); } diff --git a/src/lisp.h b/src/lisp.h index c5593b21008..bca4dfbb603 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3708,7 +3708,7 @@ extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_cons (struct Lisp_Cons *); -extern _Noreturn void integer_overflow (void); +extern _Noreturn void range_error (void); extern void init_alloc_once (void); extern void init_alloc (void); extern void syms_of_alloc (void); diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 592efce359d..d41b08f7965 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -20,10 +20,10 @@ (require 'ert) (ert-deftest divide-extreme-sign () - (should-error (ceiling most-negative-fixnum -1.0)) - (should-error (floor most-negative-fixnum -1.0)) - (should-error (round most-negative-fixnum -1.0)) - (should-error (truncate most-negative-fixnum -1.0))) + (should (= (ceiling most-negative-fixnum -1.0) (- most-negative-fixnum))) + (should (= (floor most-negative-fixnum -1.0) (- most-negative-fixnum))) + (should (= (round most-negative-fixnum -1.0) (- most-negative-fixnum))) + (should (= (truncate most-negative-fixnum -1.0) (- most-negative-fixnum)))) (ert-deftest logb-extreme-fixnum () (should (= (logb most-negative-fixnum) (1+ (logb most-positive-fixnum))))) @@ -66,6 +66,10 @@ (1+ most-positive-fixnum) (* most-positive-fixnum most-positive-fixnum)))) (dolist (n ns) + (should (= n (ceiling n))) + (should (= n (floor n))) + (should (= n (round n))) + (should (= n (truncate n))) (dolist (d ns) (let ((q (/ n d)) (r (% n d))