diff options
| author | Paul Eggert | 2018-09-11 11:21:11 -0700 |
|---|---|---|
| committer | Paul Eggert | 2018-09-11 11:34:43 -0700 |
| commit | fa3785ea5fd73eaba84b8e3b8f988dd53f3a4148 (patch) | |
| tree | 3b37f928b5c5b80a92e467f2b49c333e05cf7b3b /src | |
| parent | 94297848332f01a18b5a6a7d29f46d03dcd881ec (diff) | |
| download | emacs-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.c | 8 | ||||
| -rw-r--r-- | src/bignum.c | 2 | ||||
| -rw-r--r-- | src/data.c | 8 | ||||
| -rw-r--r-- | src/eval.c | 8 | ||||
| -rw-r--r-- | src/lisp.h | 2 |
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 | |||
| 7125 | void | ||
| 7126 | range_error (void) | ||
| 7127 | { | ||
| 7128 | xsignal0 (Qrange_error); | ||
| 7129 | } | ||
| 7130 | |||
| 7131 | /* Initialization. */ | 7123 | /* Initialization. */ |
| 7132 | 7124 | ||
| 7133 | void | 7125 | void |
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 | |||
| 2407 | emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2) | 2407 | emacs_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. */ | ||
| 1770 | void | ||
| 1771 | overflow_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); | |||
| 3751 | extern ptrdiff_t inhibit_garbage_collection (void); | 3751 | extern ptrdiff_t inhibit_garbage_collection (void); |
| 3752 | extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); | 3752 | extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); |
| 3753 | extern void free_cons (struct Lisp_Cons *); | 3753 | extern void free_cons (struct Lisp_Cons *); |
| 3754 | extern _Noreturn void range_error (void); | ||
| 3755 | extern void init_alloc_once (void); | 3754 | extern void init_alloc_once (void); |
| 3756 | extern void init_alloc (void); | 3755 | extern void init_alloc (void); |
| 3757 | extern void syms_of_alloc (void); | 3756 | extern void syms_of_alloc (void); |
| @@ -3888,6 +3887,7 @@ extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object); | |||
| 3888 | extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, | 3887 | extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, |
| 3889 | Lisp_Object); | 3888 | Lisp_Object); |
| 3890 | extern _Noreturn void signal_error (const char *, Lisp_Object); | 3889 | extern _Noreturn void signal_error (const char *, Lisp_Object); |
| 3890 | extern _Noreturn void overflow_error (void); | ||
| 3891 | extern bool FUNCTIONP (Lisp_Object); | 3891 | extern bool FUNCTIONP (Lisp_Object); |
| 3892 | extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); | 3892 | extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); |
| 3893 | extern Lisp_Object eval_sub (Lisp_Object form); | 3893 | extern Lisp_Object eval_sub (Lisp_Object form); |