From b3e9794385d0699f4b4c14303040bb40ba89542b Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 23 Feb 2016 22:42:03 +0900
Subject: [PATCH] remove pic->xp

---
 contrib/10.callcc/callcc.c                  |  21 ---
 extlib/benz/cont.c                          |   5 -
 extlib/benz/error.c                         | 167 ++++++++++++--------
 extlib/benz/gc.c                            |   6 -
 extlib/benz/include/picrin/extra.h          |  17 +-
 extlib/benz/include/picrin/private/object.h |   5 +
 extlib/benz/include/picrin/private/state.h  |   3 -
 extlib/benz/state.c                         |  12 --
 8 files changed, 113 insertions(+), 123 deletions(-)

diff --git a/contrib/10.callcc/callcc.c b/contrib/10.callcc/callcc.c
index 3cba0975..0afe3d7e 100644
--- a/contrib/10.callcc/callcc.c
+++ b/contrib/10.callcc/callcc.c
@@ -20,10 +20,6 @@ struct fullcont {
   size_t ci_offset;
   ptrdiff_t ci_len;
 
-  struct proc **xp_ptr;
-  size_t xp_offset;
-  ptrdiff_t xp_len;
-
   struct code *ip;
 
   struct object **arena;
@@ -41,7 +37,6 @@ cont_dtor(pic_state *pic, void *data)
   pic_free(pic, cont->stk_ptr);
   pic_free(pic, cont->st_ptr);
   pic_free(pic, cont->ci_ptr);
-  pic_free(pic, cont->xp_ptr);
   pic_free(pic, cont->arena);
   pic_free(pic, cont);
 }
@@ -53,7 +48,6 @@ cont_mark(pic_state *pic, void *data, void (*mark)(pic_state *, pic_value))
   struct checkpoint *cp;
   pic_value *stack;
   struct callinfo *ci;
-  struct proc **xp;
   size_t i;
 
   /* checkpoint */
@@ -78,11 +72,6 @@ cont_mark(pic_state *pic, void *data, void (*mark)(pic_state *, pic_value))
     }
   }
 
