diff --git a/eval.c b/eval.c index 66ab8649..d2360568 100644 --- a/eval.c +++ b/eval.c @@ -11,7 +11,7 @@ static int scheme_initialized_p = 0; #if SEXP_USE_DEBUG_VM static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out) { int i; - if (! sexp_oport(out)) out = sexp_current_error_port(ctx); + if (! sexp_oportp(out)) out = sexp_current_error_port(ctx); for (i=0; i 1) + /* fold variadic arithmetic operators */ + for (i=num_args-1; i>0; i--) emit(ctx, sexp_opcode_code(op)); break; - case SEXP_OPC_ARITHMETIC_INV: - emit(ctx, (num_args==1) ? sexp_opcode_inverse(op) : sexp_opcode_code(op)); - break; case SEXP_OPC_ARITHMETIC_CMP: if (num_args > 2) { emit(ctx, SEXP_OP_STACK_REF); @@ -993,13 +1002,6 @@ static void generate_opcode_app (sexp ctx, sexp app) { emit(ctx, sexp_opcode_code(op)); } - /* emit optional folding of operator */ - if ((num_args > 2) - && (sexp_opcode_class(op) == SEXP_OPC_ARITHMETIC - || sexp_opcode_class(op) == SEXP_OPC_ARITHMETIC_INV)) - for (i=num_args-2; i>0; i--) - emit(ctx, sexp_opcode_code(op)); - sexp_context_depth(ctx) -= (num_args-1); sexp_gc_release1(ctx); } @@ -1815,30 +1817,6 @@ sexp sexp_vm (sexp ctx, sexp proc) { else sexp_raise("remainder: not an integer", sexp_list2(ctx, _ARG1, _ARG2)); #endif break; - case SEXP_OP_NEGATIVE: - if (sexp_fixnump(_ARG1)) - _ARG1 = sexp_make_fixnum(-sexp_unbox_fixnum(_ARG1)); -#if SEXP_USE_BIGNUMS - else if (sexp_bignump(_ARG1)) { - _ARG1 = sexp_copy_bignum(ctx, NULL, _ARG1, 0); - sexp_bignum_sign(_ARG1) = -sexp_bignum_sign(_ARG1); - } -#endif -#if SEXP_USE_FLONUMS - else if (sexp_flonump(_ARG1)) - _ARG1 = sexp_make_flonum(ctx, -sexp_flonum_value(_ARG1)); -#endif - else sexp_raise("-: not a number", sexp_list1(ctx, _ARG1)); - break; - case SEXP_OP_INVERSE: - if (sexp_fixnump(_ARG1)) - _ARG1 = sexp_make_flonum(ctx, 1/(double)sexp_unbox_fixnum(_ARG1)); -#if SEXP_USE_FLONUMS - else if (sexp_flonump(_ARG1)) - _ARG1 = sexp_make_flonum(ctx, 1/sexp_flonum_value(_ARG1)); -#endif - else sexp_raise("/: not a number", sexp_list1(ctx, _ARG1)); - break; case SEXP_OP_LT: if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) { i = (sexp_sint_t)_ARG1 < (sexp_sint_t)_ARG2; @@ -2686,7 +2664,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) { stack[top++] = SEXP_ZERO; sexp_context_top(ctx) = top; res = sexp_vm(ctx, proc); - if (! res) res = SEXP_VOID; + if (! res) res = SEXP_VOID; /* shouldn't happen */ } return res; } diff --git a/include/chibi/eval.h b/include/chibi/eval.h index 22b82f7f..2337feb4 100644 --- a/include/chibi/eval.h +++ b/include/chibi/eval.h @@ -37,7 +37,6 @@ enum sexp_opcode_classes { SEXP_OPC_TYPE_PREDICATE, SEXP_OPC_PREDICATE, SEXP_OPC_ARITHMETIC, - SEXP_OPC_ARITHMETIC_INV, SEXP_OPC_ARITHMETIC_CMP, SEXP_OPC_IO, SEXP_OPC_CONSTRUCTOR, @@ -102,8 +101,6 @@ enum sexp_opcode_names { SEXP_OP_DIV, SEXP_OP_QUOTIENT, SEXP_OP_REMAINDER, - SEXP_OP_NEGATIVE, - SEXP_OP_INVERSE, SEXP_OP_LT, SEXP_OP_LE, SEXP_OP_EQN, diff --git a/opcodes.c b/opcodes.c index 85a35afc..e3837e42 100644 --- a/opcodes.c +++ b/opcodes.c @@ -33,10 +33,10 @@ _OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR2INT, 1, 0, SEXP_CHAR, 0, 0, "char->integer", _OP(SEXP_OPC_GENERIC, SEXP_OP_INT2CHAR, 1, 0, SEXP_FIXNUM, 0, 0, "integer->char", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR_UPCASE, 1, 0, SEXP_CHAR, 0, 0, "char-upcase", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR_DOWNCASE, 1, 0, SEXP_CHAR, 0, 0, "char-downcase", 0, NULL), -_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", sexp_make_fixnum(0), NULL), -_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", sexp_make_fixnum(1), NULL), -_OP(SEXP_OPC_ARITHMETIC_INV, SEXP_OP_SUB, 0, 1, SEXP_FIXNUM, 0, SEXP_OP_NEGATIVE, "-", 0, NULL), -_OP(SEXP_OPC_ARITHMETIC_INV, SEXP_OP_DIV, 0, 1, SEXP_FIXNUM, 0, SEXP_OP_INVERSE, "/", 0, NULL), +_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", SEXP_ZERO, NULL), +_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", SEXP_ONE, NULL), +_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_SUB, 0, 1, SEXP_FIXNUM, 0, 1, "-", SEXP_ZERO, NULL), +_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_DIV, 0, 1, SEXP_FIXNUM, 0, 1, "/", SEXP_ONE, NULL), _OP(SEXP_OPC_ARITHMETIC, SEXP_OP_QUOTIENT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", 0, NULL), _OP(SEXP_OPC_ARITHMETIC, SEXP_OP_REMAINDER, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "remainder", 0, NULL), _OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LT, 2, 1, SEXP_FIXNUM, 0, 0, "<", 0, NULL),