aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorPaul Eggert2018-09-11 11:21:11 -0700
committerPaul Eggert2018-09-11 11:34:43 -0700
commitfa3785ea5fd73eaba84b8e3b8f988dd53f3a4148 (patch)
tree3b37f928b5c5b80a92e467f2b49c333e05cf7b3b /src
parent94297848332f01a18b5a6a7d29f46d03dcd881ec (diff)
downloademacs-fa3785ea5fd73eaba84b8e3b8f988dd53f3a4148.tar.gz
emacs-fa3785ea5fd73eaba84b8e3b8f988dd53f3a4148.zip
Use overflow-error for bignum overflow
This better corresponds to what emacs-26 did in the rare cases where it checked for integer overflow. * src/alloc.c (range_error): Remove. All uses changed to overflow_error. * src/eval.c (overflow_error): New function.
Diffstat (limited to 'src')
-rw-r--r--src/alloc.c8
-rw-r--r--src/bignum.c2
-rw-r--r--src/data.c8
-rw-r--r--src/eval.c8
-rw-r--r--src/lisp.h2
5 files changed, 14 insertions, 14 deletions
diff --git a/src/alloc.c b/src/alloc.c
index abb98a9eb68..6bced4e8f01 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -7120,14 +7120,6 @@ verify_alloca (void)
7120 7120
7121#endif /* ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */ 7121#endif /* ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */
7122 7122
7123/* Memory allocation for GMP. */
7124
7125void
7126range_error (void)
7127{
7128 xsignal0 (Qrange_error);
7129}
7130
7131/* Initialization. */ 7123/* Initialization. */
7132 7124
7133void 7125void
diff --git a/src/bignum.c b/src/bignum.c
index f4c24d132be..2da2c961c47 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -80,7 +80,7 @@ make_bignum_bits (size_t bits)
80 /* The documentation says integer-width should be nonnegative, so 80 /* The documentation says integer-width should be nonnegative, so
81 a single comparison suffices even though 'bits' is unsigned. */ 81 a single comparison suffices even though 'bits' is unsigned. */
82 if (integer_width < bits) 82 if (integer_width < bits)
83 range_error (); 83 overflow_error ();
84 84
85 struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, 85 struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
86 PVEC_BIGNUM); 86 PVEC_BIGNUM);
diff --git a/src/data.c b/src/data.c
index 66f69e7e83a..1e97d9efa15 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2407,7 +2407,7 @@ static void
2407emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2) 2407emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2)
2408{ 2408{
2409 if (NLIMBS_LIMIT - emacs_mpz_size (op1) < emacs_mpz_size (op2)) 2409 if (NLIMBS_LIMIT - emacs_mpz_size (op1) < emacs_mpz_size (op2))
2410 range_error (); 2410 overflow_error ();
2411 mpz_mul (rop, op1, op2); 2411 mpz_mul (rop, op1, op2);
2412} 2412}
2413 2413
@@ -2421,7 +2421,7 @@ emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, mp_bitcnt_t op2)
2421 2421
2422 mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS; 2422 mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS;
2423 if (lim - emacs_mpz_size (op1) < op2limbs) 2423 if (lim - emacs_mpz_size (op1) < op2limbs)
2424 range_error (); 2424 overflow_error ();
2425 mpz_mul_2exp (rop, op1, op2); 2425 mpz_mul_2exp (rop, op1, op2);
2426} 2426}
2427 2427
@@ -2435,7 +2435,7 @@ emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp)
2435 2435
2436 int nbase = emacs_mpz_size (base), n; 2436 int nbase = emacs_mpz_size (base), n;
2437 if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n) 2437 if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n)
2438 range_error (); 2438 overflow_error ();
2439 mpz_pow_ui (rop, base, exp); 2439 mpz_pow_ui (rop, base, exp);
2440} 2440}
2441 2441
@@ -3292,7 +3292,7 @@ expt_integer (Lisp_Object x, Lisp_Object y)
3292 && mpz_fits_ulong_p (XBIGNUM (y)->value)) 3292 && mpz_fits_ulong_p (XBIGNUM (y)->value))
3293 exp = mpz_get_ui (XBIGNUM (y)->value); 3293 exp = mpz_get_ui (XBIGNUM (y)->value);
3294 else 3294 else
3295 range_error (); 3295 overflow_error ();
3296 3296
3297 emacs_mpz_pow_ui (mpz[0], *bignum_integer (&mpz[0], x), exp); 3297 emacs_mpz_pow_ui (mpz[0], *bignum_integer (&mpz[0], x), exp);
3298 return make_integer_mpz (); 3298 return make_integer_mpz ();
diff --git a/src/eval.c b/src/eval.c
index 60dd6f1e8d2..500427cb62b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1765,6 +1765,14 @@ signal_error (const char *s, Lisp_Object arg)
1765 xsignal (Qerror, Fcons (build_string (s), arg)); 1765 xsignal (Qerror, Fcons (build_string (s), arg));
1766} 1766}
1767 1767
1768/* Use this for arithmetic overflow, e.g., when an integer result is
1769 too large even for a bignum. */
1770void
1771overflow_error (void)
1772{
1773 xsignal0 (Qoverflow_error);
1774}
1775
1768 1776
1769/* Return true if LIST is a non-nil atom or 1777/* Return true if LIST is a non-nil atom or
1770 a list containing one of CONDITIONS. */ 1778 a list containing one of CONDITIONS. */
diff --git a/src/lisp.h b/src/lisp.h
index 454d728f9e0..bb190b691b0 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3751,7 +3751,6 @@ extern void display_malloc_warning (void);
3751extern ptrdiff_t inhibit_garbage_collection (void); 3751extern ptrdiff_t inhibit_garbage_collection (void);
3752extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); 3752extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
3753extern void free_cons (struct Lisp_Cons *); 3753extern void free_cons (struct Lisp_Cons *);
3754extern _Noreturn void range_error (void);
3755extern void init_alloc_once (void); 3754extern void init_alloc_once (void);
3756extern void init_alloc (void); 3755extern void init_alloc (void);
3757extern void syms_of_alloc (void); 3756extern void syms_of_alloc (void);
@@ -3888,6 +3887,7 @@ extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
3888extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, 3887extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object,
3889 Lisp_Object); 3888 Lisp_Object);
3890extern _Noreturn void signal_error (const char *, Lisp_Object); 3889extern _Noreturn void signal_error (const char *, Lisp_Object);
3890extern _Noreturn void overflow_error (void);
3891extern bool FUNCTIONP (Lisp_Object); 3891extern bool FUNCTIONP (Lisp_Object);
3892extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); 3892extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector);
3893extern Lisp_Object eval_sub (Lisp_Object form); 3893extern Lisp_Object eval_sub (Lisp_Object form);