diff --git a/include/picrin.h b/include/picrin.h index 9da11089..832a0a83 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -80,7 +80,8 @@ pic_value pic_str_new_cstr(pic_state *, const char *); bool pic_parse_file(pic_state *, FILE *file, pic_value *); bool pic_parse_cstr(pic_state *, const char *, pic_value *); -pic_value pic_run(pic_state *, struct pic_proc *, pic_value); +pic_value pic_apply(pic_state *pic, struct pic_proc *, pic_value); +pic_value pic_apply_argv(pic_state *pic, struct pic_proc *, size_t, ...); struct pic_proc *pic_codegen(pic_state *, pic_value); void pic_abort(pic_state *, const char *); diff --git a/src/codegen.c b/src/codegen.c index cf2904a6..7a3567ff 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -619,6 +619,8 @@ pic_codegen(pic_state *pic, pic_value obj) { struct pic_proc *proc; codegen_state *state; + struct pic_env *env; + int i; state = new_codegen_state(pic); @@ -635,10 +637,20 @@ pic_codegen(pic_state *pic, pic_value obj) } } state->irep = new_irep(pic); + state->irep->argc = 1; codegen(state, obj); state->irep->code[state->irep->clen].insn = OP_STOP; state->irep->clen++; - proc = pic_proc_new(pic, state->irep, NULL); + + env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); + env->num_val = state->irep->argc; + env->values = (pic_value *)pic_alloc(pic, sizeof(pic_value) * env->num_val); + for (i = 0; i < env->num_val; ++i) { + env->values[i] = pic_undef_value(); + } + env->up = NULL; + + proc = pic_proc_new(pic, state->irep, env); destroy_codegen_state(pic, state); diff --git a/src/init.c b/src/init.c index 7db3fbd7..e2e44177 100644 --- a/src/init.c +++ b/src/init.c @@ -38,8 +38,9 @@ pic_load_stdlib(pic_state *pic) abort(); } - v = pic_run(pic, proc, pic_nil_value()); + v = pic_apply(pic, proc, pic_nil_value()); if (pic_undef_p(v)) { + fputs(pic->errmsg, stderr); fputs("fatal error: built-in.scm evaluation failure", stderr); abort(); } diff --git a/src/vm.c b/src/vm.c index 9ba037b8..e2c5e3b0 100644 --- a/src/vm.c +++ b/src/vm.c @@ -178,11 +178,13 @@ pic_get_args(pic_state *pic, const char *format, ...) #define POPCI() (pic->ci--) pic_value -pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) +pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) { struct pic_code *pc; int ai = pic_gc_arena_preserve(pic); jmp_buf jmp; + size_t argc, i; + struct pic_code boot; #if PIC_DIRECT_THREADED_VM static void *oplabels[] = { @@ -195,8 +197,6 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) }; #endif - pc = proc->u.irep->code; - if (setjmp(jmp) == 0) { pic->jmp = &jmp; } @@ -204,12 +204,19 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) goto L_RAISE; } - /* adjust call frame */ - pic->sp[0] = pic_obj_value(proc); - pic->ci->argc = 1; - pic->ci->pc = NULL; - pic->ci->fp = pic->sp; - pic->sp++; + argc = pic_length(pic, argv) + 1; + + PUSH(pic_obj_value(proc)); + for (i = 1; i < argc; ++i) { + PUSH(pic_car(pic, argv)); + argv = pic_cdr(pic, argv); + } + + /* boot! */ + boot.insn = OP_CALL; + boot.u.i = argc; + pc = &boot; + goto L_CALL; VM_LOOP { CASE(OP_POP) { @@ -297,6 +304,7 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) pic_callinfo *ci; struct pic_proc *proc; + L_CALL: c = pic->sp[-pc->u.i]; if (! pic_proc_p(c)) { pic->errmsg = "invalid application"; diff --git a/tools/main.c b/tools/main.c index fac9c432..68469855 100644 --- a/tools/main.c +++ b/tools/main.c @@ -117,7 +117,7 @@ main(int argc, char *argv[], char **envp) pic->errmsg = NULL; goto next; } - v = pic_run(pic, proc, pic_nil_value()); + v = pic_apply(pic, proc, pic_nil_value()); if (pic_undef_p(v)) { printf("runtime error: %s\n", pic->errmsg); pic->errmsg = NULL;