From 46c1d0f2a77e1b8c46634fe586db043089fbff56 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Thu, 18 Sep 2014 14:12:18 +0900
Subject: [PATCH] use call/cc in exception handler implementation

---
 error.c                | 88 +++++++++++++++++++++++-------------------
 include/picrin.h       |  1 -
 include/picrin/error.h |  7 +---
 state.c                |  1 -
 4 files changed, 51 insertions(+), 46 deletions(-)

diff --git a/error.c b/error.c
index 2e7ec4d5..4eb34157 100644
--- a/error.c
+++ b/error.c
@@ -8,6 +8,8 @@
 
 #include "picrin.h"
 #include "picrin/pair.h"
+#include "picrin/proc.h"
+#include "picrin/cont.h"
 #include "picrin/string.h"
 #include "picrin/error.h"
 
@@ -66,42 +68,60 @@ pic_errmsg(pic_state *pic)
   return pic_str_cstr(str);
 }
 
-void
-pic_push_try(pic_state *pic, struct pic_proc *handler)
+static pic_value
+native_exception_handler(pic_state *pic)
 {
+  pic_value err;
+  struct pic_proc *cont;
+
+  pic_get_args(pic, "o", &err);
+
+  pic->err = err;
+
+  cont = pic_proc_ptr(pic_attr_ref(pic, pic_get_proc(pic), "@@escape"));
+
+  pic_apply1(pic, cont, pic_false_value());
+
+  UNREACHABLE();
+}
+
+static pic_value
+native_push_try(pic_state *pic)
+{
+  struct pic_proc *cont, *handler;
   struct pic_jmpbuf *try_jmp;
 
+  pic_get_args(pic, "l", &cont);
+
+  handler = pic_make_proc(pic, native_exception_handler, "(native-exception-handler)");
+
+  pic_attr_set(pic, handler, "@@escape", pic_obj_value(cont));
+
   if (pic->try_jmp_idx >= pic->try_jmp_size) {
     pic->try_jmp_size *= 2;
     pic->try_jmps = pic_realloc(pic, pic->try_jmps, sizeof(struct pic_jmpbuf) * pic->try_jmp_size);
   }
 
   try_jmp = pic->try_jmps + pic->try_jmp_idx++;
-
   try_jmp->handler = handler;
 
-  try_jmp->ci_offset = pic->ci - pic->cibase;
-  try_jmp->sp_offset = pic->sp - pic->stbase;
-  try_jmp->ip = pic->ip;
+  return pic_true_value();
+}
 
-  try_jmp->prev_jmp = pic->jmp;
-  pic->jmp = &try_jmp->here;
+bool
+pic_push_try(pic_state *pic)
+{
+  pic_value val;
+
+  val = pic_callcc(pic, pic_make_proc(pic, native_push_try, "(native-push-try)"));
+
+  return pic_test(val);
 }
 
 void
 pic_pop_try(pic_state *pic)
 {
-  struct pic_jmpbuf *try_jmp;
-
-  try_jmp = pic->try_jmps + --pic->try_jmp_idx;
-
-  /* assert(pic->jmp == &try_jmp->here); */
-
-  pic->ci = try_jmp->ci_offset + pic->cibase;
-  pic->sp = try_jmp->sp_offset + pic->stbase;
-  pic->ip = try_jmp->ip;
-
-  pic->jmp = try_jmp->prev_jmp;
+  --pic->try_jmp_idx;
 }
 
 struct pic_error *
@@ -124,28 +144,13 @@ pic_make_error(pic_state *pic, pic_sym type, const char *msg, pic_value irrs)
 pic_value
 pic_raise_continuable(pic_state *pic, pic_value err)
 {
+  struct pic_proc *handler;
   pic_value v;
 
   if (pic->try_jmp_idx == 0) {
-    pic_errorf(pic, "no exception handler registered");
+    pic_panic(pic, "no exception handler registered");
   }
 
-  if (pic->try_jmps[pic->try_jmp_idx - 1].handler == NULL) {
-    void pic_vm_tear_off(pic_state *);
-
-    pic_vm_tear_off(pic);         /* tear off */
-
-    pic->err = err;
-    if (! pic->jmp) {
-      puts(pic_errmsg(pic));
-      pic_panic(pic, "no handler found on stack");
-    }
-
-    longjmp(*pic->jmp, 1);
-  }
-
-  struct pic_proc *handler;
-
   handler = pic->try_jmps[pic->try_jmp_idx - 1].handler;
 
   pic_gc_protect(pic, pic_obj_value(handler));
@@ -154,7 +159,7 @@ pic_raise_continuable(pic_state *pic, pic_value err)
 
   v = pic_apply1(pic, pic->try_jmps[pic->try_jmp_idx].handler, err);
 
-  pic->try_jmp_idx++;
+  pic->try_jmps[pic->try_jmp_idx++].handler = handler;
 
   return v;
 }
@@ -195,11 +200,16 @@ pic_error_with_exception_handler(pic_state *pic)
 
   pic_get_args(pic, "ll", &handler, &thunk);
 
-  pic_push_try(pic, handler);
+  if (pic->try_jmp_idx >= pic->try_jmp_size) {
+    pic->try_jmp_size *= 2;
+    pic->try_jmps = pic_realloc(pic, pic->try_jmps, sizeof(struct pic_jmpbuf) * pic->try_jmp_size);
+  }
+
+  pic->try_jmps[pic->try_jmp_idx++].handler = handler;
 
   val = pic_apply0(pic, thunk);
 
-  pic_pop_try(pic);
+  pic->try_jmp_idx--;
 
   return val;
 }
diff --git a/include/picrin.h b/include/picrin.h
index 5bec9eb0..17a159dd 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -111,7 +111,6 @@ typedef struct {
 
   struct pic_reader *reader;
 
-  jmp_buf *jmp;
   pic_value err;
   struct pic_jmpbuf *try_jmps;
   size_t try_jmp_size, try_jmp_idx;
diff --git a/include/picrin/error.h b/include/picrin/error.h
index 9541ab55..8686d3ff 100644
--- a/include/picrin/error.h
+++ b/include/picrin/error.h
@@ -21,17 +21,14 @@ struct pic_jmpbuf {
 /* do not return from try block! */
 
 #define pic_try                                 \
-  pic_try_with_handler(NULL)
-#define pic_try_with_handler(handler)           \
-  pic_push_try(pic, handler);                   \
-  if (setjmp(*pic->jmp) == 0)                   \
+  if (pic_push_try(pic))                        \
     do
 #define pic_catch                               \
     while (pic_pop_try(pic), 0);                \
   else                                          \
     if (pic_pop_try(pic), 1)
 
-void pic_push_try(pic_state *, struct pic_proc *);
+bool pic_push_try(pic_state *);
 void pic_pop_try(pic_state *);
 
 pic_value pic_raise_continuable(pic_state *, pic_value);
diff --git a/state.c b/state.c
index df9ba02c..e75876a2 100644
--- a/state.c
+++ b/state.c
@@ -71,7 +71,6 @@ pic_open(int argc, char *argv[], char **envp)
   xh_init_int(&pic->reader->labels, sizeof(pic_value));
 
   /* error handling */
-  pic->jmp = NULL;
   pic->err = pic_undef_value();
   pic->try_jmps = calloc(PIC_RESCUE_SIZE, sizeof(struct pic_jmpbuf));
   pic->try_jmp_idx = 0;