diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index 4357ebb57c..7021d6f45a 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -956,6 +956,8 @@ scheme_optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info) info = scheme_optimize_info_add_frame(info, data->num_params, data->num_params, SCHEME_LAMBDA_FRAME); + + /* For reporting warnings: */ if (info->context && SCHEME_PAIRP(info->context)) ctx = scheme_make_pair((Scheme_Object *)data, SCHEME_CDR(info->context)); diff --git a/src/mzscheme/src/numarith.c b/src/mzscheme/src/numarith.c index 3161b71041..15b1b3f189 100644 --- a/src/mzscheme/src/numarith.c +++ b/src/mzscheme/src/numarith.c @@ -249,10 +249,14 @@ static Scheme_Object *unary_minus(const Scheme_Object *n) return minus(1, a); } -GEN_BIN_OP(scheme_bin_plus, "+", ADD, F_ADD, FS_ADD, scheme_bignum_add, scheme_rational_add, scheme_complex_add, GEN_RETURN_N2, GEN_RETURN_N1, NO_NAN_CHECK, NO_NAN_CHECK) -GEN_BIN_OP(scheme_bin_minus, "-", SUBTRACT, F_SUBTRACT, FS_SUBTRACT, scheme_bignum_subtract, scheme_rational_subtract, scheme_complex_subtract, GEN_SINGLE_SUBTRACT_N2, GEN_RETURN_N1, NO_NAN_CHECK, NO_NAN_CHECK) -GEN_BIN_OP(scheme_bin_mult, "*", MULTIPLY, F_MULTIPLY, FS_MULTIPLY, scheme_bignum_multiply, scheme_rational_multiply, scheme_complex_multiply, GEN_RETURN_0, GEN_RETURN_0, NO_NAN_CHECK, NO_NAN_CHECK) -GEN_BIN_DIV_OP(scheme_bin_div, "/", DIVIDE, F_DIVIDE, FS_DIVIDE, scheme_make_rational, scheme_rational_divide, scheme_complex_divide) +#define ret_other(n1, n2) if (SAME_OBJ(n1, scheme_make_integer(0))) return (Scheme_Object *)n2 +#define ret_1other(n1, n2) if (SAME_OBJ(n1, scheme_make_integer(1))) return (Scheme_Object *)n2 +#define ret_zero(n1, n2) if (SAME_OBJ(n1, scheme_make_integer(0))) return scheme_make_integer(0) + +GEN_BIN_OP(scheme_bin_plus, "+", ADD, F_ADD, FS_ADD, scheme_bignum_add, scheme_rational_add, scheme_complex_add, GEN_RETURN_N2, GEN_RETURN_N1, NO_NAN_CHECK, NO_NAN_CHECK, ret_other, cx_NO_CHECK, ret_other, cx_NO_CHECK) +GEN_BIN_OP(scheme_bin_minus, "-", SUBTRACT, F_SUBTRACT, FS_SUBTRACT, scheme_bignum_subtract, scheme_rational_subtract, scheme_complex_subtract, GEN_SINGLE_SUBTRACT_N2, GEN_RETURN_N1, NO_NAN_CHECK, NO_NAN_CHECK, cx_NO_CHECK, cx_NO_CHECK, ret_other, cx_NO_CHECK) +GEN_BIN_OP(scheme_bin_mult, "*", MULTIPLY, F_MULTIPLY, FS_MULTIPLY, scheme_bignum_multiply, scheme_rational_multiply, scheme_complex_multiply, GEN_RETURN_0, GEN_RETURN_0, NO_NAN_CHECK, NO_NAN_CHECK, ret_zero, ret_1other, ret_zero, ret_1other) +GEN_BIN_DIV_OP(scheme_bin_div, "/", DIVIDE, F_DIVIDE, FS_DIVIDE, scheme_make_rational, scheme_rational_divide, scheme_complex_divide, ret_zero, cx_NO_CHECK, cx_NO_CHECK, ret_1other) GEN_NARY_OP(static, plus, "+", scheme_bin_plus, 0, SCHEME_NUMBERP, "number", GEN_IDENT) GEN_NARY_OP(static, mult, "*", scheme_bin_mult, 1, SCHEME_NUMBERP, "number", GEN_IDENT) diff --git a/src/mzscheme/src/number.c b/src/mzscheme/src/number.c index 1d94ed97d3..5e7972888b 100644 --- a/src/mzscheme/src/number.c +++ b/src/mzscheme/src/number.c @@ -1960,7 +1960,7 @@ GEN_BIN_PROT(bin_expt); scheme_real_to_complex(scheme_make_float(y))) \ : scheme_make_float(sch_pow((double)x, (double)y))) -static GEN_BIN_OP(bin_expt, "expt", fixnum_expt, F_EXPT, FS_EXPT, scheme_generic_integer_power, scheme_rational_power, scheme_complex_power, GEN_RETURN_0_USUALLY, GEN_RETURN_1, NAN_RETURNS_NAN, NAN_RETURNS_SNAN) +static GEN_BIN_OP(bin_expt, "expt", fixnum_expt, F_EXPT, FS_EXPT, scheme_generic_integer_power, scheme_rational_power, scheme_complex_power, GEN_RETURN_0_USUALLY, GEN_RETURN_1, NAN_RETURNS_NAN, NAN_RETURNS_SNAN, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK) Scheme_Object * scheme_expt(int argc, Scheme_Object *argv[]) diff --git a/src/mzscheme/src/numcomp.c b/src/mzscheme/src/numcomp.c index 2f9707643a..950a9fb09a 100644 --- a/src/mzscheme/src/numcomp.c +++ b/src/mzscheme/src/numcomp.c @@ -289,8 +289,8 @@ negative_p (int argc, Scheme_Object *argv[]) #define MAX_IZI(a, b) bin_max(IZI_REAL_PART(a), IZI_REAL_PART(b)) #define MIN_IZI(a, b) bin_min(IZI_REAL_PART(a), IZI_REAL_PART(b)) -static GEN_BIN_OP(bin_max, "max", MAX, F_MAX, FS_MAX, scheme_bignum_max, scheme_rational_max, MAX_IZI, GEN_OMIT, GEN_OMIT, NAN_RETURNS_NAN, NAN_RETURNS_SNAN) -static GEN_BIN_OP(bin_min, "min", MIN, F_MIN, FS_MIN, scheme_bignum_min, scheme_rational_min, MIN_IZI, GEN_OMIT, GEN_OMIT, NAN_RETURNS_NAN, NAN_RETURNS_SNAN) +static GEN_BIN_OP(bin_max, "max", MAX, F_MAX, FS_MAX, scheme_bignum_max, scheme_rational_max, MAX_IZI, GEN_OMIT, GEN_OMIT, NAN_RETURNS_NAN, NAN_RETURNS_SNAN, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK) +static GEN_BIN_OP(bin_min, "min", MIN, F_MIN, FS_MIN, scheme_bignum_min, scheme_rational_min, MIN_IZI, GEN_OMIT, GEN_OMIT, NAN_RETURNS_NAN, NAN_RETURNS_SNAN, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK) GEN_TWOARY_OP(static, sch_max, "max", bin_max, SCHEME_REALP, REAL_NUMBER_STR) GEN_TWOARY_OP(static, sch_min, "min", bin_min, SCHEME_REALP, REAL_NUMBER_STR) diff --git a/src/mzscheme/src/nummacs.h b/src/mzscheme/src/nummacs.h index 57883eccc5..0ddd4faeb8 100644 --- a/src/mzscheme/src/nummacs.h +++ b/src/mzscheme/src/nummacs.h @@ -97,6 +97,8 @@ name (int argc, Scheme_Object *argv[]) \ #define GEN_BIN_PROT(name) \ static Scheme_Object *name (const Scheme_Object *n1, const Scheme_Object *n2) +#define cx_NO_CHECK(n1, n2) /* empty */ + /* This macro is used to implement most all binary math and comparison functions (!): */ #define GEN_BIN_THING(rettype, name, scheme_name, \ iop, fop, fsop, bn_op, rop, cxop, \ @@ -106,7 +108,8 @@ static Scheme_Object *name (const Scheme_Object *n1, const Scheme_Object *n2) combinezero, firstzero, sfirstzero, secondzero, ssecondzero, \ nanchk, snanchk, nanchk_more, snanchk_more, \ complexwrap, noniziwrap, exactzerowrapl, exactzerowrapr, numbertype,\ - toi_or_toe) \ + toi_or_toe, \ + check_exact_zero1, check_exact_one1, check_exact_zero2, check_exact_one2) \ rettype name (const Scheme_Object *n1, const Scheme_Object *n2); \ static rettype name ## __wrong_type(const Scheme_Object *v) \ { \ @@ -117,12 +120,16 @@ static rettype name ## __wrong_type(const Scheme_Object *v) \ } \ static MZ_INLINE rettype name ## __int_big(const Scheme_Object *n1, const Scheme_Object *n2) { \ Small_Bignum sb; \ + check_exact_zero1(n1, n2); \ + check_exact_one1(n1, n2); \ return bn_op((scheme_make_small_bignum(SCHEME_INT_VAL(n1), \ &sb)), \ (n2)); \ } \ static MZ_INLINE rettype name ## __int_rat(const Scheme_Object *n1, const Scheme_Object *n2) { \ Small_Rational sr1; \ + check_exact_zero1(n1, n2); \ + check_exact_one1(n1, n2); \ return rop((scheme_make_small_rational(SCHEME_INT_VAL(n1), \ &sr1)), \ (n2)); \ @@ -130,6 +137,8 @@ static MZ_INLINE rettype name ## __int_rat(const Scheme_Object *n1, const Scheme complexwrap( \ static MZ_INLINE rettype name ## __int_comp(const Scheme_Object *n1, const Scheme_Object *n2) { \ Small_Complex sc; \ + check_exact_zero1(n1, n2); \ + check_exact_one1(n1, n2); \ return cxop((scheme_make_small_complex(n1, &sc)), \ (n2)); \ }) \ @@ -185,6 +194,8 @@ static MZ_INLINE rettype name ## __dbl_comp(double d1, const Scheme_Object *n1, }) \ static MZ_INLINE rettype name ## __big_int(const Scheme_Object *n1, const Scheme_Object *n2) { \ Small_Bignum sb; \ + check_exact_zero2(n2, n1); \ + check_exact_one2(n2, n1); \ return bn_op((n1), (scheme_make_small_bignum(SCHEME_INT_VAL(n2), &sb))); \ } \ FLOATWRAP( \ @@ -217,6 +228,8 @@ static MZ_INLINE rettype name ## __big_comp(const Scheme_Object *n1, const Schem } \ static MZ_INLINE rettype name ## __rat_int(const Scheme_Object *n1, const Scheme_Object *n2) { \ Small_Rational sr8; \ + check_exact_zero2(n2, n1); \ + check_exact_one2(n2, n1); \ return rop((n1), \ (scheme_make_small_rational(SCHEME_INT_VAL(n2), \ &sr8))); \ @@ -255,6 +268,8 @@ static MZ_INLINE rettype name ## __rat_comp(const Scheme_Object *n1, const Schem complexwrap( \ static MZ_INLINE rettype name ## __comp_int(const Scheme_Object *n1, const Scheme_Object *n2) { \ Small_Complex sc; \ + check_exact_zero2(n2, n1); \ + check_exact_one2(n2, n1); \ return cxop((n1), (scheme_make_small_complex(n2, &sc))); \ }) \ FLOATWRAP(complexwrap( \ @@ -517,7 +532,7 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \ # define NAN_CHECK_0(x) if (MZ_IS_NAN(x)) return 0 -#define GEN_BIN_OP(name, scheme_name, iop, fop, fsop, bn_op, rop, cxop, exzeopl, exzeopr, nanckop, snanckop) \ +#define GEN_BIN_OP(name, scheme_name, iop, fop, fsop, bn_op, rop, cxop, exzeopl, exzeopr, nanckop, snanckop, c0_1, c1_1, c0_2, c1_2) \ GEN_BIN_THING(Scheme_Object *, name, scheme_name, \ iop, fop, fsop, bn_op, rop, cxop, \ GEN_OMIT, GEN_FIRST_ONLY, \ @@ -525,9 +540,10 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \ 0, 0, 0, 0, \ GEN_SCHEME_BOOL_APPLY, badfunc, badfunc, badfunc, badfunc, \ nanckop, snanckop, nanckop, snanckop, \ - GEN_IDENT, GEN_IDENT, exzeopl, exzeopr, "number", GEN_TOI) + GEN_IDENT, GEN_IDENT, exzeopl, exzeopr, "number", GEN_TOI, \ + c0_1, c1_1, c0_2, c1_2) -#define GEN_BIN_DIV_OP(name, scheme_name, iop, fop, fsop, bn_op, rop, cxop) \ +#define GEN_BIN_DIV_OP(name, scheme_name, iop, fop, fsop, bn_op, rop, cxop, c0_1, c1_1, c0_2, c1_2) \ GEN_BIN_THING(Scheme_Object *, name, scheme_name, \ iop, fop, fsop, bn_op, rop, cxop, \ GEN_IDENT, GEN_APPLY, \ @@ -535,7 +551,8 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \ GEN_MAKE_NZERO, GEN_MAKE_NSZERO, GEN_MAKE_PZERO, GEN_MAKE_PSZERO, \ GEN_APPLY3, GEN_MAKE_ZERO_Z, GEN_MAKE_SZERO_Z, GEN_SAME_INF_Z, GEN_SAME_SINF_Z, \ NAN_CHECK_NAN_IF_WEIRD, SNAN_CHECK_NAN_IF_WEIRD, NAN_CHECK_NAN_IF_WEIRD, SNAN_CHECK_NAN_IF_WEIRD, \ - GEN_IDENT, GEN_IDENT, GEN_RETURN_0, GEN_OMIT, "number", GEN_TOI) + GEN_IDENT, GEN_IDENT, GEN_RETURN_0, GEN_OMIT, "number", GEN_TOI, \ + c0_1, c1_1, c0_2, c1_2) #define GEN_BIN_COMP(name, scheme_name, iop, fop, bn_op, rop, cxop, waybig, waysmall, firstzero, secondzero, complexwrap, noniziwrap, numbertype) \ GEN_BIN_THING(int, name, scheme_name, \ @@ -545,7 +562,8 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \ waybig, waybig, waysmall, waysmall, \ GEN_SCHEME_BOOL_APPLY, firstzero, firstzero, secondzero, secondzero, \ NAN_CHECK_0_IF_WEIRD, NAN_CHECK_0_IF_WEIRD, NAN_CHECK_0, NAN_CHECK_0, \ - complexwrap, noniziwrap, GEN_OMIT, GEN_OMIT, numbertype, GEN_TOE) + complexwrap, noniziwrap, GEN_OMIT, GEN_OMIT, numbertype, GEN_TOE, \ + cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK) #define GEN_BIN_INT_OP(name, scheme_name, op, bigop) \ static Scheme_Object *name (const Scheme_Object *n1, const Scheme_Object *n2); \ diff --git a/src/mzscheme/src/read.c b/src/mzscheme/src/read.c index d932e4216d..c1778abaf5 100644 --- a/src/mzscheme/src/read.c +++ b/src/mzscheme/src/read.c @@ -5532,15 +5532,15 @@ Scheme_Object *scheme_load_delayed_code(int _which, Scheme_Load_Delay *_delay_in scheme_end_atomic_no_swap(); if (v) { - delay_info->symtab[which] = v; - if (*ht) { v = resolve_references(v, port, NULL, scheme_make_hash_table(SCHEME_hash_ptr), scheme_make_hash_table(SCHEME_hash_ptr), 0, 0); } - + + delay_info->symtab[which] = v; + return v; } else { scheme_longjmp(*scheme_current_thread->error_buf, 1); diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index 0f8b0fde21..5c0a6a094c 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -3321,7 +3321,7 @@ static int is_closed_reference(Scheme_Object *v) { /* Look for a converted function (possibly with no new arguments) that is accessed directly as a closure, instead of through a - top-level reference. */ + top-level reference. */ if (SCHEME_RPAIRP(v)) { v = SCHEME_CAR(v); return SCHEME_PROCP(v);