mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
parent
558e1a895f
commit
72ec53ca26
5 changed files with 25 additions and 7 deletions
4
eval.c
4
eval.c
|
@ -1947,8 +1947,8 @@ sexp sexp_inexact_to_exact (sexp ctx, sexp self, sexp_sint_t n, sexp z) {
|
||||||
res = sexp_xtype_exception(ctx, self, "exact: not an integer", z);
|
res = sexp_xtype_exception(ctx, self, "exact: not an integer", z);
|
||||||
#endif
|
#endif
|
||||||
#if SEXP_USE_BIGNUMS
|
#if SEXP_USE_BIGNUMS
|
||||||
} else if ((sexp_flonum_value(z) > SEXP_MAX_FIXNUM)
|
} else if ((sexp_flonum_value(z) > (double)SEXP_MAX_FIXNUM)
|
||||||
|| sexp_flonum_value(z) < SEXP_MIN_FIXNUM) {
|
|| sexp_flonum_value(z) < (double)SEXP_MIN_FIXNUM) {
|
||||||
res = sexp_double_to_bignum(ctx, sexp_flonum_value(z));
|
res = sexp_double_to_bignum(ctx, sexp_flonum_value(z));
|
||||||
#endif
|
#endif
|
||||||
} else {
|
} else {
|
||||||
|
|
|
@ -1079,6 +1079,7 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
|
||||||
#define sexp_negate_flonum(x) sexp_flonum_value(x) = -(sexp_flonum_value(x))
|
#define sexp_negate_flonum(x) sexp_flonum_value(x) = -(sexp_flonum_value(x))
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* TODO: Doesn't support x == SEXP_MIN_FIXNUM. */
|
||||||
#define sexp_negate(x) \
|
#define sexp_negate(x) \
|
||||||
if (sexp_flonump(x)) \
|
if (sexp_flonump(x)) \
|
||||||
sexp_negate_flonum(x); \
|
sexp_negate_flonum(x); \
|
||||||
|
|
|
@ -65,7 +65,7 @@ sexp json_read_number (sexp ctx, sexp self, sexp in) {
|
||||||
res *= pow(10.0, scale_sign * scale);
|
res *= pow(10.0, scale_sign * scale);
|
||||||
}
|
}
|
||||||
if (ch != EOF) sexp_push_char(ctx, ch, in);
|
if (ch != EOF) sexp_push_char(ctx, ch, in);
|
||||||
return (inexactp || fabs(res) > SEXP_MAX_FIXNUM) ?
|
return (inexactp || fabs(res) > (double)SEXP_MAX_FIXNUM) ?
|
||||||
sexp_make_flonum(ctx, sign * res) :
|
sexp_make_flonum(ctx, sign * res) :
|
||||||
sexp_make_fixnum(sign * res); /* always return inexact? */
|
sexp_make_fixnum(sign * res); /* always return inexact? */
|
||||||
}
|
}
|
||||||
|
|
10
sexp.c
10
sexp.c
|
@ -2890,6 +2890,13 @@ sexp sexp_make_ratio (sexp ctx, sexp num, sexp den) {
|
||||||
sexp sexp_ratio_normalize (sexp ctx, sexp rat, sexp in) {
|
sexp sexp_ratio_normalize (sexp ctx, sexp rat, sexp in) {
|
||||||
sexp tmp;
|
sexp tmp;
|
||||||
sexp_gc_var2(num, den);
|
sexp_gc_var2(num, den);
|
||||||
|
if (sexp_exact_negativep(sexp_ratio_denominator(rat))) {
|
||||||
|
/* Prevent overflow in the sexp_negate. */
|
||||||
|
if (sexp_ratio_numerator(rat) == sexp_make_fixnum(SEXP_MIN_FIXNUM))
|
||||||
|
sexp_ratio_numerator(rat) = sexp_fixnum_to_bignum(ctx, sexp_ratio_numerator(rat));
|
||||||
|
sexp_negate(sexp_ratio_numerator(rat));
|
||||||
|
sexp_negate(sexp_ratio_denominator(rat));
|
||||||
|
}
|
||||||
num = sexp_ratio_numerator(rat), den = sexp_ratio_denominator(rat);
|
num = sexp_ratio_numerator(rat), den = sexp_ratio_denominator(rat);
|
||||||
if (den == SEXP_ZERO)
|
if (den == SEXP_ZERO)
|
||||||
return sexp_read_error(ctx, "zero denominator in ratio", rat, in);
|
return sexp_read_error(ctx, "zero denominator in ratio", rat, in);
|
||||||
|
@ -2909,6 +2916,9 @@ sexp sexp_ratio_normalize (sexp ctx, sexp rat, sexp in) {
|
||||||
sexp_ratio_numerator(rat)
|
sexp_ratio_numerator(rat)
|
||||||
= sexp_quotient(ctx, sexp_ratio_numerator(rat), num);
|
= sexp_quotient(ctx, sexp_ratio_numerator(rat), num);
|
||||||
if (sexp_exact_negativep(sexp_ratio_denominator(rat))) {
|
if (sexp_exact_negativep(sexp_ratio_denominator(rat))) {
|
||||||
|
/* Prevent overflow in the sexp_negate. */
|
||||||
|
if (sexp_ratio_numerator(rat) == sexp_make_fixnum(SEXP_MIN_FIXNUM))
|
||||||
|
sexp_ratio_numerator(rat) = sexp_fixnum_to_bignum(ctx, sexp_ratio_numerator(rat));
|
||||||
sexp_negate(sexp_ratio_numerator(rat));
|
sexp_negate(sexp_ratio_numerator(rat));
|
||||||
sexp_negate(sexp_ratio_denominator(rat));
|
sexp_negate(sexp_ratio_denominator(rat));
|
||||||
}
|
}
|
||||||
|
|
15
vm.c
15
vm.c
|
@ -1869,7 +1869,12 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
||||||
if (sexp_flonum_value(_ARG1) == trunc(sexp_flonum_value(_ARG1)))
|
if (sexp_flonum_value(_ARG1) == trunc(sexp_flonum_value(_ARG1)))
|
||||||
_ARG1 = sexp_make_fixnum(sexp_flonum_value(_ARG1));
|
_ARG1 = sexp_make_fixnum(sexp_flonum_value(_ARG1));
|
||||||
#else
|
#else
|
||||||
_ARG1 = sexp_fx_div(tmp1, tmp2);
|
if (tmp1 == sexp_make_fixnum(SEXP_MIN_FIXNUM) && tmp2 == SEXP_NEG_ONE) {
|
||||||
|
_ARG1 = sexp_fixnum_to_bignum(ctx, tmp1);
|
||||||
|
sexp_negate_exact(_ARG1);
|
||||||
|
} else {
|
||||||
|
_ARG1 = sexp_fx_div(tmp1, tmp2);
|
||||||
|
}
|
||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
@ -1896,9 +1901,11 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
||||||
if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
|
if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) {
|
||||||
if (tmp2 == SEXP_ZERO)
|
if (tmp2 == SEXP_ZERO)
|
||||||
sexp_raise("divide by zero", SEXP_NULL);
|
sexp_raise("divide by zero", SEXP_NULL);
|
||||||
tmp = _ARG1 = sexp_fx_div(tmp1, tmp2);
|
if (tmp1 == sexp_make_fixnum(SEXP_MIN_FIXNUM) && tmp2 == SEXP_NEG_ONE) {
|
||||||
if ((sexp_sint_t)tmp1 < 0 && (sexp_sint_t)tmp2 < 0 && (sexp_sint_t)tmp < 0) {
|
_ARG1 = sexp_fixnum_to_bignum(ctx, tmp1);
|
||||||
_ARG1 = sexp_quotient(ctx, tmp1=sexp_fixnum_to_bignum(ctx, tmp1), tmp2);
|
sexp_negate_exact(_ARG1);
|
||||||
|
} else {
|
||||||
|
_ARG1 = sexp_fx_div(tmp1, tmp2);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
#if SEXP_USE_BIGNUMS
|
#if SEXP_USE_BIGNUMS
|
||||||
|
|
Loading…
Add table
Reference in a new issue