mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-21 22:59:16 +02:00
Removing SEXP_OP_NEGATIVE and SEXP_OP_INVERSE - these are compiled
directly by generate_opcode_app now. Zero arity cases now supported: (-) => 0, (/) => 1, equivalent to the zero arity + and * cases.
This commit is contained in:
Alex Shinn
parent
e999b1a77a
commit
325007d2b9
3 changed files with 26 additions and 51 deletions
66
eval.c
66
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<top; i++) {
|
||||
sexp_printf(ctx, out, "%s %02d: ", ((i==fp) ? "*" : " "), i);
|
||||
sexp_write(ctx, stack[i], out);
|
||||
|
|
@ -914,7 +914,7 @@ static void generate_set (sexp ctx, sexp set) {
|
|||
|
||||
static void generate_opcode_app (sexp ctx, sexp app) {
|
||||
sexp op = sexp_car(app);
|
||||
sexp_sint_t i, num_args;
|
||||
sexp_sint_t i, num_args, inv_default=0;
|
||||
sexp_gc_var1(ls);
|
||||
sexp_gc_preserve1(ctx, ls);
|
||||
|
||||
|
|
@ -926,29 +926,38 @@ static void generate_opcode_app (sexp ctx, sexp app) {
|
|||
&& sexp_opcode_variadic_p(op)
|
||||
&& sexp_opcode_data(op)
|
||||
&& (sexp_opcode_class(op) != SEXP_OPC_PARAMETER)) {
|
||||
emit_push(ctx, sexp_opcode_data(op));
|
||||
if (sexp_opcode_opt_param_p(op))
|
||||
emit(ctx, SEXP_OP_CDR);
|
||||
sexp_context_depth(ctx)++;
|
||||
num_args++;
|
||||
if (sexp_opcode_inverse(op)) {
|
||||
inv_default = 1;
|
||||
} else {
|
||||
emit_push(ctx, sexp_opcode_data(op));
|
||||
if (sexp_opcode_opt_param_p(op)) emit(ctx, SEXP_OP_CDR);
|
||||
sexp_context_depth(ctx)++;
|
||||
num_args++;
|
||||
}
|
||||
}
|
||||
|
||||
/* push the arguments onto the stack in reverse order */
|
||||
ls = ((sexp_opcode_inverse(op)
|
||||
&& (sexp_opcode_class(op) != SEXP_OPC_ARITHMETIC_INV))
|
||||
&& (sexp_opcode_class(op) != SEXP_OPC_ARITHMETIC))
|
||||
? sexp_cdr(app) : sexp_reverse(ctx, sexp_cdr(app)));
|
||||
for ( ; sexp_pairp(ls); ls = sexp_cdr(ls))
|
||||
generate(ctx, sexp_car(ls));
|
||||
|
||||
/* push the default for inverse opcodes */
|
||||
if (inv_default) {
|
||||
emit_push(ctx, sexp_opcode_data(op));
|
||||
if (sexp_opcode_opt_param_p(op)) emit(ctx, SEXP_OP_CDR);
|
||||
sexp_context_depth(ctx)++;
|
||||
num_args++;
|
||||
}
|
||||
|
||||
/* emit the actual operator call */
|
||||
switch (sexp_opcode_class(op)) {
|
||||
case SEXP_OPC_ARITHMETIC:
|
||||
if (num_args > 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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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),
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue