emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master fa3785e 1/3: Use overflow-error for bignum overflow


From: Paul Eggert
Subject: [Emacs-diffs] master fa3785e 1/3: Use overflow-error for bignum overflow
Date: Tue, 11 Sep 2018 14:34:49 -0400 (EDT)

branch: master
commit fa3785ea5fd73eaba84b8e3b8f988dd53f3a4148
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    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.
---
 src/alloc.c  | 8 --------
 src/bignum.c | 2 +-
 src/data.c   | 8 ++++----
 src/eval.c   | 8 ++++++++
 src/lisp.h   | 2 +-
 5 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index abb98a9..6bced4e 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -7120,14 +7120,6 @@ verify_alloca (void)
 
 #endif /* ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */
 
-/* Memory allocation for GMP.  */
-
-void
-range_error (void)
-{
-  xsignal0 (Qrange_error);
-}
-
 /* Initialization.  */
 
 void
diff --git a/src/bignum.c b/src/bignum.c
index f4c24d1..2da2c96 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -80,7 +80,7 @@ make_bignum_bits (size_t bits)
   /* The documentation says integer-width should be nonnegative, so
      a single comparison suffices even though 'bits' is unsigned.  */
   if (integer_width < bits)
-    range_error ();
+    overflow_error ();
 
   struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
                                                 PVEC_BIGNUM);
diff --git a/src/data.c b/src/data.c
index 66f69e7..1e97d9e 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2407,7 +2407,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))
-    range_error ();
+    overflow_error ();
   mpz_mul (rop, op1, op2);
 }
 
@@ -2421,7 +2421,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)
-    range_error ();
+    overflow_error ();
   mpz_mul_2exp (rop, op1, op2);
 }
 
@@ -2435,7 +2435,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)
-    range_error ();
+    overflow_error ();
   mpz_pow_ui (rop, base, exp);
 }
 
@@ -3292,7 +3292,7 @@ expt_integer (Lisp_Object x, Lisp_Object y)
           && mpz_fits_ulong_p (XBIGNUM (y)->value))
     exp = mpz_get_ui (XBIGNUM (y)->value);
   else
-    range_error ();
+    overflow_error ();
 
   emacs_mpz_pow_ui (mpz[0], *bignum_integer (&mpz[0], x), exp);
   return make_integer_mpz ();
diff --git a/src/eval.c b/src/eval.c
index 60dd6f1..500427c 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1765,6 +1765,14 @@ signal_error (const char *s, Lisp_Object arg)
   xsignal (Qerror, Fcons (build_string (s), arg));
 }
 
+/* Use this for arithmetic overflow, e.g., when an integer result is
+   too large even for a bignum.  */
+void
+overflow_error (void)
+{
+  xsignal0 (Qoverflow_error);
+}
+
 
 /* Return true if LIST is a non-nil atom or
    a list containing one of CONDITIONS.  */
diff --git a/src/lisp.h b/src/lisp.h
index 454d728..bb190b6 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3751,7 +3751,6 @@ 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 range_error (void);
 extern void init_alloc_once (void);
 extern void init_alloc (void);
 extern void syms_of_alloc (void);
@@ -3888,6 +3887,7 @@ extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, 
Lisp_Object);
 extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object,
                                Lisp_Object);
 extern _Noreturn void signal_error (const char *, Lisp_Object);
+extern _Noreturn void overflow_error (void);
 extern bool FUNCTIONP (Lisp_Object);
 extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, 
Lisp_Object *arg_vector);
 extern Lisp_Object eval_sub (Lisp_Object form);



reply via email to

[Prev in Thread] Current Thread [Next in Thread]