procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Restore traditional lsh behavior on fixnums

Browse source 
* 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.
This commit is contained in:
Paul Eggert 2018-08-18 15:20:46 -07:00
parent 877cd22f55
commit 673b1785db
5 changed files with 59 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
doc/lispref/numbers.texi
View file

@ -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
@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 @@ 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
@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:

12
lisp/subr.el
View file

@ -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.

60
src/data.c
View file

@ -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);

21
test/lisp/international/ccl-tests.el
View file

@ -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)))

16
test/src/data-tests.el
View file

@ -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