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

forgot to preserve some gc vars in the bignum lib

Browse source
This commit is contained in:
Alex Shinn 2009-12-30 03:49:21 +09:00
parent c94490872c
commit 1dba7fb8fd
2 changed files with 31 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
eval.c
View file

@ -1663,6 +1663,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case SEXP_OP_ADD: case SEXP_OP_ADD:
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
tmp1 = _ARG1, tmp2 = _ARG2; tmp1 = _ARG1, tmp2 = _ARG2;
sexp_context_top(ctx) = top;
if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) { if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
j = sexp_unbox_fixnum(tmp1) + sexp_unbox_fixnum(tmp2); j = sexp_unbox_fixnum(tmp1) + sexp_unbox_fixnum(tmp2);
if ((j < SEXP_MIN_FIXNUM) || (j > SEXP_MAX_FIXNUM)) if ((j < SEXP_MIN_FIXNUM) || (j > SEXP_MAX_FIXNUM))
@ -1690,6 +1691,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case SEXP_OP_SUB: case SEXP_OP_SUB:
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
tmp1 = _ARG1, tmp2 = _ARG2; tmp1 = _ARG1, tmp2 = _ARG2;
sexp_context_top(ctx) = top;
if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) { if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
j = sexp_unbox_fixnum(tmp1) - sexp_unbox_fixnum(tmp2); j = sexp_unbox_fixnum(tmp1) - sexp_unbox_fixnum(tmp2);
if ((j < SEXP_MIN_FIXNUM) || (j > SEXP_MAX_FIXNUM)) if ((j < SEXP_MIN_FIXNUM) || (j > SEXP_MAX_FIXNUM))
@ -1717,6 +1719,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case SEXP_OP_MUL: case SEXP_OP_MUL:
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
tmp1 = _ARG1, tmp2 = _ARG2; tmp1 = _ARG1, tmp2 = _ARG2;
sexp_context_top(ctx) = top;
if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) { if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
prod = (sexp_lsint_t)sexp_unbox_fixnum(tmp1) * sexp_unbox_fixnum(tmp2); prod = (sexp_lsint_t)sexp_unbox_fixnum(tmp1) * sexp_unbox_fixnum(tmp2);
if ((prod < SEXP_MIN_FIXNUM) || (prod > SEXP_MAX_FIXNUM)) if ((prod < SEXP_MIN_FIXNUM) || (prod > SEXP_MAX_FIXNUM))
@ -1742,6 +1745,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
top--; top--;
break; break;
case SEXP_OP_DIV: case SEXP_OP_DIV:
sexp_context_top(ctx) = top;
if (_ARG2 == SEXP_ZERO) { if (_ARG2 == SEXP_ZERO) {
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
if (sexp_flonump(_ARG1) && sexp_flonum_value(_ARG1) == 0.0) if (sexp_flonump(_ARG1) && sexp_flonum_value(_ARG1) == 0.0)
@ -1785,6 +1789,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
} }
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
else { else {
sexp_context_top(ctx) = top;
_ARG2 = sexp_quotient(ctx, _ARG1, _ARG2); _ARG2 = sexp_quotient(ctx, _ARG1, _ARG2);
top--; top--;
} }
@ -1802,6 +1807,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
} }
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
else { else {
sexp_context_top(ctx) = top;
_ARG2 = sexp_remainder(ctx, _ARG1, _ARG2); _ARG2 = sexp_remainder(ctx, _ARG1, _ARG2);
top--; top--;
} }

33
opt/bignum.c
View file

