diff --git a/eval.c b/eval.c index 180ffb5b..add0196e 100644 --- a/eval.c +++ b/eval.c @@ -1373,7 +1373,6 @@ sexp sexp_make_opcode (sexp ctx, sexp self, sexp name, sexp op_class, sexp code, sexp num_args, sexp flags, sexp arg1t, sexp arg2t, sexp invp, sexp data, sexp data2, sexp_proc1 func) { sexp res; - sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, name); sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, num_args); sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, flags); if ((! sexp_fixnump(op_class)) || (sexp_unbox_fixnum(op_class) <= 0) @@ -1394,7 +1393,7 @@ sexp sexp_make_opcode (sexp ctx, sexp self, sexp name, sexp op_class, sexp code, sexp_opcode_data(res) = data; sexp_opcode_data2(res) = data2; sexp_opcode_func(res) = func; - sexp_opcode_name(res) = strdup(sexp_string_data(name)); + sexp_opcode_name(res) = sexp_stringp(name) ? strdup(sexp_string_data(name)) : ""; } return res; } diff --git a/main.c b/main.c index b613c262..eaae6876 100644 --- a/main.c +++ b/main.c @@ -33,8 +33,6 @@ static void repl (sexp ctx) { sexp_gc_preserve4(ctx, obj, tmp, res, env); env = sexp_make_env(ctx); sexp_env_parent(env) = sexp_context_env(ctx); - sexp_env_define(ctx, sexp_context_env(ctx), - sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), env); sexp_context_tracep(ctx) = 1; in = sexp_param_ref(ctx, env, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL)); out = sexp_param_ref(ctx, env, sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL)); diff --git a/vm.c b/vm.c index 4d272bbc..27f5916d 100644 --- a/vm.c +++ b/vm.c @@ -197,34 +197,36 @@ static void generate_opcode_app (sexp ctx, sexp app) { num_args = sexp_unbox_fixnum(sexp_length(ctx, sexp_cdr(app))); sexp_context_tailp(ctx) = 0; - /* maybe push the default for an optional argument */ - if ((num_args == sexp_opcode_num_args(op)) - && sexp_opcode_variadic_p(op) - && sexp_opcode_data(op) - && (sexp_opcode_class(op) != SEXP_OPC_PARAMETER)) { - if (sexp_opcode_inverse(op)) { - inv_default = 1; - } else { - emit_push(ctx, sexp_opcode_data(op)); - if (sexp_opcode_opt_param_p(op)) { -#if SEXP_USE_GREEN_THREADS - emit(ctx, SEXP_OP_PARAMETER_REF); - emit_word(ctx, (sexp_uint_t)sexp_opcode_data(op)); - sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), sexp_opcode_data(op)); -#endif - emit(ctx, SEXP_OP_CDR); - } - sexp_context_depth(ctx)++; - num_args++; - } - } + if (sexp_opcode_class(op) != SEXP_OPC_PARAMETER) { - /* push the arguments onto the stack in reverse order */ - ls = ((sexp_opcode_inverse(op) - && (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)); + /* maybe push the default for an optional argument */ + if ((num_args == sexp_opcode_num_args(op)) + && sexp_opcode_variadic_p(op) && sexp_opcode_data(op)) { + if (sexp_opcode_inverse(op)) { + inv_default = 1; + } else { + emit_push(ctx, sexp_opcode_data(op)); + if (sexp_opcode_opt_param_p(op)) { +#if SEXP_USE_GREEN_THREADS + emit(ctx, SEXP_OP_PARAMETER_REF); + emit_word(ctx, (sexp_uint_t)sexp_opcode_data(op)); + sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), sexp_opcode_data(op)); +#endif + 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)) + ? 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) { @@ -280,10 +282,19 @@ static void generate_opcode_app (sexp ctx, sexp app) { break; case SEXP_OPC_PARAMETER: #if SEXP_USE_GREEN_THREADS + if (num_args > 0) { + if (sexp_opcode_data2(op) && sexp_applicablep(sexp_opcode_data2(op))) { + ls = sexp_list2(ctx, sexp_opcode_data2(op), sexp_cadr(app)); + generate(ctx, ls); + } else { + generate(ctx, sexp_cadr(app)); + } + } emit(ctx, SEXP_OP_PARAMETER_REF); emit_word(ctx, (sexp_uint_t)op); sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), op); #else + if (num_args > 0) generate(ctx, sexp_cadr(app)); emit_push(ctx, sexp_opcode_data(op)); #endif emit(ctx, ((num_args == 0) ? SEXP_OP_CDR : SEXP_OP_SET_CDR)); @@ -801,7 +812,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { tmp2 = _WORD0; ip += sizeof(sexp); for (tmp1=sexp_context_params(ctx); sexp_pairp(tmp1); tmp1=sexp_cdr(tmp1)) - if (sexp_car(tmp1) == tmp2) { + if (sexp_caar(tmp1) == tmp2) { _PUSH(sexp_car(tmp1)); goto loop; }