-  /* exception handlers */
-  for (xp = cont->xp_ptr; xp != cont->xp_ptr + cont->xp_offset; ++xp) {
-    mark(pic, pic_obj_value(*xp));
-  }
-
   /* arena */
   for (i = 0; i < cont->arena_idx; ++i) {
     mark(pic, pic_obj_value(cont->arena[i]));
@@ -139,11 +128,6 @@ save_cont(pic_state *pic, struct fullcont **c)
   cont->ci_ptr = pic_malloc(pic, sizeof(struct callinfo) * cont->ci_len);
   memcpy(cont->ci_ptr, pic->cibase, sizeof(struct callinfo) * cont->ci_len);
 
-  cont->xp_offset = pic->xp - pic->xpbase;
-  cont->xp_len = pic->xpend - pic->xpbase;
-  cont->xp_ptr = pic_malloc(pic, sizeof(struct proc *) * cont->xp_len);
-  memcpy(cont->xp_ptr, pic->xpbase, sizeof(struct proc *) * cont->xp_len);
-
   cont->ip = pic->ip;
 
   cont->arena_idx = pic->arena_idx;
@@ -190,11 +174,6 @@ restore_cont(pic_state *pic, struct fullcont *cont)
   pic->ci = pic->cibase + cont->ci_offset;
   pic->ciend = pic->cibase + cont->ci_len;
 
-  assert(pic->xpend - pic->xpbase >= cont->xp_len);
-  memcpy(pic->xpbase, cont->xp_ptr, sizeof(struct proc *) * cont->xp_len);
-  pic->xp = pic->xpbase + cont->xp_offset;
-  pic->xpend = pic->xpbase + cont->xp_len;
-
   pic->ip = cont->ip;
 
   assert(pic->arena_size >= cont->arena_size);
diff --git a/extlib/benz/cont.c b/extlib/benz/cont.c
index dc34f2a2..3ddbf7db 100644
--- a/extlib/benz/cont.c
+++ b/extlib/benz/cont.c
@@ -14,7 +14,6 @@ struct pic_cont {
   struct checkpoint *cp;
   ptrdiff_t sp_offset;
   ptrdiff_t ci_offset;
-  ptrdiff_t xp_offset;
   size_t arena_idx;
   struct code *ip;
 
@@ -35,7 +34,6 @@ pic_save_point(pic_state *pic, struct pic_cont *cont, PIC_JMPBUF *jmp)
   cont->cp = pic->cp;
   cont->sp_offset = pic->sp - pic->stbase;
   cont->ci_offset = pic->ci - pic->cibase;
-  cont->xp_offset = pic->xp - pic->xpbase;
   cont->arena_idx = pic->arena_idx;
   cont->ip = pic->ip;
   cont->prev = pic->cc;
@@ -55,7 +53,6 @@ pic_load_point(pic_state *pic, struct pic_cont *cont)
   pic->cp = cont->cp;
   pic->sp = pic->stbase + cont->sp_offset;
   pic->ci = pic->cibase + cont->ci_offset;
-  pic->xp = pic->xpbase + cont->xp_offset;
   pic->arena_idx = cont->arena_idx;
   pic->ip = cont->ip;
   pic->cc = cont->prev;
@@ -89,8 +86,6 @@ pic_dynamic_wind(pic_state *pic, pic_value in, pic_value thunk, pic_value out)
   struct checkpoint *here;
   pic_value val;
 
-  assert(pic_proc_p(pic, thunk));
-
   pic_call(pic, in, 0);       /* enter */
 
   here = pic->cp;
diff --git a/extlib/benz/error.c b/extlib/benz/error.c
index 0105215f..fea8a857 100644
--- a/extlib/benz/error.c
+++ b/extlib/benz/error.c
@@ -37,46 +37,6 @@ pic_warnf(pic_state *pic, const char *fmt, ...)
   xfprintf(pic, file, "warn: %s\n", pic_str(pic, err));
 }
 
-void
-pic_error(pic_state *pic, const char *msg, int n, ...)
-{
-  va_list ap;
-  pic_value irrs;
-
-  va_start(ap, n);
-  irrs = pic_vlist(pic, n, ap);
-  va_end(ap);
-
-  pic_raise(pic, pic_make_error(pic, "", msg, irrs));
-}
-
-void
-pic_push_handler(pic_state *pic, pic_value handler)
-{
-  size_t xp_len;
-  ptrdiff_t xp_offset;
-
-  if (pic->xp >= pic->xpend) {
-    xp_len = (size_t)(pic->xpend - pic->xpbase) * 2;
-    xp_offset = pic->xp - pic->xpbase;
-    pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct proc *) * xp_len);
-    pic->xp = pic->xpbase + xp_offset;
-    pic->xpend = pic->xpbase + xp_len;
-  }
-
-  *pic->xp++ = pic_proc_ptr(pic, handler);
-}
-
-pic_value
-pic_pop_handler(pic_state *pic)
-{
-  if (pic->xp == pic->xpbase) {
-    pic_panic(pic, "no exception handler registered");
-  }
-
-  return pic_obj_value(*--pic->xp);
-}
-
 static pic_value
 native_exception_handler(pic_state *pic)
 {
@@ -91,14 +51,70 @@ native_exception_handler(pic_state *pic)
   PIC_UNREACHABLE();
 }
 
