From 12728df36faa4a5afc67e41cb0719c781c657f26 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 23 Mar 2014 13:09:35 +0900
Subject: [PATCH] perform tear-off operation lazily

---
 include/picrin.h |  3 +++
 src/vm.c         | 41 +++++++++++++++++++++++++++++++----------
 2 files changed, 34 insertions(+), 10 deletions(-)

diff --git a/include/picrin.h b/include/picrin.h
index e2fa4212..b69141ac 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -51,6 +51,9 @@ typedef struct {
   pic_code *ip;
   pic_value *fp;
   struct pic_env *env;
+  int regc;
+  pic_value *regs;
+  struct pic_env *up;
 } pic_callinfo;
 
 typedef struct pic_block {
diff --git a/src/vm.c b/src/vm.c
index 1e6ed478..51e1787a 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -424,12 +424,25 @@ pic_defvar(pic_state *pic, const char *name, pic_value init)
   pic_define(pic, name, pic_obj_value(pic_wrap_var(pic, var)));
 }
 
+static void
+vm_push_env(pic_state *pic)
+{
+  pic_callinfo *ci = pic->ci;
+
+  ci->env = (struct pic_env *)pic_obj_alloc(pic, offsetof(struct pic_env, storage) + sizeof(pic_value) * ci->regc, PIC_TT_ENV);
+  ci->env->up = ci->up;
+  ci->env->regc = ci->regc;
+  ci->env->regs = ci->regs;
+}
+
 static void
 vm_tear_off(pic_state *pic)
 {
   struct pic_env *env;
   int i;
 
+  assert(pic->ci->env != NULL);
+
   env = pic->ci->env;
   for (i = 0; i < env->regc; ++i) {
     env->storage[i] = env->regs[i];
@@ -596,8 +609,8 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       int depth = c.u.r.depth;
       struct pic_env *env;
 
-      env = pic->ci->env;
-      while (depth--) {
+      env = pic->ci->up;
+      while (--depth) {
 	env = env->up;
       }
       PUSH(env->regs[c.u.r.idx]);
@@ -607,8 +620,8 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       int depth = c.u.r.depth;
       struct pic_env *env;
 
-      env = pic->ci->env;
-      while (depth--) {
+      env = pic->ci->up;
+      while (--depth) {
 	env = env->up;
       }
       env->regs[c.u.r.idx] = POP();
@@ -720,10 +733,9 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 	}
 
 	/* prepare env */
-        ci->env = (struct pic_env *)pic_obj_alloc(pic, offsetof(struct pic_env, storage) + sizeof(pic_value) * irep->capturec, PIC_TT_ENV);
-        ci->env->up = proc->env;
-        ci->env->regc = irep->capturec;
-        ci->env->regs = ci->fp + irep->argc + irep->localc;
+        ci->up = proc->env;
+        ci->regc = irep->capturec;
+        ci->regs = ci->fp + irep->argc + irep->localc;
 
 	pic->ip = irep->code;
 	pic_gc_arena_restore(pic, ai);
@@ -735,7 +747,9 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       pic_value *argv;
       pic_callinfo *ci;
 
-      vm_tear_off(pic);
+      if (pic->ci->env != NULL) {
+        vm_tear_off(pic);
+      }
 
       if (c.u.i == -1) {
         pic->sp += pic->ci[1].retc - 1;
@@ -765,7 +779,9 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 	goto L_STOP;
       }
 
-      vm_tear_off(pic);
+      if (pic->ci->env != NULL) {
+        vm_tear_off(pic);
+      }
 
       pic->ci->retc = c.u.i;
 
@@ -797,6 +813,11 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       if (! pic_proc_irep_p(pic_proc_ptr(self))) {
         pic_error(pic, "logic flaw");
       }
+
+      if (pic->ci->env == NULL) {
+        vm_push_env(pic);
+      }
+
       proc = pic_proc_new_irep(pic, irep->irep[c.u.i], pic->ci->env);
       PUSH(pic_obj_value(proc));
       pic_gc_arena_restore(pic, ai);