From 4fa2bad5fafc5719fcb403a4330525169d1c4ea2 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 28 Oct 2013 17:45:13 +0900
Subject: [PATCH] add pic_apply function (and remove pic_run)

---
 include/picrin.h |  3 ++-
 src/codegen.c    | 14 +++++++++++++-
 src/init.c       |  3 ++-
 src/vm.c         | 26 +++++++++++++++++---------
 tools/main.c     |  2 +-
 5 files changed, 35 insertions(+), 13 deletions(-)

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;