suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Chez Scheme: repair bignum shift right

Browse Source 
When a negative bignum is shifted right by a multiple of the bigint
bit size (which is 32), when a shifted-off bit is non-0, and when the
result would be a sequence of bigints with all 1 bits before rounding
to deal with the dropped bits, a carry that should have been delivered
to a new high bigint was dropped.

Closes #3794
This commit is contained in:
Matthew Flatt 2021-04-20 18:01:37 -06:00
parent 890aa076a9
commit f383076784
3 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-test-core/tests/racket/number.rktl
View File

@ -1328,6 +1328,8 @@
(test -1 arithmetic-shift -1 (- (expt 2 100)))
(test -1 arithmetic-shift (- (expt 2 100)) (- (expt 2 100)))
(test (- (expt 16 232)) arithmetic-shift (- 307 (expt 16 240)) -32)
(arity-test arithmetic-shift 2 2)
(err/rt-test (arithmetic-shift "a" 1))
(err/rt-test (arithmetic-shift 1 "a"))

13
racket/src/ChezScheme/c/number.c
View File

@ -1322,8 +1322,10 @@ static ptr s_big_ash(tc, xp, xl, sign, cnt) ptr tc; bigit *xp; iptr xl; IBOOL si
if ((xl -= (whole_bigits = (cnt = -cnt) / bigit_bits)) <= 0) return sign ? FIX(-1) : FIX(0);
cnt -= whole_bigits * bigit_bits;
/* shift by remaining count to scratch bignum, tracking bits shifted off to the right */
PREPARE_BIGNUM(tc, W(tc),xl)
/* shift by remaining count to scratch bignum, tracking bits shifted off to the right;
prepare a bignum one large than probably needed, in case we have to deal with a
carry bit when rounding down for a negative number */
PREPARE_BIGNUM(tc, W(tc),xl+1)
p1 = &BIGIT(W(tc), 0);
p2 = xp;
k = 0;
@ -1353,6 +1355,13 @@ static ptr s_big_ash(tc, xp, xl, sign, cnt) ptr tc; bigit *xp; iptr xl; IBOOL si
p1 = &BIGIT(W(tc), xl - 1);
for (i = xl, k = 1; k != 0 && i-- > 0; p1 -= 1)
EADDC(0, *p1, p1, &k)
if (k) {
/* add carry bit back; we prepared a large enough bignum,
and since of all the middle are zero, we don't have to reshift */
BIGIT(W(tc), xl) = 0;
BIGIT(W(tc), 0) = 1;
xl++;
}
}
}

2
racket/src/ChezScheme/mats/5_3.ms
View File

@ -3300,6 +3300,7 @@
(eqv? (bitwise-arithmetic-shift 0 (- (expt 2 100))) 0)
(eqv? (bitwise-arithmetic-shift 0 (expt 2 100)) 0)
(eqv? (bitwise-arithmetic-shift 0 (expt 2 100)) 0)
(eqv? (- (expt 16 232)) (bitwise-arithmetic-shift (- 307 (expt 16 240)) -32))
($test-right-shift (lambda (x n) (bitwise-arithmetic-shift x (- n))))
)
@ -3348,6 +3349,7 @@
(eqv? (bitwise-arithmetic-shift-right #x-8000000000000000 31) #x-100000000)
(eqv? (bitwise-arithmetic-shift-right #x-8000000000000000 32) #x-80000000)
(eqv? (bitwise-arithmetic-shift-right #x-8000000000000000 33) #x-40000000)
(eqv? (- (expt 16 232)) (bitwise-arithmetic-shift-right (- 307 (expt 16 240)) 32))
($test-right-shift (lambda (x n) (bitwise-arithmetic-shift-right x n)))
)