From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Paul Eggert Newsgroups: gmane.emacs.bugs Subject: bug#32463: 27.0.50; (logior -1) => 4611686018427387903 Date: Tue, 21 Aug 2018 19:29:31 -0700 Organization: UCLA Computer Science Department Message-ID: <34ab2db1-29b5-1121-d269-4407190e255d@cs.ucla.edu> References: <5230a57b-5896-606d-f157-2e547710b6e8@cs.ucla.edu> <66c3b06d-bf67-8f61-4b13-1debf0668010@cs.ucla.edu> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------4D81C32FEB9BC44082E4C9FD" X-Trace: blaine.gmane.org 1534905332 20335 195.159.176.226 (22 Aug 2018 02:35:32 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 22 Aug 2018 02:35:32 +0000 (UTC) User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.9.1 Cc: 32463@debbugs.gnu.org To: Andy Moreton Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Aug 22 04:35:27 2018 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fsIzX-000562-9R for geb-bug-gnu-emacs@m.gmane.org; Wed, 22 Aug 2018 04:35:27 +0200 Original-Received: from localhost ([::1]:56581 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fsJ1b-0006tc-Rj for geb-bug-gnu-emacs@m.gmane.org; Tue, 21 Aug 2018 22:37:35 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48768) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fsJ1L-0006WP-8C for bug-gnu-emacs@gnu.org; Tue, 21 Aug 2018 22:37:20 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fsIuJ-0004Bs-RS for bug-gnu-emacs@gnu.org; Tue, 21 Aug 2018 22:30:07 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:52154) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fsIuI-0004A1-Uu for bug-gnu-emacs@gnu.org; Tue, 21 Aug 2018 22:30:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fsIuI-0008WD-Jy for bug-gnu-emacs@gnu.org; Tue, 21 Aug 2018 22:30:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Paul Eggert Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 22 Aug 2018 02:30:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 32463 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 32463-submit@debbugs.gnu.org id=B32463.153490498232696 (code B ref 32463); Wed, 22 Aug 2018 02:30:02 +0000 Original-Received: (at 32463) by debbugs.gnu.org; 22 Aug 2018 02:29:42 +0000 Original-Received: from localhost ([127.0.0.1]:57172 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fsIty-0008VH-0Z for submit@debbugs.gnu.org; Tue, 21 Aug 2018 22:29:42 -0400 Original-Received: from zimbra.cs.ucla.edu ([131.179.128.68]:54488) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fsItv-0008V3-RZ for 32463@debbugs.gnu.org; Tue, 21 Aug 2018 22:29:40 -0400 Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id B006D1605B1; Tue, 21 Aug 2018 19:29:33 -0700 (PDT) Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10032) with ESMTP id 0j_-eqt5jvsY; Tue, 21 Aug 2018 19:29:32 -0700 (PDT) Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 425FD1605BB; Tue, 21 Aug 2018 19:29:32 -0700 (PDT) X-Virus-Scanned: amavisd-new at zimbra.cs.ucla.edu Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id xsc37Z0a-r0o; Tue, 21 Aug 2018 19:29:32 -0700 (PDT) Original-Received: from [192.168.1.9] (unknown [47.154.30.119]) by zimbra.cs.ucla.edu (Postfix) with ESMTPSA id DF3261605B1; Tue, 21 Aug 2018 19:29:31 -0700 (PDT) In-Reply-To: <66c3b06d-bf67-8f61-4b13-1debf0668010@cs.ucla.edu> Content-Language: en-US X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:149655 Archived-At: This is a multi-part message in MIME format. --------------4D81C32FEB9BC44082E4C9FD Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: quoted-printable >>> d) Extend Fceiling, Ffloor, Fround and Ftruncate to support bignums b= y >>> =C2=A0=C2=A0 updating rounding_driver. >=20 > I worked on these and installed patches to master that should do (a), (= b), and=20 > (c). For (d) I wrote the attached patch, and plan to test it a bit more= before=20 > installing, as it's the hairiest. It took me longer to write the test cases than the code, but the tests di= d find=20 bugs so it was worth it. I installed the attached. While we're on the subject I moved the definition of 'bignump' and 'fixnu= mp'=20 from C to Lisp, since they are easily implementable in Lisp and don't see= m to be=20 performance relevant. Hope you don't mind too much that I would rather mi= nimize=20 the low-level details that the C code exports. Both patches attached. --------------4D81C32FEB9BC44082E4C9FD Content-Type: text/x-patch; name="0001-Move-bignump-fixnump-from-C-to-Lisp.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0001-Move-bignump-fixnump-from-C-to-Lisp.patch" >From c79444c5b7b8ead1ea98ed5603bf2a49c13dbf16 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 21 Aug 2018 16:06:58 -0700 Subject: [PATCH 1/2] Move bignump, fixnump from C to Lisp * doc/lispref/objects.texi (Integer Type): Mention most-negative-fixnum and most-positive-fixnum as alternatives to fixnump and bignump. * lisp/subr.el (fixnump, bignump): Now written in Lisp. * src/data.c (Ffixnump, Fbignump): No longer written in C, as these new functions are not crucial for performance. --- doc/lispref/objects.texi | 7 ++++--- lisp/subr.el | 9 +++++++++ src/data.c | 21 --------------------- 3 files changed, 13 insertions(+), 24 deletions(-) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 8c92de123c..a0940032ee 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -190,9 +190,10 @@ Integer Type fixnum will return a bignum instead. Fixnums can be compared with @code{eq}, but bignums require -@code{eql} or @code{=}. The @code{fixnump} predicate can be used to -detect such small integers, and @code{bignump} can be used to detect -large integers. +@code{eql} or @code{=}. To test whether an integer is a fixnum or a +bignum, you can compare it to @code{most-negative-fixnum} and +@code{most-positive-fixnum}, or you can use the convenience predicates +@code{fixnump} and @code{bignump} on any object. The read syntax for integers is a sequence of (base ten) digits with an optional sign at the beginning and an optional period at the end. The diff --git a/lisp/subr.el b/lisp/subr.el index cafa4835ea..9e880bc880 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -366,6 +366,15 @@ zerop (declare (compiler-macro (lambda (_) `(= 0 ,number)))) (= 0 number)) +(defun fixnump (object) + "Return t if OBJECT is a fixnum." + (and (integerp object) + (<= most-negative-fixnum object most-positive-fixnum))) + +(defun bignump (object) + "Return t if OBJECT is a bignum." + (and (integerp object) (not (fixnump object)))) + (defun lsh (value count) "Return VALUE with its bits shifted left by COUNT. If COUNT is negative, shifting is actually to the right. diff --git a/src/data.c b/src/data.c index 4c6d33f294..08c7271dd7 100644 --- a/src/data.c +++ b/src/data.c @@ -511,16 +511,6 @@ DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, return Qnil; } -DEFUN ("fixnump", Ffixnump, Sfixnump, 1, 1, 0, - doc: /* Return t if OBJECT is an fixnum. */ - attributes: const) - (Lisp_Object object) -{ - if (FIXNUMP (object)) - return Qt; - return Qnil; -} - DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0, doc: /* Return t if OBJECT is an integer or a marker (editor pointer). */) (register Lisp_Object object) @@ -598,15 +588,6 @@ DEFUN ("condition-variable-p", Fcondition_variable_p, Scondition_variable_p, return Qt; return Qnil; } - -DEFUN ("bignump", Fbignump, Sbignump, 1, 1, 0, - doc: /* Return t if OBJECT is a bignum. */) - (Lisp_Object object) -{ - if (BIGNUMP (object)) - return Qt; - return Qnil; -} /* Extract and set components of lists. */ @@ -4153,7 +4134,6 @@ syms_of_data (void) defsubr (&Sconsp); defsubr (&Satom); defsubr (&Sintegerp); - defsubr (&Sfixnump); defsubr (&Sinteger_or_marker_p); defsubr (&Snumberp); defsubr (&Snumber_or_marker_p); @@ -4179,7 +4159,6 @@ syms_of_data (void) defsubr (&Sthreadp); defsubr (&Smutexp); defsubr (&Scondition_variable_p); - defsubr (&Sbignump); defsubr (&Scar); defsubr (&Scdr); defsubr (&Scar_safe); -- 2.17.1 --------------4D81C32FEB9BC44082E4C9FD Content-Type: text/x-patch; name="0002-Add-bignum-support-to-floor-ceiling-etc.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0002-Add-bignum-support-to-floor-ceiling-etc.patch" >From 30efb8ed6c0968ca486081112f8d4dc147af9e6c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 21 Aug 2018 19:23:45 -0700 Subject: [PATCH 2/2] Add bignum support to floor, ceiling, etc. Problem reported by Andy Moreton (Bug#32463#35 (d)). * src/floatfns.c (rounding_driver): Change the signature of the integer rounder to use mpz_t rather than EMACS_INT. All uses changed. Support bignums. (ceiling2, floor2, truncate2, round2): Remove. All uses changed to rounddiv_q or to a GMP library function. (rounddiv_q): New function. * test/src/floatfns-tests.el (bignum-round): New test. --- src/floatfns.c | 95 ++++++++++++++++++++++---------------- test/src/floatfns-tests.el | 27 +++++++++++ 2 files changed, 82 insertions(+), 40 deletions(-) diff --git a/src/floatfns.c b/src/floatfns.c index ea9000b90a..c09fe9d6a5 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -357,10 +357,10 @@ This is the same as the exponent of a float. */) static Lisp_Object rounding_driver (Lisp_Object arg, Lisp_Object divisor, double (*double_round) (double), - EMACS_INT (*int_round2) (EMACS_INT, EMACS_INT), + void (*int_divide) (mpz_t, mpz_t const, mpz_t const), const char *name) { - CHECK_FIXNUM_OR_FLOAT (arg); + CHECK_NUMBER (arg); double d; if (NILP (divisor)) @@ -371,12 +371,25 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, } else { - CHECK_FIXNUM_OR_FLOAT (divisor); + CHECK_NUMBER (divisor); if (!FLOATP (arg) && !FLOATP (divisor)) { - if (XFIXNUM (divisor) == 0) + if (EQ (divisor, make_fixnum (0))) xsignal0 (Qarith_error); - return make_fixnum (int_round2 (XFIXNUM (arg), XFIXNUM (divisor))); + mpz_t d, q; + mpz_init (d); + mpz_init (q); + int_divide (q, + (FIXNUMP (arg) + ? (mpz_set_intmax (q, XFIXNUM (arg)), q) + : XBIGNUM (arg)->value), + (FIXNUMP (divisor) + ? (mpz_set_intmax (d, XFIXNUM (divisor)), d) + : XBIGNUM (divisor)->value)); + Lisp_Object result = make_number (q); + mpz_clear (d); + mpz_clear (q); + return result; } double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg); @@ -400,37 +413,39 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, xsignal2 (Qrange_error, build_string (name), arg); } -static EMACS_INT -ceiling2 (EMACS_INT i1, EMACS_INT i2) -{ - return i1 / i2 + ((i1 % i2 != 0) & ((i1 < 0) == (i2 < 0))); -} - -static EMACS_INT -floor2 (EMACS_INT i1, EMACS_INT i2) -{ - return i1 / i2 - ((i1 % i2 != 0) & ((i1 < 0) != (i2 < 0))); -} - -static EMACS_INT -truncate2 (EMACS_INT i1, EMACS_INT i2) -{ - return i1 / i2; -} - -static EMACS_INT -round2 (EMACS_INT i1, EMACS_INT i2) -{ - /* The C language's division operator gives us one remainder R, but - we want the remainder R1 on the other side of 0 if R1 is closer - to 0 than R is; because we want to round to even, we also want R1 - if R and R1 are the same distance from 0 and if C's quotient is - odd. */ - EMACS_INT q = i1 / i2; - EMACS_INT r = i1 % i2; - EMACS_INT abs_r = eabs (r); - EMACS_INT abs_r1 = eabs (i2) - abs_r; - return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1); +static void +rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) +{ + /* mpz_tdiv_qr gives us one remainder R, but we want the remainder + R1 on the other side of 0 if R1 is closer to 0 than R is; because + we want to round to even, we also want R1 if R and R1 are the + same distance from 0 and if the quotient is odd. + + If we were using EMACS_INT arithmetic instead of bignums, + the following code could look something like this: + + q = n / d; + r = n % d; + neg_d = d < 0; + neg_r = r < 0; + r = eabs (r); + abs_r1 = eabs (d) - r; + if (abs_r1 < r + (q & 1)) + q += neg_d == neg_r ? 1 : -1; */ + + mpz_t r, abs_r1; + mpz_init (r); + mpz_init (abs_r1); + mpz_tdiv_qr (q, r, n, d); + bool neg_d = mpz_sgn (d) < 0; + bool neg_r = mpz_sgn (r) < 0; + mpz_abs (r, r); + mpz_abs (abs_r1, d); + mpz_sub (abs_r1, abs_r1, r); + if (mpz_cmp (abs_r1, r) < (mpz_odd_p (q) != 0)) + (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1); + mpz_clear (r); + mpz_clear (abs_r1); } /* The code uses emacs_rint, so that it works to undefine HAVE_RINT @@ -461,7 +476,7 @@ This rounds the value towards +inf. With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); + return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, "ceiling"); } DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, @@ -470,7 +485,7 @@ This rounds the value towards -inf. With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, floor, floor2, "floor"); + return rounding_driver (arg, divisor, floor, mpz_fdiv_q, "floor"); } DEFUN ("round", Fround, Sround, 1, 2, 0, @@ -483,7 +498,7 @@ your machine. For example, (round 2.5) can return 3 on some systems, but 2 on others. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, emacs_rint, round2, "round"); + return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, "round"); } DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, @@ -492,7 +507,7 @@ Rounds ARG toward zero. With optional DIVISOR, truncate ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, trunc, truncate2, "truncate"); + return rounding_driver (arg, divisor, trunc, mpz_tdiv_q, "truncate"); } diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index e4caaa1e49..592efce359 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -58,4 +58,31 @@ (ert-deftest bignum-mod () (should (= 0 (mod (1+ most-positive-fixnum) 2.0)))) +(ert-deftest bignum-round () + (let ((ns (list (* most-positive-fixnum most-negative-fixnum) + (1- most-negative-fixnum) most-negative-fixnum + (1+ most-negative-fixnum) -2 1 1 2 + (1- most-positive-fixnum) most-positive-fixnum + (1+ most-positive-fixnum) + (* most-positive-fixnum most-positive-fixnum)))) + (dolist (n ns) + (dolist (d ns) + (let ((q (/ n d)) + (r (% n d)) + (same-sign (eq (< n 0) (< d 0)))) + (should (= (ceiling n d) + (+ q (if (and same-sign (not (zerop r))) 1 0)))) + (should (= (floor n d) + (- q (if (and (not same-sign) (not (zerop r))) 1 0)))) + (should (= (truncate n d) q)) + (let ((cdelta (abs (- n (* d (ceiling n d))))) + (fdelta (abs (- n (* d (floor n d))))) + (rdelta (abs (- n (* d (round n d)))))) + (should (<= rdelta cdelta)) + (should (<= rdelta fdelta)) + (should (if (zerop r) + (= 0 cdelta fdelta rdelta) + (or (/= cdelta fdelta) + (zerop (% (round n d) 2))))))))))) + (provide 'floatfns-tests) -- 2.17.1 --------------4D81C32FEB9BC44082E4C9FD--