mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-16 17:37:34 +02:00
updating more bitwise corner cases (issue #408)
This commit is contained in:
Alex Shinn
parent
383c6cba62
commit
5fb3217ada
2 changed files with 47 additions and 16 deletions
|
|
@ -16,6 +16,13 @@
|
|||
#define sexp_bignum_normalize(x) x
|
||||
#endif
|
||||
|
||||
/* The twos complement form of a negative bignum has a -1 sign */
|
||||
/* and bits adjusted as usual, extending just the high word with */
|
||||
/* leading ones. Bitwise operations are then performed as usual. */
|
||||
/* If the result has a leading extended one from a twos complement */
|
||||
/* number, the complement is reversed and sign remains negative. */
|
||||
/* Otherwise, the result is positive, the sign is set to 1 and there's */
|
||||
/* no need to undo the complement. */
|
||||
static void sexp_set_twos_complement (sexp a) {
|
||||
int i, len=sexp_bignum_length(a), carry = 1;
|
||||
sexp_uint_t* data = sexp_bignum_data(a), n;
|
||||
|
|
@ -34,7 +41,6 @@ static sexp sexp_twos_complement (sexp ctx, sexp x) {
|
|||
if (sexp_bignump(x) && sexp_bignum_sign(x) < 0) {
|
||||
sexp_gc_preserve1(ctx, res);
|
||||
res = sexp_copy_bignum(ctx, NULL, x, 0);
|
||||
sexp_bignum_sign(res) = 1;
|
||||
sexp_set_twos_complement(res);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
|
|
@ -52,13 +58,17 @@ static sexp sexp_fixnum_to_twos_complement (sexp ctx, sexp x, int len) {
|
|||
sexp_bignum_data(res)[i] = (sexp_uint_t)((sexp_sint_t)-1);
|
||||
sexp_bignum_data(res)[0] = ~(-(sexp_unbox_fixnum(x)));
|
||||
res = sexp_bignum_fxadd(ctx, res, 1);
|
||||
if (sexp_bignum_length(res) == len + 1 && sexp_bignum_data(res)[len] == 1)
|
||||
sexp_bignum_data(res)[len] = -1;
|
||||
if (sexp_unbox_fixnum(x) < 0)
|
||||
sexp_bignum_sign(res) = -1;
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_bit_and (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
|
||||
#if SEXP_USE_BIGNUMS
|
||||
sexp_sint_t len, i;
|
||||
sexp_sint_t len, lenx, leny, i;
|
||||
#endif
|
||||
sexp_gc_var3(res, x2, y2);
|
||||
if (sexp_fixnump(x) && sexp_fixnump(y)) {
|
||||
|
|
@ -75,13 +85,24 @@ sexp sexp_bit_and (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
|
|||
if (sexp_fixnump(y2)) {
|
||||
res = sexp_make_fixnum(sexp_unbox_fixnum(y2) & sexp_bignum_data(x2)[0]);
|
||||
} else if (sexp_bignump(y2)) {
|
||||
if (sexp_bignum_length(x2) < sexp_bignum_length(y2))
|
||||
lenx = sexp_bignum_length(x2);
|
||||
leny = sexp_bignum_length(y2);
|
||||
if (leny < lenx)
|
||||
res = sexp_copy_bignum(ctx, NULL, x2, 0);
|
||||
else
|
||||
res = sexp_copy_bignum(ctx, NULL, y2, 0);
|
||||
for (i=0, len=sexp_bignum_length(res); i<len; i++)
|
||||
sexp_bignum_data(res)[i]
|
||||
= sexp_bignum_data(x2)[i] & sexp_bignum_data(y2)[i];
|
||||
= (i<lenx ? sexp_bignum_data(x2)[i] : sexp_bignum_sign(x2) < 0 ? -1 : 0) &
|
||||
(i<leny ? sexp_bignum_data(y2)[i] : sexp_bignum_sign(y2) < 0 ? -1 : 0);
|
||||
if ((sexp_bignum_sign(x2) < 0 || sexp_bignum_sign(y2) < 0) && ((sexp_sint_t)(sexp_bignum_data(res)[len-1])) < 0) {
|
||||
sexp_set_twos_complement(res);
|
||||
if (sexp_bignum_sign(res) > 0) {
|
||||
sexp_negate_exact(res);
|
||||
}
|
||||
} else if (sexp_bignum_sign(res) < 0) {
|
||||
sexp_negate_exact(res);
|
||||
}
|
||||
} else {
|
||||
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, y2);
|
||||
}
|
||||
|
|
@ -95,7 +116,7 @@ sexp sexp_bit_and (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
|
|||
|
||||
sexp sexp_bit_ior (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
|
||||
#if SEXP_USE_BIGNUMS
|
||||
sexp_sint_t len, i;
|
||||
sexp_sint_t len, tmplen, i;
|
||||
#endif
|
||||
sexp_gc_var2(res, tmp);
|
||||
if (sexp_fixnump(x)) {
|
||||
|
|
@ -120,21 +141,23 @@ sexp sexp_bit_ior (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
|
|||
} else if (sexp_bignump(y) || sexp_fixnump(y)) {
|
||||
if (sexp_fixnump(y) || sexp_bignum_length(x) >= sexp_bignum_length(y)) {
|
||||
res = sexp_copy_bignum(ctx, NULL, x, 0);
|
||||
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(res);
|
||||
tmp = sexp_fixnump(y) ? sexp_fixnum_to_twos_complement(ctx, y, len) : sexp_twos_complement(ctx, y);
|
||||
} else {
|
||||
res = sexp_copy_bignum(ctx, NULL, y, 0);
|
||||
len = sexp_bignum_length(res);
|
||||
tmp = sexp_twos_complement(ctx, x);
|
||||
len = sexp_bignum_length(tmp);
|
||||
}
|
||||
if (sexp_bignum_sign(res) < 0)
|
||||
sexp_set_twos_complement(res);
|
||||
tmplen = sexp_bignum_length(tmp);
|
||||
for (i=0; i<len; i++)
|
||||
sexp_bignum_data(res)[i] |= sexp_bignum_data(tmp)[i];
|
||||
if ((sexp_bignum_sign(x) < 0) ^ (sexp_fixnump(y) || sexp_bignum_sign(y) < 0))
|
||||
sexp_bignum_data(res)[i] |= (i<tmplen ? sexp_bignum_data(tmp)[i] : sexp_bignum_sign(tmp) < 0 ? -1 : 0);
|
||||
if ((sexp_bignum_sign(res) < 0 || sexp_bignum_sign(tmp) < 0) && ((sexp_sint_t)(sexp_bignum_data(res)[len-1])) < 0) {
|
||||
sexp_set_twos_complement(res);
|
||||
if (sexp_fixnump(y) || sexp_bignum_sign(y) < 0) {
|
||||
sexp_negate_exact(res);
|
||||
if (sexp_bignum_sign(res) > 0) {
|
||||
sexp_negate_exact(res);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, y);
|
||||
|
|
@ -149,7 +172,7 @@ sexp sexp_bit_ior (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
|
|||
|
||||
sexp sexp_bit_xor (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
|
||||
#if SEXP_USE_BIGNUMS
|
||||
sexp_sint_t len, i;
|
||||
sexp_sint_t len, tmplen, i;
|
||||
#endif
|
||||
sexp_gc_var2(res, tmp);
|
||||
if (sexp_fixnump(x)) {
|
||||
|
|
@ -183,9 +206,9 @@ sexp sexp_bit_xor (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
|
|||
}
|
||||
if (sexp_bignum_sign(res) < 0)
|
||||
sexp_set_twos_complement(res);
|
||||
tmplen = sexp_bignum_length(tmp);
|
||||
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] ^= (i<tmplen ? sexp_bignum_data(tmp)[i] : sexp_bignum_sign(tmp) < 0 ? -1 : 0);
|
||||
if ((sexp_bignum_sign(x) < 0) ^ (sexp_fixnump(y) || sexp_bignum_sign(y) < 0))
|
||||
sexp_set_twos_complement(res);
|
||||
if (sexp_fixnump(y) || sexp_bignum_sign(y) < 0) {
|
||||
|
|
@ -401,4 +424,3 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
|
|||
sexp_define_foreign(ctx, env, "bit-set?", 2, sexp_bit_set_p);
|
||||
return SEXP_VOID;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -21,6 +21,12 @@
|
|||
(test -2600468497 (bitwise-ior 1694076839 -4290775858))
|
||||
(test -184549633 (bitwise-ior -193073517 1689392892))
|
||||
(test -167776621 (bitwise-ior -193073517 1689392892000000000000))
|
||||
(test -18446744073709551616
|
||||
(bitwise-ior -18446744073709551616
|
||||
340282366920938463463374607431768211456))
|
||||
(test 340282366920938463481821351505477763072
|
||||
(bitwise-ior 18446744073709551616
|
||||
340282366920938463463374607431768211456))
|
||||
(test -7090566332214939648
|
||||
(bitwise-ior -193073517000000000000 1689392892000000000000))
|
||||
(test -351599414102633810746018680881203758247936
|
||||
|
|
@ -45,6 +51,9 @@
|
|||
-1689392892000000000000193073517000000000000))
|
||||
(test 3769478 (bitwise-and 1694076839 -4290775858))
|
||||
(test 1680869008 (bitwise-and -193073517 1689392892))
|
||||
(test 340282366920938463463374607431768211456
|
||||
(bitwise-and 340282366920938463463374607431768211456
|
||||
(bitwise-not 18446744073709551616)))
|
||||
|
||||
(test 1 (arithmetic-shift 1 0))
|
||||
(test 2 (arithmetic-shift 1 1))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue