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

fixing bitwise-ior for the bignum|negative-fixnum case

Browse source
This commit is contained in:
Alex Shinn 2017-05-07 16:17:06 +09:00
parent 1e25dda078
commit bddb28ace7
2 changed files with 25 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
lib/srfi/142/bit.c
View file

@ -47,6 +47,7 @@ static sexp sexp_fixnum_to_twos_complement (sexp ctx, sexp x, int len) {
sexp_gc_var1(res); sexp_gc_var1(res);
sexp_gc_preserve1(ctx, res); sexp_gc_preserve1(ctx, res);
res = sexp_make_bignum(ctx, len); res = sexp_make_bignum(ctx, len);
if (sexp_unbox_fixnum(x) < 0)
for (i = len-1; i > 0; i--) for (i = len-1; i > 0; i--)
sexp_bignum_data(res)[i] = (sexp_uint_t)((sexp_sint_t)-1); sexp_bignum_data(res)[i] = (sexp_uint_t)((sexp_sint_t)-1);
sexp_bignum_data(res)[0] = ~(-(sexp_unbox_fixnum(x))); sexp_bignum_data(res)[0] = ~(-(sexp_unbox_fixnum(x)));
@ -109,17 +110,17 @@ sexp sexp_bit_ior (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) { } else if (sexp_bignump(x)) {
sexp_gc_preserve2(ctx, res, tmp); sexp_gc_preserve2(ctx, res, tmp);
if (sexp_fixnump(y)) { if (sexp_fixnump(y) && sexp_unbox_fixnum(y) >= 0) {
res = sexp_copy_bignum(ctx, NULL, x, 0); res = sexp_copy_bignum(ctx, NULL, x, 0);
if (sexp_bignum_sign(res) < 0) if (sexp_bignum_sign(res) < 0)
sexp_set_twos_complement(res); sexp_set_twos_complement(res);
sexp_bignum_data(res)[0] |= (sexp_uint_t)sexp_unbox_fixnum(y); sexp_bignum_data(res)[0] |= (sexp_uint_t)sexp_unbox_fixnum(y);
if (sexp_bignum_sign(res) < 0) if (sexp_bignum_sign(res) < 0)
sexp_set_twos_complement(res); sexp_set_twos_complement(res);
} else if (sexp_bignump(y)) { } else if (sexp_bignump(y) || sexp_fixnump(y)) {
if (sexp_bignum_length(x) >= sexp_bignum_length(y)) { if (sexp_fixnump(y) || sexp_bignum_length(x) >= sexp_bignum_length(y)) {
res = sexp_copy_bignum(ctx, NULL, x, 0); res = sexp_copy_bignum(ctx, NULL, x, 0);
tmp = sexp_twos_complement(ctx, y); tmp = sexp_fixnump(y) ? sexp_fixnum_to_twos_complement(ctx, y, sexp_bignum_length(x)) : sexp_twos_complement(ctx, y);
len = sexp_bignum_length(tmp); len = sexp_bignum_length(tmp);
} else { } else {
res = sexp_copy_bignum(ctx, NULL, y, 0); res = sexp_copy_bignum(ctx, NULL, y, 0);
@ -129,10 +130,12 @@ sexp sexp_bit_ior (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
if (sexp_bignum_sign(res) < 0) if (sexp_bignum_sign(res) < 0)
sexp_set_twos_complement(res); sexp_set_twos_complement(res);
for (i=0; i<len; i++) for (i=0; i<len; i++)
sexp_bignum_data(res)[i] sexp_bignum_data(res)[i] |= sexp_bignum_data(tmp)[i];
= sexp_bignum_data(res)[i] | sexp_bignum_data(tmp)[i]; if ((sexp_bignum_sign(res) < 0) ^ sexp_fixnump(y))
if (sexp_bignum_sign(res) < 0)
sexp_set_twos_complement(res); sexp_set_twos_complement(res);
if (sexp_fixnump(y)) {
sexp_negate_exact(res);
}
} else { } else {
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, y); res = sexp_type_exception(ctx, self, SEXP_FIXNUM, y);
} }

13
lib/srfi/142/test.sld
View file

@ -20,8 +20,21 @@
(test -18446744073709551446 (bitwise-xor #b10101010 (- -1 #xffffffffffffffff))) (test -18446744073709551446 (bitwise-xor #b10101010 (- -1 #xffffffffffffffff)))
(test -2600468497 (bitwise-ior 1694076839 -4290775858)) (test -2600468497 (bitwise-ior 1694076839 -4290775858))
(test -184549633 (bitwise-ior -193073517 1689392892)) (test -184549633 (bitwise-ior -193073517 1689392892))
(test -167776621 (bitwise-ior -193073517 1689392892000000000000))
(test -7090566332214939648
(bitwise-ior -193073517000000000000 1689392892000000000000))
(test -351599414102633810746018680881203758247936
(bitwise-ior -1930735170000000000001689392892000000000000
1689392892000000000000193073517000000000000))
(test -2604237975 (bitwise-xor 1694076839 -4290775858)) (test -2604237975 (bitwise-xor 1694076839 -4290775858))
(test -1865418641 (bitwise-xor -193073517 1689392892)) (test -1865418641 (bitwise-xor -193073517 1689392892))
(test -1510500507664429879296
(bitwise-xor -193073517000000000000 1689392892000000000000))
(test -1510500507664429879296
(bitwise-xor -193073517000000000000 1689392892000000000000))
(test -461856550205267621490541042387407516495872
(bitwise-xor -1930735170000000000001689392892000000000000
1689392892000000000000193073517000000000000))
(test 3769478 (bitwise-and 1694076839 -4290775858)) (test 3769478 (bitwise-and 1694076839 -4290775858))
(test 1680869008 (bitwise-and -193073517 1689392892)) (test 1680869008 (bitwise-and -193073517 1689392892))