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

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

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

Pip Cet wrote:
> Are you suggesting we revert to
> the previous behavior, and try to come up with an interpretation for
> bignums that somehow extends the previous behavior?

I think Eli was suggesting reverting lsh to the traditional behavior for 
fixnums, for backwards-compatibility reasons.

There doesn't seem to be a good way to extend this behavior for bignums, so I 
installed the attached patch that simply makes it an error to invoke (lsh A B) 
where A is a negative bignum and B is negative. This patch also adds some test 
cases inspired by one of your previous emails (thanks).

[-- Attachment #2: 0001-Restore-traditional-lsh-behavior-on-fixnums.txt --]
[-- Type: text/plain, Size: 10598 bytes --]

From 673b1785db4604efe81b8045a9d8ab68936af719 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Sat, 18 Aug 2018 15:20:46 -0700
Subject: [PATCH] Restore traditional lsh behavior on fixnums
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* doc/lispref/numbers.texi (Bitwise Operations): Document that
the traditional (lsh A B) behavior is for fixnums, and that it
is an error if A and B are both negative and A is a bignum.
See Bug#32463.
* lisp/subr.el (lsh): New function, moved here from src/data.c.
* src/data.c (ash_lsh_impl): Remove, moving body into Fash
since it’s the only caller now.
(Fash): Check for out-of-range counts.  If COUNT is zero,
return first argument instead of going through libgmp.  Omit
lsh code since lsh is now done in Lisp.  Add code for shifting
fixnums right, to avoid a round trip through libgmp.
(Flsh): Remove; moved to lisp/subr.el.
* test/lisp/international/ccl-tests.el (shift):
Test for traditional lsh behavior, instead of assuming
lsh is like ash when bignums are present.
* test/src/data-tests.el (data-tests-logand)
(data-tests-logior, data-tests-logxor, data-tests-ash-lsh):
New tests.
---
 doc/lispref/numbers.texi             |  7 +++-
 lisp/subr.el                         | 12 ++++++
 src/data.c                           | 60 +++++++++++-----------------
 test/lisp/international/ccl-tests.el | 21 +++-------
 test/src/data-tests.el               | 16 ++++++--
 5 files changed, 59 insertions(+), 57 deletions(-)

diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 37d2c31649..ee6456b1be 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -844,7 +844,9 @@ Bitwise Operations
 if @var{count} is negative, bringing zeros into the vacated bits.  If
 @var{count} is negative, @code{lsh} shifts zeros into the leftmost
 (most-significant) bit, producing a nonnegative result even if
-@var{integer1} is negative.  Contrast this with @code{ash}, below.
+@var{integer1} is negative fixnum.  (If @var{integer1} is a negative
+bignum, @var{count} must be nonnegative.)  Contrast this with
+@code{ash}, below.
 
 Here are two examples of @code{lsh}, shifting a pattern of bits one
 place to the left.  We show only the low-order eight bits of the binary
@@ -913,7 +915,8 @@ Bitwise Operations
 @code{ash} gives the same results as @code{lsh} except when
 @var{integer1} and @var{count} are both negative.  In that case,
 @code{ash} puts ones in the empty bit positions on the left, while
-@code{lsh} puts zeros in those bit positions.
+@code{lsh} puts zeros in those bit positions and requires
+@var{integer1} to be a fixnum.
 
 Thus, with @code{ash}, shifting the pattern of bits one place to the right
 looks like this:
diff --git a/lisp/subr.el b/lisp/subr.el
index fbb3e49a35..cafa4835ea 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -366,6 +366,18 @@ zerop
   (declare (compiler-macro (lambda (_) `(= 0 ,number))))
   (= 0 number))
 
+(defun lsh (value count)
+  "Return VALUE with its bits shifted left by COUNT.
+If COUNT is negative, shifting is actually to the right.
+In this case, if VALUE is a negative fixnum treat it as unsigned,
+i.e., subtract 2 * most-negative-fixnum from VALUE before shifting it."
+  (when (and (< value 0) (< count 0))
+    (when (< value most-negative-fixnum)
+      (signal 'args-out-of-range (list value count)))
+    (setq value (logand (ash value -1) most-positive-fixnum))
+    (setq count (1+ count)))
+  (ash value count))
+
 \f
 ;;;; List functions.
 
diff --git a/src/data.c b/src/data.c
index 5a355d9787..a39978ab1d 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3365,30 +3365,44 @@ representation.  */)
 		      : count_one_bits_ll (v));
 }
 
-static Lisp_Object
-ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh)
+DEFUN ("ash", Fash, Sash, 2, 2, 0,
+       doc: /* Return VALUE with its bits shifted left by COUNT.
+If COUNT is negative, shifting is actually to the right.
+In this case, the sign bit is duplicated.  */)
+  (Lisp_Object value, Lisp_Object count)
 {
-  /* This code assumes that signed right shifts are arithmetic.  */
-  verify ((EMACS_INT) -1 >> 1 == -1);
-
   Lisp_Object val;
 
+  /* The negative of the minimum value of COUNT that fits into a fixnum,
+     such that mpz_fdiv_q_exp supports -COUNT.  */
+  EMACS_INT minus_count_min = min (-MOST_NEGATIVE_FIXNUM,
+				   TYPE_MAXIMUM (mp_bitcnt_t));
   CHECK_INTEGER (value);
-  CHECK_FIXNUM (count);
+  CHECK_RANGED_INTEGER (count, - minus_count_min, TYPE_MAXIMUM (mp_bitcnt_t));
 
   if (BIGNUMP (value))
     {
+      if (XFIXNUM (count) == 0)
+	return value;
       mpz_t result;
       mpz_init (result);
-      if (XFIXNUM (count) >= 0)
+      if (XFIXNUM (count) > 0)
 	mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count));
-      else if (lsh)
-	mpz_tdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count));
       else
 	mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count));
       val = make_number (result);
       mpz_clear (result);
     }
+  else if (XFIXNUM (count) <= 0)
+    {
+      /* This code assumes that signed right shifts are arithmetic.  */
+      verify ((EMACS_INT) -1 >> 1 == -1);
+
+      EMACS_INT shift = -XFIXNUM (count);
+      EMACS_INT result = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift
+			  : XFIXNUM (value) < 0 ? -1 : 0);
+      val = make_fixnum (result);
+    }
   else
     {
       /* Just do the work as bignums to make the code simpler.  */
@@ -3400,14 +3414,7 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh)
 
       if (XFIXNUM (count) >= 0)
 	mpz_mul_2exp (result, result, XFIXNUM (count));
-      else if (lsh)
-	{
-	  if (mpz_sgn (result) > 0)
-	    mpz_fdiv_q_2exp (result, result, - XFIXNUM (count));
-	  else
-	    mpz_fdiv_q_2exp (result, result, - XFIXNUM (count));
-	}
-      else /* ash */
+      else
 	mpz_fdiv_q_2exp (result, result, - XFIXNUM (count));
 
       val = make_number (result);
@@ -3417,24 +3424,6 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh)
   return val;
 }
 
-DEFUN ("ash", Fash, Sash, 2, 2, 0,
-       doc: /* Return VALUE with its bits shifted left by COUNT.
-If COUNT is negative, shifting is actually to the right.
-In this case, the sign bit is duplicated.  */)
-  (register Lisp_Object value, Lisp_Object count)
-{
-  return ash_lsh_impl (value, count, false);
-}
-
-DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
-       doc: /* Return VALUE with its bits shifted left by COUNT.
-If COUNT is negative, shifting is actually to the right.
-In this case, zeros are shifted in on the left.  */)
-  (register Lisp_Object value, Lisp_Object count)
-{
-  return ash_lsh_impl (value, count, true);
-}
-
 DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
        doc: /* Return NUMBER plus one.  NUMBER may be a number or a marker.
 Markers are converted to integers.  */)
@@ -4235,7 +4224,6 @@ syms_of_data (void)
   defsubr (&Slogior);
   defsubr (&Slogxor);
   defsubr (&Slogcount);
-  defsubr (&Slsh);
   defsubr (&Sash);
   defsubr (&Sadd1);
   defsubr (&Ssub1);
diff --git a/test/lisp/international/ccl-tests.el b/test/lisp/international/ccl-tests.el
index b41b8c1ff6..7dd7224726 100644
--- a/test/lisp/international/ccl-tests.el
+++ b/test/lisp/international/ccl-tests.el
@@ -37,18 +37,9 @@
 
   ;; shift right -ve                    -5628     #x3fffffffffffea04
   (should (= (ash -5628 -8)               -22)) ; #x3fffffffffffffea
-
-  ;; shift right                       -5628      #x3fffffffffffea04
-  (cond
-   ((fboundp 'bignump)
-    (should (= (lsh -5628 -8)            -22))) ; #x3fffffffffffffea  bignum
-   ((= (logb most-negative-fixnum) 61)
-    (should (= (lsh -5628 -8)
-               (string-to-number
-                "18014398509481962"))))         ; #x003fffffffffffea  master (64bit)
-   ((= (logb most-negative-fixnum) 29)
-    (should (= (lsh -5628 -8)        4194282))) ; #x003fffea          master (32bit)
-   ))
+  (should (= (lsh -5628 -8)
+             (ash (- -5628 (ash most-negative-fixnum 1)) -8)
+             (ash (logand (ash -5628 -1) most-positive-fixnum) -7))))
 
 ;; CCl program from `pgg-parse-crc24' in lisp/obsolete/pgg-parse.el
 (defconst prog-pgg-source
@@ -177,11 +168,11 @@ prog-midi-code
      82169 240 2555 18 128 81943 15 276 529 305 81 -17660 -17916 22])
 
 (defconst prog-midi-dump
-"Out-buffer must be 2 times bigger than in-buffer.
+(concat "Out-buffer must be 2 times bigger than in-buffer.
 Main-body:
     2:[read-jump-cond-expr-const] read r0, if !(r0 < 128), jump to 22(+20)
     5:[branch] jump to array[r3] of length 4
-	11 12 15 18 22 
+	11 12 15 18 22 ""
    11:[jump] jump to 2(-9)
    12:[set-register] r1 = r0
    13:[set-register] r0 = r4
@@ -227,7 +218,7 @@ prog-midi-dump
    71:[jump] jump to 2(-69)
 At EOF:
    72:[end] end
-")
+"))
 
 (ert-deftest ccl-compile-midi ()
   (should (equal (ccl-compile prog-midi-source) prog-midi-code)))
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index a4c6b0e491..85cbab2610 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -598,7 +598,9 @@ binding-test-some-local
   (should (fixnump (1- (1+ most-positive-fixnum)))))
 
 (ert-deftest data-tests-logand ()
-  (should (= -1 (logand -1)))
+  (should (= -1 (logand) (logand -1) (logand -1 -1)))
+  (let ((n (1+ most-positive-fixnum)))
+    (should (= (logand -1 n) n)))
   (let ((n (* 2 most-negative-fixnum)))
     (should (= (logand -1 n) n))))
 
@@ -606,11 +608,11 @@ binding-test-some-local
   (should (= (logcount (read "#xffffffffffffffffffffffffffffffff")) 128)))
 
 (ert-deftest data-tests-logior ()
-  (should (= -1 (logior -1)))
+  (should (= -1 (logior -1) (logior -1 -1)))
   (should (= -1 (logior most-positive-fixnum most-negative-fixnum))))
 
 (ert-deftest data-tests-logxor ()
-  (should (= -1 (logxor -1)))
+  (should (= -1 (logxor -1) (logxor -1 -1 -1)))
   (let ((n (1+ most-positive-fixnum)))
     (should (= (logxor -1 n) (lognot n)))))
 
@@ -642,6 +644,12 @@ data-tests-check-sign
   (should (= (ash most-negative-fixnum 1)
              (* most-negative-fixnum 2)))
   (should (= (lsh most-negative-fixnum 1)
-             (* most-negative-fixnum 2))))
+             (* most-negative-fixnum 2)))
+  (should (= (ash (* 2 most-negative-fixnum) -1)
+	     most-negative-fixnum))
+  (should (= (lsh most-positive-fixnum -1) (/ most-positive-fixnum 2)))
+  (should (= (lsh most-negative-fixnum -1) (lsh (- most-negative-fixnum) -1)))
+  (should (= (lsh -1 -1) most-positive-fixnum))
+  (should-error (lsh (1- most-negative-fixnum) -1)))
 
 ;;; data-tests.el ends here
-- 
2.17.1