-void
-pic_push_native_handler(pic_state *pic, struct pic_cont *cont)
+static pic_value
+dynamic_set(pic_state *pic)
 {
-  pic_value handler;
+  pic_value var, val;
 
+  pic_get_args(pic, "");
+
+  var = pic_closure_ref(pic, 0);
+  val = pic_closure_ref(pic, 1);
+
+  pic_proc_ptr(pic, var)->locals[0] = val;
+
+  return pic_undef_value(pic);
+}
+
+pic_value
+pic_start_try(pic_state *pic, PIC_JMPBUF *jmp)
+{
+  struct pic_cont *cont;
+  pic_value handler;
+  pic_value var, old_val, new_val;
+  pic_value in, out;
+  struct checkpoint *here;
+
+  /* call/cc */
+
+  cont = pic_alloca_cont(pic);
+  pic_save_point(pic, cont, jmp);
   handler = pic_lambda(pic, native_exception_handler, 1, pic_make_cont(pic, cont));
 
-  pic_push_handler(pic, handler);
+  /* with-exception-handler */
+
+  var = pic_ref(pic, "picrin.base", "current-exception-handlers");
+  old_val = pic_call(pic, var, 0);
+  new_val = pic_cons(pic, handler, old_val);
+
+  in = pic_lambda(pic, dynamic_set, 2, var, new_val);
+  out = pic_lambda(pic, dynamic_set, 2, var, old_val);
+
+  /* dynamic-wind */
+
+  pic_call(pic, in, 0);       /* enter */
+
+  here = pic->cp;
+  pic->cp = (struct checkpoint *)pic_obj_alloc(pic, sizeof(struct checkpoint), PIC_TYPE_CP);
+  pic->cp->prev = here;
+  pic->cp->depth = here->depth + 1;
+  pic->cp->in = pic_proc_ptr(pic, in);
+  pic->cp->out = pic_proc_ptr(pic, out);
+
+  return pic_cons(pic, pic_obj_value(here), out);
+}
+
+void
+pic_end_try(pic_state *pic, pic_value cookie)
+{
+  struct checkpoint *here = (struct checkpoint *)pic_obj_ptr(pic_car(pic, cookie));
+  pic_value out = pic_cdr(pic, cookie);
+
+  pic->cp = here;
+
+  pic_call(pic, out, 0); /* exit */
+
+  pic_exit_point(pic);
 }
 
 pic_value
@@ -124,48 +140,72 @@ pic_make_error(pic_state *pic, const char *type, const char *msg, pic_value irrs
   return pic_obj_value(e);
 }
 
-pic_value
-pic_raise_continuable(pic_state *pic, pic_value err)
+pic_value pic_raise_continuable(pic_state *, pic_value err);
+
+void
+pic_error(pic_state *pic, const char *msg, int n, ...)
 {
-  pic_value handler, v;
+  va_list ap;
+  pic_value irrs;
 
-  handler = pic_pop_handler(pic);
+  va_start(ap, n);
+  irrs = pic_vlist(pic, n, ap);
+  va_end(ap);
 
-  pic_protect(pic, handler);
+  pic_raise(pic, pic_make_error(pic, "", msg, irrs));
+}
 
-  v = pic_call(pic, handler, 1, err);
+static pic_value
+raise(pic_state *pic)
+{
+  pic_get_args(pic, "");
 
-  pic_push_handler(pic, handler);
+  pic_call(pic, pic_closure_ref(pic, 0), 1, pic_closure_ref(pic, 1));
 
-  return v;
+  pic_error(pic, "handler returned", 2, pic_closure_ref(pic, 0), pic_closure_ref(pic, 1));
 }
 
 void
 pic_raise(pic_state *pic, pic_value err)
 {
-  pic_value val;
+  pic_value stack, exc = pic_ref(pic, "picrin.base", "current-exception-handlers");
 
-  val = pic_raise_continuable(pic, err);
+  stack = pic_call(pic, exc, 0);
 
-  pic_pop_handler(pic);
+  pic_dynamic_bind(pic, exc, pic_cdr(pic, stack), pic_lambda(pic, raise, 2, pic_car(pic, stack), err));
 
-  pic_error(pic, "error handler returned", 2, val, err);
+  PIC_UNREACHABLE();
+}
+
+static pic_value
+raise_continuable(pic_state *pic)
+{
+  pic_get_args(pic, "");
+
+  return pic_call(pic, pic_closure_ref(pic, 0), 1, pic_closure_ref(pic, 1));
+}
+
+pic_value
+pic_raise_continuable(pic_state *pic, pic_value err)
+{
+  pic_value stack, exc = pic_ref(pic, "picrin.base", "current-exception-handlers");
+
+  stack = pic_call(pic, exc, 0);
+
+  return pic_dynamic_bind(pic, exc, pic_cdr(pic, stack), pic_lambda(pic, raise_continuable, 2, pic_car(pic, stack), err));
 }
 
 static pic_value
 pic_error_with_exception_handler(pic_state *pic)
 {
-  pic_value handler, thunk, val;
+  pic_value handler, thunk;
+  pic_value stack, exc = pic_ref(pic, "picrin.base", "current-exception-handlers");
 
   pic_get_args(pic, "ll", &handler, &thunk);
 
-  pic_push_handler(pic, handler);
+  stack = pic_call(pic, exc, 0);
 
-  val = pic_call(pic, thunk, 0);
-
-  pic_pop_handler(pic);
-
-  return val;
+  return pic_dynamic_bind(pic, exc, pic_cons(pic, handler, stack), thunk);
 }
 
 static pic_value
