bug#32463: 27.0.50; (logior -1) => 4611686018427387903

[Paul Eggert <eggert@cs.ucla.edu>]

[-- Attachment #1: Type: text/plain, Size: 775 bytes --]

>>> d) Extend Fceiling, Ffloor, Fround and Ftruncate to support bignums by
>>>    updating rounding_driver.
> 
> I worked on these and installed patches to master that should do (a), (b), and 
> (c). For (d) I wrote the attached patch, and plan to test it a bit more before 
> installing, as it's the hairiest.

It took me longer to write the test cases than the code, but the tests did find 
bugs so it was worth it. I installed the attached.

While we're on the subject I moved the definition of 'bignump' and 'fixnump' 
from C to Lisp, since they are easily implementable in Lisp and don't seem to be 
performance relevant. Hope you don't mind too much that I would rather minimize 
the low-level details that the C code exports.

Both patches attached.

[-- Attachment #2: 0001-Move-bignump-fixnump-from-C-to-Lisp.patch --]
[-- Type: text/x-patch, Size: 3638 bytes --]

From c79444c5b7b8ead1ea98ed5603bf2a49c13dbf16 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
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;
-}
 \f
 /* 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


[-- Attachment #3: 0002-Add-bignum-support-to-floor-ceiling-etc.patch --]
[-- Type: text/x-patch, Size: 7285 bytes --]

From 30efb8ed6c0968ca486081112f8d4dc147af9e6c Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
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