[Emacs-diffs] master 673b178: Restore traditional lsh behavior on fixnums

[Paul Eggert]

branch: master
commit 673b1785db4604efe81b8045a9d8ab68936af719
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Restore traditional lsh behavior on fixnums
    
    * 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 37d2c31..ee6456b 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -844,7 +844,9 @@ bits in @var{integer1} to the left @var{count} places, or 
to the right
 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
address@hidden is negative.  Contrast this with @code{ash}, below.
address@hidden is negative fixnum.  (If @var{integer1} is a negative
+bignum, @var{count} must be nonnegative.)  Contrast this with
address@hidden, 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 @@ is negative.
 @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
address@hidden puts zeros in those bit positions.
address@hidden puts zeros in those bit positions and requires
address@hidden 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 fbb3e49..cafa483 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -366,6 +366,18 @@ was called."
   (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))
+
 
 ;;;; List functions.
 
diff --git a/src/data.c b/src/data.c
index 5a355d9..a39978a 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 b41b8c1..7dd7224 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 @@ At EOF:
      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 @@ Main-body:
    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 a4c6b0e..85cbab2 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -598,7 +598,9 @@ comparing the subr with a much slower lisp implementation."
   (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 @@ comparing the subr with a much slower lisp 
implementation."
   (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 @@ comparing the subr with a much slower lisp implementation."
   (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