@@ -249,6 +289,7 @@ pic_error_error_object_type(pic_state *pic)
 void
 pic_init_error(pic_state *pic)
 {
+  pic_defvar(pic, "current-exception-handlers", pic_nil_value(pic), pic_false_value(pic));
   pic_defun(pic, "with-exception-handler", pic_error_with_exception_handler);
   pic_defun(pic, "raise", pic_error_raise);
   pic_defun(pic, "raise-continuable", pic_error_raise_continuable);
diff --git a/extlib/benz/gc.c b/extlib/benz/gc.c
index 9bbec745..0f0bc6f2 100644
--- a/extlib/benz/gc.c
+++ b/extlib/benz/gc.c
@@ -413,7 +413,6 @@ gc_mark_phase(pic_state *pic)
 {
   pic_value *stack;
   struct callinfo *ci;
-  struct proc **xhandler;
   struct list_head *list;
   int it;
   size_t j;
@@ -437,11 +436,6 @@ gc_mark_phase(pic_state *pic)
     }
   }
 
-  /* exception handlers */
-  for (xhandler = pic->xpbase; xhandler != pic->xp; ++xhandler) {
-    gc_mark_object(pic, (struct object *)*xhandler);
-  }
-
   /* arena */
   for (j = 0; j < pic->arena_idx; ++j) {
     gc_mark_object(pic, (struct object *)pic->arena[j]);
diff --git a/extlib/benz/include/picrin/extra.h b/extlib/benz/include/picrin/extra.h
index e574e24c..ffe1c3d7 100644
--- a/extlib/benz/include/picrin/extra.h
+++ b/extlib/benz/include/picrin/extra.h
@@ -78,26 +78,17 @@ xFILE *xfopen_null(pic_state *, const char *mode);
     pic_in_library(pic, lib);                   \
   } while (0)
 
