APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1510393370 0 # Sat Nov 11 09:42:50 2017 +0000 # Node ID c8b7adfa23c6f68a106755cc970296763c2ed59d # Parent 7ce0eaac52e01c1f46b35f8a36d08abcd3bbc0a6 Make % behave more consistently with varying signs, bignums src/ChangeLog addition: 2017-11-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; * data.c: * data.c (rem_two_fixnum): New. Return the result of the % operator on two EMACS_INTs. Standardise on the sign so we don't have to put up with the quirks of the local C implementation. * data.c (Frem): Document the meaning of %, cross reference to the C standard; document that the result will have the sign of NUMBER1. * lisp.h (EMACS_INT_ABS): New. Make a version of abs() available appropriate for an EMACS_INT. * doprnt.c (doprnt_1): Use this version of abs(). tests/ChangeLog addition: 2017-11-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el: Check for the %-equivalence documented in the C standard for bignums too. diff -r 7ce0eaac52e0 -r c8b7adfa23c6 src/ChangeLog --- a/src/ChangeLog Thu Nov 09 21:59:49 2017 +0000 +++ b/src/ChangeLog Sat Nov 11 09:42:50 2017 +0000 ＠＠ -1,3 +1,18 ＠＠ +2017-11-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * data.c: + * data.c (rem_two_fixnum): New. + Return the result of the % operator on two EMACS_INTs. Standardise + on the sign so we don't have to put up with the quirks of the + local C implementation. + * data.c (Frem): + Document the meaning of %, cross reference to the C standard; + document that the result will have the sign of NUMBER1. + * lisp.h (EMACS_INT_ABS): New. + Make a version of abs() available appropriate for an EMACS_INT. + * doprnt.c (doprnt_1): + Use this version of abs(). + 2017-11-09 Aidan Kehoe <kehoea(a)parhasard.net&gt; * mule-ccl.c (ccl_driver): diff -r 7ce0eaac52e0 -r c8b7adfa23c6 src/data.c --- a/src/data.c Thu Nov 09 21:59:49 2017 +0000 +++ b/src/data.c Sat Nov 11 09:42:50 2017 +0000 ＠＠ -2900,9 +2900,43 ＠＠ return make_fixnum (~ fixnum_char_or_marker_to_int (number)); } +static Lisp_Object +rem_two_fixnum (EMACS_INT number1, EMACS_INT number2) +{ + EMACS_UINT val1, val2; + EMACS_INT sign; + + if (0 == number2) + { + Fsignal (Qarith_error, Qnil); + } + + if (number1 < 0) + { + sign = -1; + val1 = -number1; + } + else + { + sign = 1; + val1 = number1; + } + + val2 = EMACS_INT_ABS (number2); + + return make_fixnum ((EMACS_INT)((val1 % val2) * sign)); +} + DEFUN ("%", Frem, 2, 2, 0, /* -Return remainder of first arg divided by second. -Both must be integers, characters or markers. +Return remainder of NUMBER1 divided by NUMBER2. + +Both must be integers, characters or markers. This is the remainder in the C +sense, so the following equivalence (from the C standard) holds: + +\(eql NUMBER1 (+ (* (/ NUMBER1 NUMBER2) NUMBER2) (% NUMBER1 NUMBER2))) + +In this implementation, the result will have the sign of NUMBER1, something +not standardized in C. */ (number1, number2)) { ＠＠ -2914,26 +2948,34 ＠＠ if (promote_args (&number1, &number2) == FIXNUM_T) { - if (XREALFIXNUM (number2) == 0) - Fsignal (Qarith_error, Qnil); - return make_fixnum (XREALFIXNUM (number1) % XREALFIXNUM (number2)); + return rem_two_fixnum (XREALFIXNUM (number1), XREALFIXNUM (number2)); } else { if (bignum_sign (XBIGNUM_DATA (number2)) == 0) - Fsignal (Qarith_error, Qnil); - bignum_mod (scratch_bignum, XBIGNUM_DATA (number1), - XBIGNUM_DATA (number2)); + { + Fsignal (Qarith_error, Qnil); + } + if (bignum_sign (XBIGNUM_DATA (number1)) > -1) + { + bignum_mod (scratch_bignum, XBIGNUM_DATA (number1), + XBIGNUM_DATA (number2)); + } + else + { + bignum_neg (scratch_bignum, XBIGNUM_DATA (number1)); + bignum_mod (scratch_bignum2, scratch_bignum, + XBIGNUM_DATA (number2)); + bignum_neg (scratch_bignum, scratch_bignum2); + } + return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); } #else /* !HAVE_BIGNUM */ EMACS_INT ival1 = fixnum_char_or_marker_to_int (number1); EMACS_INT ival2 = fixnum_char_or_marker_to_int (number2); - if (ival2 == 0) - Fsignal (Qarith_error, Qnil); - - return make_fixnum (ival1 % ival2); + return rem_two_fixnum (ival1, ival2); #endif /* HAVE_BIGNUM */ } diff -r 7ce0eaac52e0 -r c8b7adfa23c6 src/doprnt.c --- a/src/doprnt.c Thu Nov 09 21:59:49 2017 +0000 +++ b/src/doprnt.c Sat Nov 11 09:42:50 2017 +0000 ＠＠ -926,7 +926,7 ＠＠ } } filllen = (max (zeros_to_add, 0) + 1 /* sign flag */ - + 2 /* number flag */ + labs (padding_to_add)) + + 2 /* number flag */ + EMACS_INT_ABS (padding_to_add)) * MAX_ICHAR_LEN; filling = fill_cursor = alloca_ibytes (filllen); diff -r 7ce0eaac52e0 -r c8b7adfa23c6 src/lisp.h --- a/src/lisp.h Thu Nov 09 21:59:49 2017 +0000 +++ b/src/lisp.h Sat Nov 11 09:42:50 2017 +0000 ＠＠ -503,6 +503,15 ＠＠ #define BITS_PER_EMACS_INT (SIZEOF_EMACS_INT * BITS_PER_CHAR) +/* Make a version of abs() available appropriate for an EMACS_INT. */ +#if SIZEOF_EMACS_INT == SIZEOF_INT +# define EMACS_INT_ABS abs +#elif SIZEOF_EMACS_INT == SIZEOF_LONG +# define EMACS_INT_ABS labs +#elif SIZEOF_EMACS_INT == SIZEOF_LONG_LONG +# define EMACS_INT_ABS llabs +#endif + /* -------------------------- basic byte typedefs --------------------- */ /* The definitions we put here and in the next section use typedefs to diff -r 7ce0eaac52e0 -r c8b7adfa23c6 tests/ChangeLog --- a/tests/ChangeLog Thu Nov 09 21:59:49 2017 +0000 +++ b/tests/ChangeLog Sat Nov 11 09:42:50 2017 +0000 ＠＠ -1,3 +1,9 ＠＠ +2017-11-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/lisp-tests.el: + Check for the %-equivalence documented in the C standard for + bignums too. + 2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/mule-tests.el: diff -r 7ce0eaac52e0 -r c8b7adfa23c6 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Thu Nov 09 21:59:49 2017 +0000 +++ b/tests/automated/lisp-tests.el Sat Nov 11 09:42:50 2017 +0000 ＠＠ -757,7 +757,22 ＠＠ (= (% big (1+ most-positive-fixnum)) most-positive-fixnum) (= (% negbig (1- most-negative-fixnum)) most-negative-fixnum) (= (mod big (1+ most-positive-fixnum)) most-positive-fixnum) - (= (mod negbig (1- most-negative-fixnum)) most-negative-fixnum))) + (= (mod negbig (1- most-negative-fixnum)) most-negative-fixnum)) + + (macrolet + ((check-%-for-value (value denominator) + `(Assert (eql ,value + (+ (* (/ ,value ,denominator) ,denominator) + (% ,value ,denominator)))))) + (let ((limit (* most-positive-fixnum 2)) random-value random-denominator) + (dotimes (i 10) ;; Increase these COUNTs to reassure. + (dotimes (j 4) + (setq random-value (random limit) + random-denominator (random limit)) + (check-%-for-value random-value random-denominator) + (check-%-for-value (- random-value) random-denominator) + (check-%-for-value random-value (- random-denominator)) + (check-%-for-value (- random-value) (- random-denominator))))))) ;;----------------------------------------------------- ;; Arithmetic comparison operations -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)