From cdaaaf2e1bd1f8ad2784ffc8265aa642da2d1190 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Tue, 18 Dec 2018 12:21:27 -0800
Subject: [PATCH] Support (ash INTEGER BIGNUM)

* src/data.c (emacs_mpz_mul_2exp): 2nd arg is now a
nonnegative EMACS_INT not mp_bitcnt_t, to simplify checking.
(Fash): Support COUNT values that are bignums or that
exceed mp_bitcnt_t range.
* test/src/data-tests.el (data-tests-ash-lsh): Test this.
---
 src/data.c             | 29 +++++++++++++++++++++--------
 test/src/data-tests.el |  4 ++++
 2 files changed, 25 insertions(+), 8 deletions(-)

diff --git a/src/data.c b/src/data.c
index 0980cf99886..c64adb6635e 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2414,14 +2414,14 @@ emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2)
 }
 
 static void
-emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, mp_bitcnt_t op2)
+emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, EMACS_INT op2)
 {
   /* Fudge factor derived from GMP 6.1.2, to avoid an abort in
      mpz_mul_2exp (look for the '+ 1' in its source code).  */
   enum { mul_2exp_extra_limbs = 1 };
   enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - mul_2exp_extra_limbs) };
 
-  mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS;
+  EMACS_INT op2limbs = op2 / GMP_NUMB_BITS;
   if (lim - emacs_mpz_size (op1) < op2limbs)
     overflow_error ();
   mpz_mul_2exp (rop, op1, op2);
@@ -3251,12 +3251,21 @@ If COUNT is negative, shifting is actually to the right.
 In this case, the sign bit is duplicated.  */)
   (Lisp_Object value, Lisp_Object count)
 {
-  /* 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_RANGED_INTEGER (count, - minus_count_min, TYPE_MAXIMUM (mp_bitcnt_t));
+  CHECK_INTEGER (count);
+
+  if (! FIXNUMP (count))
+    {
+      if (EQ (value, make_fixnum (0)))
+	return value;
+      if (mpz_sgn (XBIGNUM (count)->value) < 0)
+	{
+	  EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value)
+			 : mpz_sgn (XBIGNUM (value)->value));
+	  return make_fixnum (v < 0 ? -1 : 0);
+	}
+      overflow_error ();
+    }
 
   if (XFIXNUM (count) <= 0)
     {
@@ -3275,7 +3284,11 @@ In this case, the sign bit is duplicated.  */)
 
   mpz_t *zval = bignum_integer (&mpz[0], value);
   if (XFIXNUM (count) < 0)
-    mpz_fdiv_q_2exp (mpz[0], *zval, - XFIXNUM (count));
+    {
+      if (TYPE_MAXIMUM (mp_bitcnt_t) < - XFIXNUM (count))
+	return make_fixnum (mpz_sgn (*zval) < 0 ? -1 : 0);
+      mpz_fdiv_q_2exp (mpz[0], *zval, - XFIXNUM (count));
+    }
   else
     emacs_mpz_mul_2exp (mpz[0], *zval, XFIXNUM (count));
   return make_integer_mpz ();
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index d41c7623289..bbf7e2a2394 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -656,6 +656,10 @@ comparing the subr with a much slower lisp implementation."
 (ert-deftest data-tests-ash-lsh ()
   (should (= (ash most-negative-fixnum 1)
              (* most-negative-fixnum 2)))
+  (should (= (ash 0 (* 2 most-positive-fixnum)) 0))
+  (should (= (ash 1000 (* 2 most-negative-fixnum)) 0))
+  (should (= (ash -1000 (* 2 most-negative-fixnum)) -1))
+  (should (= (ash (* 2 most-negative-fixnum) (* 2 most-negative-fixnum)) -1))
   (should (= (lsh most-negative-fixnum 1)
              (* most-negative-fixnum 2)))
   (should (= (ash (* 2 most-negative-fixnum) -1)
-- 
2.39.5