[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master ee641b8: Fix bugs when rounding to bignums
From: |
Paul Eggert |
Subject: |
[Emacs-diffs] master ee641b8: Fix bugs when rounding to bignums |
Date: |
Wed, 22 Aug 2018 22:31:01 -0400 (EDT) |
branch: master
commit ee641b87cf220250ba89f219fb47a4406a05deb7
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
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.
---
doc/lispref/errors.texi | 8 +++++---
doc/lispref/numbers.texi | 2 +-
src/alloc.c | 6 +++---
src/data.c | 8 ++++----
src/floatfns.c | 16 ++++++++++++++--
src/lisp.h | 2 +-
test/src/floatfns-tests.el | 12 ++++++++----
7 files changed, 36 insertions(+), 18 deletions(-)
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index a0e32c5..e61ea98 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
address@hidden range-error
+The message is @code{Arithmetic range error}.
+This can happen with integers exceeding the @code{integer-width} limit.
address@hidden 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}.
address@hidden 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 a815047..d031136 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 24a24aa..cdcd465 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 08c7271..170a74a 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 c09fe9d..e788486 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 c5593b2..bca4dfb 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 592efce..d41b08f 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))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master ee641b8: Fix bugs when rounding to bignums,
Paul Eggert <=