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.

1 files changed, 24 insertions, 36 deletions

diff --git a/src/data.c b/src/data.c
index 5a355d9787c..a39978ab1dc 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);