-/* for pic_try & pic_catch macros */
-struct pic_cont *pic_alloca_cont(pic_state *);
-pic_value pic_make_cont(pic_state *, struct pic_cont *);
-void pic_push_native_handler(pic_state *, struct pic_cont *);
-pic_value pic_pop_handler(pic_state *);
-void pic_save_point(pic_state *, struct pic_cont *, PIC_JMPBUF *);
-void pic_exit_point(pic_state *);
-
 #define pic_try pic_try_(PIC_GENSYM(cont), PIC_GENSYM(jmp))
 #define pic_try_(cont, jmp)                                             \
   do {                                                                  \
+    extern pic_value pic_start_try(pic_state *, PIC_JMPBUF *);          \
+    extern void pic_end_try(pic_state *, pic_value);                    \
     PIC_JMPBUF jmp;                                                     \
-    struct pic_cont *cont = pic_alloca_cont(pic);                       \
     if (PIC_SETJMP(pic, jmp) == 0) {                                    \
-      pic_save_point(pic, cont, &jmp);                                  \
-      pic_push_native_handler(pic, cont);
+      pic_value pic_try_cookie_ = pic_start_try(pic, &jmp);
 #define pic_catch pic_catch_(PIC_GENSYM(label))
 #define pic_catch_(label)                                 \
-      pic_pop_handler(pic);                               \
-      pic_exit_point(pic);                                \
+      pic_end_try(pic, pic_try_cookie_);                  \
     } else {                                              \
       goto label;                                         \
     }                                                     \
diff --git a/extlib/benz/include/picrin/private/object.h b/extlib/benz/include/picrin/private/object.h
index f92db235..9d157a4f 100644
--- a/extlib/benz/include/picrin/private/object.h
+++ b/extlib/benz/include/picrin/private/object.h
@@ -188,9 +188,14 @@ void pic_rope_decref(pic_state *, struct rope *);
 #define pic_func_p(pic, proc) (pic_type(pic, proc) == PIC_TYPE_FUNC)
 #define pic_irep_p(pic, proc) (pic_type(pic, proc) == PIC_TYPE_IREP)
 
+struct pic_cont *pic_alloca_cont(pic_state *);
+pic_value pic_make_cont(pic_state *, struct pic_cont *);
+void pic_save_point(pic_state *, struct pic_cont *, PIC_JMPBUF *);
+void pic_exit_point(pic_state *);
 void pic_wind(pic_state *, struct checkpoint *, struct checkpoint *);
 pic_value pic_dynamic_wind(pic_state *, pic_value in, pic_value thunk, pic_value out);
 
+pic_value pic_dynamic_bind(pic_state *, pic_value var, pic_value val, pic_value thunk);
 
 #if defined(__cplusplus)
 }
diff --git a/extlib/benz/include/picrin/private/state.h b/extlib/benz/include/picrin/private/state.h
index 9a59574d..92f26679 100644
--- a/extlib/benz/include/picrin/private/state.h
+++ b/extlib/benz/include/picrin/private/state.h
@@ -49,9 +49,6 @@ struct pic_state {
   struct callinfo *ci;
   struct callinfo *cibase, *ciend;
 
-  struct proc **xp;
-  struct proc **xpbase, **xpend;
-
   struct code *ip;
 
   struct lib *lib;
diff --git a/extlib/benz/state.c b/extlib/benz/state.c
index 95918308..b5f97b31 100644
--- a/extlib/benz/state.c
+++ b/extlib/benz/state.c
@@ -229,14 +229,6 @@ pic_open(pic_allocf allocf, void *userdata)
     goto EXIT_CI;
   }
 
-  /* exception handler */
-  pic->xpbase = pic->xp = allocf(userdata, NULL, PIC_RESCUE_SIZE * sizeof(struct proc *));
-  pic->xpend = pic->xpbase + PIC_RESCUE_SIZE;
-
-  if (! pic->xp) {
-    goto EXIT_XP;
-  }
-
   /* GC arena */
   pic->arena = allocf(userdata, NULL, PIC_ARENA_SIZE * sizeof(struct object *));
   pic->arena_size = PIC_ARENA_SIZE;
@@ -317,8 +309,6 @@ pic_open(pic_allocf allocf, void *userdata)
   return pic;
 
  EXIT_ARENA:
-  allocf(userdata, pic->xp, 0);
- EXIT_XP:
   allocf(userdata, pic->ci, 0);
  EXIT_CI:
   allocf(userdata, pic->sp, 0);
@@ -336,7 +326,6 @@ pic_close(pic_state *pic)
   /* clear out root objects */
   pic->sp = pic->stbase;
   pic->ci = pic->cibase;
-  pic->xp = pic->xpbase;
   pic->arena_idx = 0;
   pic->err = pic_invalid_value(pic);
   pic->globals = pic_invalid_value(pic);
@@ -358,7 +347,6 @@ pic_close(pic_state *pic)
   /* free runtime context */
   allocf(pic->userdata, pic->stbase, 0);
   allocf(pic->userdata, pic->cibase, 0);
-  allocf(pic->userdata, pic->xpbase, 0);
 
   /* free global stacks */
   kh_destroy(oblist, &pic->oblist);