diff --git a/extlib/xfile b/extlib/xfile index 8cb37986..70abe4ff 160000 --- a/extlib/xfile +++ b/extlib/xfile @@ -1 +1 @@ -Subproject commit 8cb37986f940d4207477ab3710ce1c172cf499d0 +Subproject commit 70abe4ffd48e60b2a7fdeb54ad1a793bc786b27b diff --git a/src/codegen.c b/src/codegen.c index 14bb906f..588b4f56 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -92,7 +92,7 @@ typedef struct analyze_state { pic_sym rCONS, rCAR, rCDR, rNILP; pic_sym rADD, rSUB, rMUL, rDIV; pic_sym rEQ, rLT, rLE, rGT, rGE, rNOT; - pic_sym sCALL, sTAILCALL, sREF; + pic_sym sCALL, sTAILCALL, sREF, sRETURN; } analyze_state; static void push_scope(analyze_state *, pic_value); @@ -142,6 +142,7 @@ new_analyze_state(pic_state *pic) register_symbol(pic, state, sCALL, "call"); register_symbol(pic, state, sTAILCALL, "tail-call"); register_symbol(pic, state, sREF, "ref"); + register_symbol(pic, state, sRETURN, "return"); /* push initial scope */ push_scope(state, pic_nil_value()); @@ -254,13 +255,25 @@ static pic_value analyze_lambda(analyze_state *, pic_value); static pic_value analyze(analyze_state *state, pic_value obj, bool tailpos) { - int ai = pic_gc_arena_preserve(state->pic); + pic_state *pic = state->pic; + int ai = pic_gc_arena_preserve(pic); pic_value res; + pic_sym tag; res = analyze_node(state, obj, tailpos); - pic_gc_arena_restore(state->pic, ai); - pic_gc_protect(state->pic, res); + tag = pic_sym(pic_car(pic, res)); + if (tailpos) { + if (tag == pic->sIF || tag == pic->sBEGIN || tag == state->sTAILCALL || tag == state->sRETURN) { + /* pass through */ + } + else { + res = pic_list(pic, 2, pic_symbol_value(state->sRETURN), res); + } + } + + pic_gc_arena_restore(pic, ai); + pic_gc_protect(pic, res); return res; } @@ -646,7 +659,7 @@ pic_analyze(pic_state *pic, pic_value obj) state = new_analyze_state(pic); - obj = analyze(state, obj, false); + obj = analyze(state, obj, true); destroy_analyze_state(state); return obj; @@ -925,7 +938,7 @@ typedef struct codegen_state { pic_state *pic; codegen_context *cxt; pic_sym sGREF, sCREF, sLREF; - pic_sym sCALL, sTAILCALL; + pic_sym sCALL, sTAILCALL, sRETURN; unsigned *cv_tbl, cv_num; } codegen_state; @@ -946,6 +959,7 @@ new_codegen_state(pic_state *pic) register_symbol(pic, state, sGREF, "gref"); register_symbol(pic, state, sLREF, "lref"); register_symbol(pic, state, sCREF, "cref"); + register_symbol(pic, state, sRETURN, "return"); push_codegen_context(state, pic_nil_value(), pic_nil_value(), false, pic_nil_value()); @@ -1297,6 +1311,12 @@ codegen(codegen_state *state, pic_value obj) cxt->clen++; return; } + else if (sym == state->sRETURN) { + codegen(state, pic_list_ref(pic, obj, 1)); + cxt->code[cxt->clen].insn = OP_RET; + cxt->clen++; + return; + } pic_error(pic, "codegen: unknown AST type"); } @@ -1318,8 +1338,6 @@ codegen_lambda(codegen_state *state, pic_value obj) { /* body */ codegen(state, body); - state->cxt->code[state->cxt->clen].insn = OP_RET; - state->cxt->clen++; } return pop_codegen_context(state); } @@ -1332,34 +1350,20 @@ pic_codegen(pic_state *pic, pic_value obj) state = new_codegen_state(pic); codegen(state, obj); - state->cxt->code[state->cxt->clen].insn = OP_RET; - state->cxt->clen++; return destroy_codegen_state(state); } -struct pic_proc * -pic_compile(pic_state *pic, pic_value obj) +static struct pic_irep * +compile(pic_state *pic, pic_value obj) { - struct pic_proc *proc; struct pic_irep *irep; - jmp_buf jmp, *prev_jmp = pic->jmp; int ai = pic_gc_arena_preserve(pic); - - if (setjmp(jmp) == 0) { - pic->jmp = &jmp; - } - else { - /* error occured */ - proc = NULL; - goto exit; - } - #if DEBUG fprintf(stderr, "ai = %d\n", pic_gc_arena_preserve(pic)); - fprintf(stderr, "## input expression\n"); + fprintf(stderr, "# input expression\n"); pic_debug(pic, obj); fprintf(stderr, "\n"); @@ -1398,23 +1402,39 @@ pic_compile(pic_state *pic, pic_value obj) #if DEBUG fprintf(stderr, "## codegen completed\n"); pic_dump_irep(pic, irep); +#endif - fprintf(stderr, "## compilation finished\n"); +#if DEBUG + fprintf(stderr, "# compilation finished\n"); puts(""); #endif - proc = pic_proc_new_irep(pic, irep, NULL); + pic_gc_arena_restore(pic, ai); + pic_gc_protect(pic, pic_obj_value(irep)); -#if VM_DEBUG - pic_dump_irep(pic, proc->u.irep); -#endif + return irep; +} + +struct pic_proc * +pic_compile(pic_state *pic, pic_value obj) +{ + struct pic_proc *proc; + jmp_buf jmp, *prev_jmp = pic->jmp; + + if (setjmp(jmp) == 0) { + pic->jmp = &jmp; + } + else { + /* error occured */ + proc = NULL; + goto exit; + } + + proc = pic_proc_new_irep(pic, compile(pic, obj), NULL); exit: pic->jmp = prev_jmp; - pic_gc_arena_restore(pic, ai); - pic_gc_protect(pic, pic_obj_value(proc)); - return proc; } diff --git a/src/vm.c b/src/vm.c index d9cd024b..862f5825 100644 --- a/src/vm.c +++ b/src/vm.c @@ -411,21 +411,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) argc = pic_length(pic, argv) + 1; #if VM_DEBUG - puts("== booting VM..."); - printf(" proc = "); - pic_debug(pic, pic_obj_value(proc)); - puts(""); - printf(" argv = "); - pic_debug(pic, argv); - puts(""); - if (! proc->cfunc_p) { - printf(" irep = "); - pic_dump_irep(pic, proc->u.irep); - } - else { - printf(" cfunc = %p\n", (void *)proc->u.cfunc); - } - puts("\nLet's go!"); + puts("### booting VM... ###"); #endif PUSH(pic_obj_value(proc)); @@ -439,8 +425,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) boot[0].u.i = argc; boot[1].insn = OP_STOP; pic->ip = boot; - c = *pic->ip; - goto L_CALL; VM_LOOP { CASE(OP_NOP) { @@ -561,13 +545,17 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) proc = pic_proc_ptr(x); #if VM_DEBUG - puts("== calling proc..."); + puts("\n== calling proc..."); printf(" proc = "); pic_debug(pic, pic_obj_value(proc)); puts(""); - printf(" argv = "); - pic_debug(pic, argv); - puts(""); + printf(" argv = ("); + for (short i = 1; i < c.u.i; ++i) { + if (i > 1) + printf(" "); + pic_debug(pic, pic->sp[-c.u.i + i]); + } + puts(")"); if (! proc->cfunc_p) { printf(" irep = "); pic_dump_irep(pic, proc->u.irep); @@ -575,7 +563,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) else { printf(" cfunc = %p\n", (void *)proc->u.cfunc); } - puts(""); + puts("== end\n"); #endif ci = PUSHCI();