Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixing some edge cases in arithmetic-shift.

Browse source
This commit is contained in:
Alex Shinn 2014-01-26 11:22:53 +09:00
parent 9e5e3fcec3
commit d1e9162012
2 changed files with 53 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
lib/srfi/33/bit.c
View file

@ -132,12 +132,21 @@ static sexp sexp_bit_xor (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
return sexp_bignum_normalize(res);
}
static int log2i(sexp_uint_t v) {
int i;
for (i = 0; i < sizeof(v)*8; i++)
if (((sexp_uint_t)1<<(i+1)) > v)
break;
return i;
}
/* should probably split into left and right shifts, that's a better */
/* interface anyway */
static sexp sexp_arithmetic_shift (sexp ctx, sexp self, sexp_sint_t n, sexp i, sexp count) {
sexp_sint_t c, tmp;
sexp_uint_t tmp;
sexp_sint_t c;
#if SEXP_USE_BIGNUMS
sexp_sint_t len, offset, bit_shift, j;
sexp_sint_t len, offset, bit_shift, tail_shift, j;
sexp_gc_var1(res);
#else
sexp res;
@ -152,10 +161,10 @@ static sexp sexp_arithmetic_shift (sexp ctx, sexp self, sexp_sint_t n, sexp i, s
} else {
tmp = (sexp_uint_t)sexp_unbox_fixnum(i) << c;
#if SEXP_USE_BIGNUMS
if (((tmp >> c) == sexp_unbox_fixnum(i))
&& (tmp < SEXP_MAX_FIXNUM) && (tmp > SEXP_MIN_FIXNUM)) {
if ((log2i(sexp_unbox_fixnum(i)) + c)
< (sizeof(sexp_uint_t)*CHAR_BIT - SEXP_FIXNUM_BITS)) {
#endif
res = sexp_make_fixnum(tmp);
res = sexp_make_fixnum(tmp * sexp_fx_sign(i));
#if SEXP_USE_BIGNUMS
} else {
sexp_gc_preserve1(ctx, res);
@ -187,14 +196,15 @@ static sexp sexp_arithmetic_shift (sexp ctx, sexp self, sexp_sint_t n, sexp i, s
} else {
offset = c / (sizeof(sexp_uint_t)*CHAR_BIT);
bit_shift = c - offset*(sizeof(sexp_uint_t)*CHAR_BIT);
tail_shift = (sizeof(sexp_uint_t)*CHAR_BIT-bit_shift);
res = sexp_make_bignum(ctx, len + offset + 1);
sexp_bignum_sign(res) = sexp_bignum_sign(i);
for (j=tmp=0; j<len; j++) {
sexp_bignum_data(res)[j+offset]
= (sexp_bignum_data(i)[j] << bit_shift) + tmp;
tmp = sexp_bignum_data(i)[j] >> (sizeof(sexp_uint_t)*CHAR_BIT-bit_shift);
tmp = sexp_bignum_data(i)[j] >> tail_shift;
}
sexp_bignum_data(res)[len+offset] = tmp;
if (bit_shift != 0) sexp_bignum_data(res)[len+offset] = tmp;
}
#endif
} else {

36
tests/srfi-33-tests.scm Normal file
View file

@ -0,0 +1,36 @@
(import (chibi) (srfi 33) (chibi test))
(test-begin "srfi-33")
(test 1 (arithmetic-shift 1 0))
(test 2 (arithmetic-shift 1 1))
(test 4 (arithmetic-shift 1 2))
(test 8 (arithmetic-shift 1 3))
(test 16 (arithmetic-shift 1 4))
(test (expt 2 31) (arithmetic-shift 1 31))
(test (expt 2 32) (arithmetic-shift 1 32))
(test (expt 2 33) (arithmetic-shift 1 33))
(test (expt 2 63) (arithmetic-shift 1 63))
(test (expt 2 64) (arithmetic-shift 1 64))
(test (expt 2 65) (arithmetic-shift 1 65))
(test (expt 2 127) (arithmetic-shift 1 127))
(test (expt 2 128) (arithmetic-shift 1 128))
(test (expt 2 129) (arithmetic-shift 1 129))
(test -1 (arithmetic-shift -1 0))
(test -2 (arithmetic-shift -1 1))
(test -4 (arithmetic-shift -1 2))
(test -8 (arithmetic-shift -1 3))
(test -16 (arithmetic-shift -1 4))
(test (- (expt 2 31)) (arithmetic-shift -1 31))
(test (- (expt 2 32)) (arithmetic-shift -1 32))
(test (- (expt 2 33)) (arithmetic-shift -1 33))
(test (- (expt 2 63)) (arithmetic-shift -1 63))
(test (- (expt 2 64)) (arithmetic-shift -1 64))
(test (- (expt 2 65)) (arithmetic-shift -1 65))
(test (- (expt 2 127)) (arithmetic-shift -1 127))
(test (- (expt 2 128)) (arithmetic-shift -1 128))
(test (- (expt 2 129)) (arithmetic-shift -1 129))
(test-end)