From 7fc4768c45bce52d34f183eb4734d9f58745ea3d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 3 May 2011 00:51:38 -0700 Subject: [PATCH] Arithmetic overflows now return float rather than wrapping around. * data.c: Include . (arith_driver): Use floating point if the accumulator would otherwise go out of EMACS_INT range. (arith_driver, Fadd1, Fsub1): Use floating point if the result is out of Emacs fixnum range. * bytecode.c (exec_byte_code): Likewise, for Bsub1, Badd1, Bnegate. --- src/ChangeLog | 8 ++++ src/bytecode.c | 6 +-- src/data.c | 126 +++++++++++++++++++++++++++++++------------------ 3 files changed, 91 insertions(+), 49 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index ccf1fea9514..435f90abad9 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,13 @@ 2011-05-03 Paul Eggert + Arithmetic overflows now return float rather than wrapping around. + * data.c: Include . + (arith_driver): Use floating point if the accumulator would otherwise + go out of EMACS_INT range. + (arith_driver, Fadd1, Fsub1): Use floating point if the result is + out of Emacs fixnum range. + * bytecode.c (exec_byte_code): Likewise, for Bsub1, Badd1, Bnegate. + * callproc.c (Fcall_process): Use 'volatile' to avoid vfork clobbering. * process.c (Fformat_network_address): Fix typo: args2 -> *args2. diff --git a/src/bytecode.c b/src/bytecode.c index c3cd3d43072..ce79b011bbb 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1186,7 +1186,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object v1; v1 = TOP; - if (INTEGERP (v1)) + if (INTEGERP (v1) && MOST_NEGATIVE_FIXNUM < XINT (v1)) { XSETINT (v1, XINT (v1) - 1); TOP = v1; @@ -1204,7 +1204,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object v1; v1 = TOP; - if (INTEGERP (v1)) + if (INTEGERP (v1) && XINT (v1) < MOST_POSITIVE_FIXNUM) { XSETINT (v1, XINT (v1) + 1); TOP = v1; @@ -1290,7 +1290,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object v1; v1 = TOP; - if (INTEGERP (v1)) + if (INTEGERP (v1) && - MOST_POSITIVE_FIXNUM <= XINT (v1)) { XSETINT (v1, - XINT (v1)); TOP = v1; diff --git a/src/data.c b/src/data.c index 577ae777d89..beff570d552 100644 --- a/src/data.c +++ b/src/data.c @@ -22,6 +22,9 @@ along with GNU Emacs. If not, see . */ #include #include #include + +#include + #include "lisp.h" #include "puresize.h" #include "character.h" @@ -2426,10 +2429,8 @@ static Lisp_Object float_arith_driver (double, size_t, enum arithop, static Lisp_Object arith_driver (enum arithop code, size_t nargs, register Lisp_Object *args) { - register Lisp_Object val; register size_t argnum; register EMACS_INT accum = 0; - register EMACS_INT next; switch (SWITCH_ENUM_CAST (code)) { @@ -2451,58 +2452,89 @@ arith_driver (enum arithop code, size_t nargs, register Lisp_Object *args) for (argnum = 0; argnum < nargs; argnum++) { + EMACS_INT a = accum; + int use_float = 0; + /* Using args[argnum] as argument to CHECK_NUMBER_... */ - val = args[argnum]; + Lisp_Object val = args[argnum]; CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); + args[argnum] = val; if (FLOATP (val)) - return float_arith_driver ((double) accum, argnum, code, - nargs, args); - args[argnum] = val; - next = XINT (args[argnum]); - switch (SWITCH_ENUM_CAST (code)) + use_float = 1; + else { - case Aadd: - accum += next; - break; - case Asub: - accum = argnum ? accum - next : nargs == 1 ? - next : next; - break; - case Amult: - accum *= next; - break; - case Adiv: - if (!argnum) - accum = next; - else + EMACS_INT next = XINT (val); + switch (SWITCH_ENUM_CAST (code)) { - if (next == 0) - xsignal0 (Qarith_error); - accum /= next; + case Aadd: + if (next < 0 + ? a < TYPE_MINIMUM (EMACS_INT) - next + : TYPE_MAXIMUM (EMACS_INT) - next < a) + use_float = 1; + else + a += next; + break; + case Asub: + if (argnum == 0 && nargs != 1) + a = next; + else if (next < 0 + ? TYPE_MAXIMUM (EMACS_INT) + next < a + : a < TYPE_MINIMUM (EMACS_INT) + next) + use_float = 1; + else + a -= next; + break; + case Amult: + if (next < 0 + ? (a < 0 + ? a < TYPE_MAXIMUM (EMACS_INT) / next + : next != -1 && TYPE_MINIMUM (EMACS_INT) / next < a) + : (next != 0 + && (a < 0 + ? a < TYPE_MINIMUM (EMACS_INT) / next + : TYPE_MAXIMUM (EMACS_INT) / next < a))) + use_float = 1; + else + a *= next; + break; + case Adiv: + if (!argnum) + a = next; + else + { + if (next == 0) + xsignal0 (Qarith_error); + a /= next; + } + break; + case Alogand: + a &= next; + break; + case Alogior: + a |= next; + break; + case Alogxor: + a ^= next; + break; + case Amax: + if (!argnum || a < next) + a = next; + break; + case Amin: + if (!argnum || next < a) + a = next; + break; } - break; - case Alogand: - accum &= next; - break; - case Alogior: - accum |= next; - break; - case Alogxor: - accum ^= next; - break; - case Amax: - if (!argnum || next > accum) - accum = next; - break; - case Amin: - if (!argnum || next < accum) - accum = next; - break; } + + if (use_float) + return float_arith_driver (accum, argnum, code, nargs, args); + + accum = a; } - XSETINT (val, accum); - return val; + return make_fixnum_or_float (accum); } #undef isnan @@ -2777,7 +2809,8 @@ Markers are converted to integers. */) if (FLOATP (number)) return (make_float (1.0 + XFLOAT_DATA (number))); - + if (XINT (number) + 1 == MOST_POSITIVE_FIXNUM + 1) + return make_float (XINT (number) + 1); XSETINT (number, XINT (number) + 1); return number; } @@ -2791,7 +2824,8 @@ Markers are converted to integers. */) if (FLOATP (number)) return (make_float (-1.0 + XFLOAT_DATA (number))); - + if (XINT (number) - 1 == MOST_NEGATIVE_FIXNUM - 1) + return make_float (XINT (number) - 1); XSETINT (number, XINT (number) - 1); return number; } -- 2.39.2