From 673b1785db4604efe81b8045a9d8ab68936af719 Mon Sep 17 00:00:00 2001 From: Paul Eggert 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)) + ;;;; 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