@ -173,8 +173,10 @@ sexp sexp_bignum_fxmul (sexp ctx, sexp d, sexp a, sexp_uint_t b, int offset) {
sexp_uint_t len=sexp_bignum_length(a), *data, *adata=sexp_bignum_data(a), sexp_uint_t len=sexp_bignum_length(a), *data, *adata=sexp_bignum_data(a),
carry=0, i; carry=0, i;
sexp_luint_t n; sexp_luint_t n;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
if ((! d) || (sexp_bignum_length(d)+offset < len)) if ((! d) || (sexp_bignum_length(d)+offset < len))
d = sexp_make_bignum(ctx, len); d = tmp = sexp_make_bignum(ctx, len);
data = sexp_bignum_data(d); data = sexp_bignum_data(d);
for (i=0; i<len; i++) { for (i=0; i<len; i++) {
n = (sexp_luint_t)adata[i]*b + carry; n = (sexp_luint_t)adata[i]*b + carry;
@ -186,6 +188,7 @@ sexp sexp_bignum_fxmul (sexp ctx, sexp d, sexp a, sexp_uint_t b, int offset) {
d = sexp_copy_bignum(ctx, NULL, d, len+offset+1); d = sexp_copy_bignum(ctx, NULL, d, len+offset+1);
sexp_bignum_data(d)[len+offset] = carry; sexp_bignum_data(d)[len+offset] = carry;
} }
sexp_gc_release1(ctx);
return d; return d;
} }
@ -522,6 +525,8 @@ sexp sexp_add (sexp ctx, sexp a, sexp b) {
sexp sexp_sub (sexp ctx, sexp a, sexp b) { sexp sexp_sub (sexp ctx, sexp a, sexp b) {
int at=sexp_number_type(a), bt=sexp_number_type(b); int at=sexp_number_type(a), bt=sexp_number_type(b);
sexp r=SEXP_VOID; sexp r=SEXP_VOID;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
switch ((at << 2) + bt) { switch ((at << 2) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX: case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG: case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
@ -537,7 +542,8 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
r = sexp_make_flonum(ctx, sexp_fixnum_to_double(a)-sexp_flonum_value(b)); r = sexp_make_flonum(ctx, sexp_fixnum_to_double(a)-sexp_flonum_value(b));
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
r = sexp_bignum_sub(ctx, NULL, b, sexp_fixnum_to_bignum(ctx, a)); tmp = sexp_fixnum_to_bignum(ctx, a);
r = sexp_bignum_sub(ctx, NULL, b, tmp);
sexp_negate(r); sexp_negate(r);
r = sexp_bignum_normalize(r); r = sexp_bignum_normalize(r);
break; break;
@ -551,7 +557,8 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
r = sexp_make_flonum(ctx, sexp_flonum_value(a) - sexp_bignum_to_double(b)); r = sexp_make_flonum(ctx, sexp_flonum_value(a) - sexp_bignum_to_double(b));
break; break;
case SEXP_NUM_BIG_FIX: case SEXP_NUM_BIG_FIX:
r = sexp_bignum_normalize(sexp_bignum_sub(ctx, NULL, a, sexp_fixnum_to_bignum(ctx, b))); tmp = sexp_fixnum_to_bignum(ctx, b);
r = sexp_bignum_normalize(sexp_bignum_sub(ctx, NULL, a, tmp));
break; break;
case SEXP_NUM_BIG_FLO: case SEXP_NUM_BIG_FLO:
r = sexp_make_flonum(ctx, sexp_flonum_value(b) - sexp_bignum_to_double(a)); r = sexp_make_flonum(ctx, sexp_flonum_value(b) - sexp_bignum_to_double(a));
@ -559,6 +566,7 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
r = sexp_bignum_normalize(sexp_bignum_sub(ctx, NULL, a, b)); r = sexp_bignum_normalize(sexp_bignum_sub(ctx, NULL, a, b));
break; break;
} }
sexp_gc_release1(ctx);
return r; return r;
} }
@ -598,6 +606,8 @@ sexp sexp_div (sexp ctx, sexp a, sexp b) {
int at=sexp_number_type(a), bt=sexp_number_type(b); int at=sexp_number_type(a), bt=sexp_number_type(b);
double f; double f;
sexp r=SEXP_VOID, rem; sexp r=SEXP_VOID, rem;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
switch ((at << 2) + bt) { switch ((at << 2) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX: case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG: case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
@ -627,11 +637,11 @@ sexp sexp_div (sexp ctx, sexp a, sexp b) {
r = sexp_make_flonum(ctx, sexp_flonum_value(a) / sexp_bignum_to_double(b)); r = sexp_make_flonum(ctx, sexp_flonum_value(a) / sexp_bignum_to_double(b));
break; break;
case SEXP_NUM_BIG_FIX: case SEXP_NUM_BIG_FIX:
b = sexp_fixnum_to_bignum(ctx, b); b = tmp = sexp_fixnum_to_bignum(ctx, b);
/* ... FALLTHROUGH ... */ /* ... FALLTHROUGH ... */
case SEXP_NUM_BIG_BIG: case SEXP_NUM_BIG_BIG:
r = sexp_bignum_quot_rem(ctx, &rem, a, b); r = sexp_bignum_quot_rem(ctx, &rem, a, b);
if (sexp_bignum_normalize(rem) != sexp_make_fixnum(0)) if (sexp_bignum_normalize(rem) != SEXP_ZERO)
r = sexp_make_flonum(ctx, sexp_bignum_to_double(a) r = sexp_make_flonum(ctx, sexp_bignum_to_double(a)
/ sexp_fixnum_to_double(b)); / sexp_fixnum_to_double(b));
else else
@ -641,12 +651,15 @@ sexp sexp_div (sexp ctx, sexp a, sexp b) {
r = sexp_make_flonum(ctx, sexp_bignum_to_double(a) / sexp_flonum_value(b)); r = sexp_make_flonum(ctx, sexp_bignum_to_double(a) / sexp_flonum_value(b));
break; break;
} }
sexp_gc_release1(ctx);
return r; return r;
} }
sexp sexp_quotient (sexp ctx, sexp a, sexp b) { sexp sexp_quotient (sexp ctx, sexp a, sexp b) {
int at=sexp_number_type(a), bt=sexp_number_type(b); int at=sexp_number_type(a), bt=sexp_number_type(b);
sexp r=SEXP_VOID; sexp r=SEXP_VOID;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
switch ((at << 2) + bt) { switch ((at << 2) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX: case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG: case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
@ -665,21 +678,24 @@ sexp sexp_quotient (sexp ctx, sexp a, sexp b) {
r = sexp_fx_div(a, b); r = sexp_fx_div(a, b);
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
r = sexp_make_fixnum(0); r = SEXP_ZERO;
break; break;
case SEXP_NUM_BIG_FIX: case SEXP_NUM_BIG_FIX:
b = sexp_fixnum_to_bignum(ctx, b); b = tmp = sexp_fixnum_to_bignum(ctx, b);
/* ... FALLTHROUGH ... */ /* ... FALLTHROUGH ... */
case SEXP_NUM_BIG_BIG: case SEXP_NUM_BIG_BIG:
r = sexp_bignum_normalize(sexp_bignum_quotient(ctx, a, b)); r = sexp_bignum_normalize(sexp_bignum_quotient(ctx, a, b));
break; break;
} }
sexp_gc_release1(ctx);
return r; return r;
} }
sexp sexp_remainder (sexp ctx, sexp a, sexp b) { sexp sexp_remainder (sexp ctx, sexp a, sexp b) {
int at=sexp_number_type(a), bt=sexp_number_type(b); int at=sexp_number_type(a), bt=sexp_number_type(b);
sexp r=SEXP_VOID; sexp r=SEXP_VOID;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
switch ((at << 2) + bt) { switch ((at << 2) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX: case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG: case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
@ -701,12 +717,13 @@ sexp sexp_remainder (sexp ctx, sexp a, sexp b) {
r = a; r = a;
break; break;
case SEXP_NUM_BIG_FIX: case SEXP_NUM_BIG_FIX:
b = sexp_fixnum_to_bignum(ctx, b); b = tmp = sexp_fixnum_to_bignum(ctx, b);
/* ... FALLTHROUGH ... */ /* ... FALLTHROUGH ... */
case SEXP_NUM_BIG_BIG: case SEXP_NUM_BIG_BIG:
r = sexp_bignum_normalize(sexp_bignum_remainder(ctx, a, b)); r = sexp_bignum_normalize(sexp_bignum_remainder(ctx, a, b));
break; break;
} }
sexp_gc_release1(ctx);
return r; return r;
} }