From daa7513be562115e78fe53eccc4edfd3e059ad5b Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 14:09:28 +0900
Subject: [PATCH 01/16] add pic_throw function

---
 include/picrin/error.h |  2 ++
 src/error.c            | 24 ++++++++++++------------
 src/macro.c            |  2 +-
 src/vm.c               |  3 ++-
 4 files changed, 17 insertions(+), 14 deletions(-)

diff --git a/include/picrin/error.h b/include/picrin/error.h
index a4caf63a..5aff2916 100644
--- a/include/picrin/error.h
+++ b/include/picrin/error.h
@@ -27,6 +27,8 @@ struct pic_jmpbuf {
 void pic_push_try(pic_state *);
 void pic_pop_try(pic_state *);
 
+noreturn void pic_throw(pic_state *, struct pic_error *);
+
 struct pic_error {
   PIC_OBJECT_HEADER
   enum pic_error_kind {
diff --git a/src/error.c b/src/error.c
index d3798f21..10097548 100644
--- a/src/error.c
+++ b/src/error.c
@@ -39,16 +39,8 @@ pic_pop_try(pic_state *pic)
   pic->try_jmps = prev;
 }
 
-const char *
-pic_errmsg(pic_state *pic)
-{
-  assert(pic->err != NULL);
-
-  return pic_str_cstr(pic->err->msg);
-}
-
-noreturn static void
-raise(pic_state *pic, struct pic_error *e)
+noreturn void
+pic_throw(pic_state *pic, struct pic_error *e)
 {
   pic->err = e;
   if (! pic->jmp) {
@@ -58,6 +50,14 @@ raise(pic_state *pic, struct pic_error *e)
   longjmp(*pic->jmp, 1);
 }
 
+const char *
+pic_errmsg(pic_state *pic)
+{
+  assert(pic->err != NULL);
+
+  return pic_str_cstr(pic->err->msg);
+}
+
 noreturn static void
 error(pic_state *pic, pic_str *msg, pic_value irrs)
 {
@@ -68,7 +68,7 @@ error(pic_state *pic, pic_str *msg, pic_value irrs)
   e->msg = msg;
   e->irrs = irrs;
 
-  raise(pic, e);
+  pic_throw(pic, e);
 }
 
 void
@@ -115,7 +115,7 @@ pic_raise(pic_state *pic, struct pic_error *e)
   struct pic_proc *handler;
 
   if (pic->ridx == 0) {
-    raise(pic, e);
+    pic_throw(pic, e);
   }
 
   handler = pic->rescue[--pic->ridx];
diff --git a/src/macro.c b/src/macro.c
index 4af43ae6..89a2a3d3 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -243,7 +243,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
         pic_catch {
           /* restores pic->lib even if an error occurs */
           pic_in_library(pic, prev->name);
-          longjmp(*pic->jmp, 1);
+          pic_throw(pic, pic->err);
         }
 
         return pic_none_value();
diff --git a/src/vm.c b/src/vm.c
index 51e1787a..047406e2 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -18,6 +18,7 @@
 #include "picrin/var.h"
 #include "picrin/lib.h"
 #include "picrin/macro.h"
+#include "picrin/error.h"
 
 #define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
 
@@ -935,7 +936,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 
       pic->jmp = prev_jmp;
       if (pic->err) {
-	longjmp(*pic->jmp, 1);
+        pic_throw(pic, pic->err);
       }
 
 #if VM_DEBUG

From edb4f61d5e1a9278368f6ffcc209ba691965efc9 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 14:24:53 +0900
Subject: [PATCH 02/16] error function is no longer used

---
 src/error.c | 21 +++++++--------------
 1 file changed, 7 insertions(+), 14 deletions(-)

diff --git a/src/error.c b/src/error.c
index 10097548..1f68afa1 100644
--- a/src/error.c
+++ b/src/error.c
@@ -58,19 +58,6 @@ pic_errmsg(pic_state *pic)
   return pic_str_cstr(pic->err->msg);
 }
 
-noreturn static void
-error(pic_state *pic, pic_str *msg, pic_value irrs)
-{
-  struct pic_error *e;
-
-  e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TT_ERROR);
-  e->type = PIC_ERROR_OTHER;
-  e->msg = msg;
-  e->irrs = irrs;
-
-  pic_throw(pic, e);
-}
-
 void
 pic_error(pic_state *pic, const char *msg)
 {
@@ -82,12 +69,18 @@ pic_errorf(pic_state *pic, const char *fmt, ...)
 {
   va_list ap;
   pic_value err_line;
+  struct pic_error *e;
 
   va_start(ap, fmt);
   err_line = pic_vformat(pic, fmt, ap);
   va_end(ap);
 
-  error(pic, pic_str_ptr(pic_car(pic, err_line)), pic_cdr(pic, err_line));
+  e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TT_ERROR);
+  e->type = PIC_ERROR_OTHER;
+  e->msg = pic_str_ptr(pic_car(pic, err_line));
+  e->irrs = pic_cdr(pic, err_line);
+
+  pic_throw(pic, e);
 }
 
 void

From 042bd304154cd140dbf30974bd94a3aeed510844 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 14:51:31 +0900
Subject: [PATCH 03/16] add notation about pic_try usage

---
 include/picrin/error.h | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/include/picrin/error.h b/include/picrin/error.h
index 5aff2916..ffc0dfed 100644
--- a/include/picrin/error.h
+++ b/include/picrin/error.h
@@ -15,6 +15,8 @@ struct pic_jmpbuf {
   struct pic_jmpbuf *prev;
 };
 
+/* do not return from try block! */
+
 #define pic_try                                 \
   pic_push_try(pic);                            \
   if (setjmp(*pic->jmp) == 0)                   \

From 4d56ebf6346a7844178379b94bcbc66d628276a5 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 14:52:52 +0900
Subject: [PATCH 04/16] drop support for raise-continuable for a moment

---
 include/picrin/error.h |  2 --
 src/error.c            | 27 ---------------------------
 2 files changed, 29 deletions(-)

diff --git a/include/picrin/error.h b/include/picrin/error.h
index ffc0dfed..cebc85e1 100644
--- a/include/picrin/error.h
+++ b/include/picrin/error.h
@@ -46,8 +46,6 @@ struct pic_error {
 #define pic_error_p(v) (pic_type(v) == PIC_TT_ERROR)
 #define pic_error_ptr(v) ((struct pic_error *)pic_ptr(v))
 
-pic_value pic_raise_continuable(pic_state *, pic_value);
-
 #if defined(__cplusplus)
 }
 #endif
diff --git a/src/error.c b/src/error.c
index 1f68afa1..1c620019 100644
--- a/src/error.c
+++ b/src/error.c
@@ -119,22 +119,6 @@ pic_raise(pic_state *pic, struct pic_error *e)
   pic_errorf(pic, "handler returned", 2, pic_obj_value(handler), a);
 }
 
-pic_value
-pic_raise_continuable(pic_state *pic, pic_value obj)
-{
-  struct pic_proc *handler;
-
-  if (pic->ridx == 0) {
-    pic_abort(pic, "logic flaw: no exception handler remains");
-  }
-
-  handler = pic->rescue[--pic->ridx];
-  obj = pic_apply_argv(pic, handler, 1, obj);
-  pic->rescue[pic->ridx++] = handler;
-
-  return obj;
-}
-
 static pic_value
 pic_error_with_exception_handler(pic_state *pic)
 {
@@ -175,16 +159,6 @@ pic_error_raise(pic_state *pic)
   pic_raise(pic, e);
 }
 
-static pic_value
-pic_error_raise_continuable(pic_state *pic)
-{
-  pic_value obj;
-
-  pic_get_args(pic, "o", &obj);
-
-  return pic_raise_continuable(pic, obj);
-}
-
 noreturn static pic_value
 pic_error_error(pic_state *pic)
 {
@@ -270,7 +244,6 @@ pic_init_error(pic_state *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);
   pic_defun(pic, "error", pic_error_error);
   pic_defun(pic, "error-object?", pic_error_error_object_p);
   pic_defun(pic, "error-object-message", pic_error_error_object_message);

From f6f695fa566f0f197afd386c1f94a6769f8352e0 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 14:53:46 +0900
Subject: [PATCH 05/16] update readme

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 359bc13e..642f5084 100644
--- a/README.md
+++ b/README.md
@@ -117,7 +117,7 @@ Picrin is a lightweight scheme implementation intended to comply with full R7RS
 | 6.8 Vectors | yes | |
 | 6.9 Bytevectors | yes | |
 | 6.10  Control features | yes | |
-| 6.11 Exceptions | yes | |
+| 6.11 Exceptions | yes | `raise-continuable` is not supported |
 | 6.12 Environments and evaluation | N/A | |
 | 6.13.1 Ports | yes | |
 | 6.13.2 Input | incomplete | TODO: binary input |

From 6448a36db5fd1a32cca818e3de0028c829931fe3 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 14:54:03 +0900
Subject: [PATCH 06/16] don't use pic->rescue stack in with-exception-handler

---
 src/error.c | 19 ++++++++-----------
 1 file changed, 8 insertions(+), 11 deletions(-)

diff --git a/src/error.c b/src/error.c
index 1c620019..87dbff12 100644
--- a/src/error.c
+++ b/src/error.c
@@ -127,19 +127,16 @@ pic_error_with_exception_handler(pic_state *pic)
 
   pic_get_args(pic, "ll", &handler, &thunk);
 
-  if (pic->ridx >= pic->rlen) {
-
-#if DEBUG
-    puts("rescue realloced");
-#endif
-
-    pic->rlen *= 2;
-    pic->rescue = (struct pic_proc **)pic_realloc(pic, pic->rescue, sizeof(struct pic_proc *) * pic->rlen);
+  pic_try {
+    v = pic_apply_argv(pic, thunk, 0);
   }
-  pic->rescue[pic->ridx++] = handler;
+  pic_catch {
+    struct pic_error *e = pic->err;
 
-  v = pic_apply_argv(pic, thunk, 0);
-  pic->ridx--;
+    pic->err = NULL;
+    v = pic_apply_argv(pic, handler, 1, pic_obj_value(e));
+    pic_errorf(pic, "error handler returned ~s, by error ~s", v, pic_obj_value(e));
+  }
   return v;
 }
 

From bb7e35ca0e3a07dd4a3295a843b21862512c45fd Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 14:55:41 +0900
Subject: [PATCH 07/16] pic_raise is equivalent to pic_throw. remove it.

---
 include/picrin.h |  1 -
 src/error.c      | 22 ++--------------------
 2 files changed, 2 insertions(+), 21 deletions(-)

diff --git a/include/picrin.h b/include/picrin.h
index 34953544..6a1b3073 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -180,7 +180,6 @@ void pic_import(pic_state *, pic_value);
 void pic_export(pic_state *, pic_sym);
 
 noreturn void pic_abort(pic_state *, const char *);
-noreturn void pic_raise(pic_state *, struct pic_error *);
 noreturn void pic_error(pic_state *, const char *); /* obsoleted */
 noreturn void pic_errorf(pic_state *, const char *, ...);
 void pic_warn(pic_state *, const char *);
diff --git a/src/error.c b/src/error.c
index 87dbff12..42ccacf3 100644
--- a/src/error.c
+++ b/src/error.c
@@ -101,24 +101,6 @@ pic_warn(pic_state *pic, const char *msg)
   fprintf(stderr, "warn: %s\n", msg);
 }
 
-void
-pic_raise(pic_state *pic, struct pic_error *e)
-{
-  pic_value a;
-  struct pic_proc *handler;
-
-  if (pic->ridx == 0) {
-    pic_throw(pic, e);
-  }
-
-  handler = pic->rescue[--pic->ridx];
-  pic_gc_protect(pic, pic_obj_value(handler));
-
-  a = pic_apply_argv(pic, handler, 1, pic_obj_value(e));
-  /* when the handler returns */
-  pic_errorf(pic, "handler returned", 2, pic_obj_value(handler), a);
-}
-
 static pic_value
 pic_error_with_exception_handler(pic_state *pic)
 {
@@ -153,7 +135,7 @@ pic_error_raise(pic_state *pic)
   e->msg = pic_str_new_cstr(pic, "raised");
   e->irrs = pic_list1(pic, v);
 
-  pic_raise(pic, e);
+  pic_throw(pic, e);
 }
 
 noreturn static pic_value
@@ -171,7 +153,7 @@ pic_error_error(pic_state *pic)
   e->msg = str;
   e->irrs = pic_list_by_array(pic, argc, argv);
 
-  pic_raise(pic, e);
+  pic_throw(pic, e);
 }
 
 static pic_value

From 0fcd1a3e1042b8441a0d424d3368e7329b0cd339 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 14:57:10 +0900
Subject: [PATCH 08/16] inline pic_error definition

---
 include/picrin.h | 7 ++++++-
 src/error.c      | 6 ------
 2 files changed, 6 insertions(+), 7 deletions(-)

diff --git a/include/picrin.h b/include/picrin.h
index 6a1b3073..51fd36eb 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -180,10 +180,15 @@ void pic_import(pic_state *, pic_value);
 void pic_export(pic_state *, pic_sym);
 
 noreturn void pic_abort(pic_state *, const char *);
-noreturn void pic_error(pic_state *, const char *); /* obsoleted */
 noreturn void pic_errorf(pic_state *, const char *, ...);
 void pic_warn(pic_state *, const char *);
 
+/* obsoleted */
+noreturn static inline void pic_error(pic_state *pic, const char *msg)
+{
+  pic_errorf(pic, msg);
+}
+
 const char *pic_errmsg(pic_state *);
 
 pic_value pic_write(pic_state *, pic_value); /* returns given obj */
diff --git a/src/error.c b/src/error.c
index 42ccacf3..9cd973c6 100644
--- a/src/error.c
+++ b/src/error.c
@@ -58,12 +58,6 @@ pic_errmsg(pic_state *pic)
   return pic_str_cstr(pic->err->msg);
 }
 
-void
-pic_error(pic_state *pic, const char *msg)
-{
-  pic_errorf(pic, msg);
-}
-
 void
 pic_errorf(pic_state *pic, const char *fmt, ...)
 {

From 8451bd5c193dfcf1000d5ee9bde80f2812f64e16 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 14:58:09 +0900
Subject: [PATCH 09/16] cleanup

---
 src/error.c | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/src/error.c b/src/error.c
index 9cd973c6..f5c3d24f 100644
--- a/src/error.c
+++ b/src/error.c
@@ -11,6 +11,24 @@
 #include "picrin/string.h"
 #include "picrin/error.h"
 
+void
+pic_abort(pic_state *pic, const char *msg)
+{
+  UNUSED(pic);
+
+  fprintf(stderr, "abort: %s\n", msg);
+  fflush(stderr);
+  abort();
+}
+
+void
+pic_warn(pic_state *pic, const char *msg)
+{
+  UNUSED(pic);
+
+  fprintf(stderr, "warn: %s\n", msg);
+}
+
 void
 pic_push_try(pic_state *pic)
 {
@@ -77,24 +95,6 @@ pic_errorf(pic_state *pic, const char *fmt, ...)
   pic_throw(pic, e);
 }
 
-void
-pic_abort(pic_state *pic, const char *msg)
-{
-  UNUSED(pic);
-
-  fprintf(stderr, "abort: %s\n", msg);
-  fflush(stderr);
-  abort();
-}
-
-void
-pic_warn(pic_state *pic, const char *msg)
-{
-  UNUSED(pic);
-
-  fprintf(stderr, "warn: %s\n", msg);
-}
-
 static pic_value
 pic_error_with_exception_handler(pic_state *pic)
 {

From 1821039e789eace9e05afd42db5a2b75ddfe4c23 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 15:00:55 +0900
Subject: [PATCH 10/16] pic->rescue is no longer used

---
 include/picrin.h      |  3 ---
 include/picrin/cont.h |  3 ---
 src/cont.c            | 10 ----------
 src/gc.c              | 18 +++---------------
 src/state.c           |  7 -------
 5 files changed, 3 insertions(+), 38 deletions(-)

diff --git a/include/picrin.h b/include/picrin.h
index 51fd36eb..6c18fe27 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -77,9 +77,6 @@ typedef struct {
 
   pic_code *ip;
 
-  struct pic_proc **rescue;
-  size_t ridx, rlen;
-
   pic_sym sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG;
   pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
   pic_sym sDEFINE_SYNTAX, sDEFINE_MACRO;
diff --git a/include/picrin/cont.h b/include/picrin/cont.h
index 38cfc131..15ea1c3f 100644
--- a/include/picrin/cont.h
+++ b/include/picrin/cont.h
@@ -26,9 +26,6 @@ struct pic_cont {
 
   pic_code *ip;
 
-  struct pic_proc **rescue;
-  size_t ridx, rlen;
-
   struct pic_object *arena[PIC_ARENA_SIZE];
   int arena_idx;
 
diff --git a/src/cont.c b/src/cont.c
index 389e8a7b..9d0379d9 100644
--- a/src/cont.c
+++ b/src/cont.c
@@ -119,11 +119,6 @@ save_cont(pic_state *pic, struct pic_cont **c)
 
   cont->ip = pic->ip;
 
-  cont->ridx = pic->ridx;
-  cont->rlen = pic->rlen;
-  cont->rescue = (struct pic_proc **)pic_alloc(pic, sizeof(struct pic_proc *) * cont->rlen);
-  memcpy(cont->rescue, pic->rescue, sizeof(struct pic_proc *) * cont->rlen);
-
   cont->arena_idx = pic->arena_idx;
   memcpy(cont->arena, pic->arena, sizeof(struct pic_object *) * PIC_ARENA_SIZE);
 
@@ -168,11 +163,6 @@ restore_cont(pic_state *pic, struct pic_cont *cont)
 
   pic->ip = cont->ip;
 
-  pic->rescue = (struct pic_proc **)pic_realloc(pic, pic->rescue, sizeof(struct pic_proc *) * cont->rlen);
-  memcpy(pic->rescue, cont->rescue, sizeof(struct pic_object *) * cont->rlen);
-  pic->ridx = cont->ridx;
-  pic->rlen = cont->rlen;
-
   memcpy(pic->arena, cont->arena, sizeof(struct pic_object *) * PIC_ARENA_SIZE);
   pic->arena_idx = cont->arena_idx;
 
diff --git a/src/gc.c b/src/gc.c
index 807574c2..97b45195 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -406,8 +406,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     struct pic_cont *cont = (struct pic_cont *)obj;
     pic_value *stack;
     pic_callinfo *ci;
-    size_t i;
-    int j;
+    int i;
 
     /* block */
     gc_mark_block(pic, cont->blk);
@@ -424,14 +423,9 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
       }
     }
 
-    /* exception handlers */
-    for (i = 0; i < cont->ridx; ++i) {
-      gc_mark_object(pic, (struct pic_object *)cont->rescue[i]);
-    }
-
     /* arena */
-    for (j = 0; j < cont->arena_idx; ++j) {
-      gc_mark_object(pic, cont->arena[j]);
+    for (i = 0; i < cont->arena_idx; ++i) {
+      gc_mark_object(pic, cont->arena[i]);
     }
 
     /* result values */
@@ -537,11 +531,6 @@ gc_mark_phase(pic_state *pic)
     }
   }
 
-  /* exception handlers */
-  for (i = 0; i < pic->ridx; ++i) {
-    gc_mark_object(pic, (struct pic_object *)pic->rescue[i]);
-  }
-
   /* error object */
   if (pic->err) {
     gc_mark_object(pic, (struct pic_object *)pic->err);
@@ -608,7 +597,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     pic_free(pic, cont->stk_ptr);
     pic_free(pic, cont->st_ptr);
     pic_free(pic, cont->ci_ptr);
-    pic_free(pic, cont->rescue);
     PIC_BLK_DECREF(pic, cont->blk);
     break;
   }
diff --git a/src/state.c b/src/state.c
index c0a511eb..4875193e 100644
--- a/src/state.c
+++ b/src/state.c
@@ -42,11 +42,6 @@ pic_open(int argc, char *argv[], char **envp)
   pic->cibase = pic->ci = (pic_callinfo *)calloc(PIC_STACK_SIZE, sizeof(pic_callinfo));
   pic->ciend = pic->cibase + PIC_STACK_SIZE;
 
-  /* exception handlers */
-  pic->rescue = (struct pic_proc **)calloc(PIC_RESCUE_SIZE, sizeof(struct pic_proc *));
-  pic->ridx = 0;
-  pic->rlen = PIC_RESCUE_SIZE;
-
   /* memory heap */
   pic->heap = pic_heap_open();
 
@@ -136,7 +131,6 @@ pic_close(pic_state *pic)
   /* clear out root objects */
   pic->sp = pic->stbase;
   pic->ci = pic->cibase;
-  pic->ridx = 0;
   pic->arena_idx = 0;
   pic->err = NULL;
   pic->glen = 0;
@@ -152,7 +146,6 @@ pic_close(pic_state *pic)
   /* free runtime context */
   free(pic->stbase);
   free(pic->cibase);
-  free(pic->rescue);
 
   /* free global stacks */
   free(pic->globals);

From f2717910d096d7c17491947c8c3b71b0137f3c13 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 15:12:01 +0900
Subject: [PATCH 11/16] remove error handling stuff from the VM

---
 src/vm.c | 21 ---------------------
 1 file changed, 21 deletions(-)

diff --git a/src/vm.c b/src/vm.c
index 047406e2..01f64423 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -500,7 +500,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 {
   pic_code c;
   int ai = pic_gc_arena_preserve(pic);
-  jmp_buf jmp, *prev_jmp = pic->jmp;
   size_t argc, i;
   pic_code boot[2];
 
@@ -516,13 +515,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
   };
 #endif
 
-  if (setjmp(jmp) == 0) {
-    pic->jmp = &jmp;
-  }
-  else {
-    goto L_RAISE;
-  }
-
   if (! pic_list_p(argv)) {
     pic_error(pic, "argv must be a proper list");
   }
@@ -774,12 +766,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       pic_value *retv;
       pic_callinfo *ci;
 
-      if (pic->err) {
-
-      L_RAISE:
-	goto L_STOP;
-      }
-
       if (pic->ci->env != NULL) {
         vm_tear_off(pic);
       }
@@ -919,7 +905,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       }								\
       else {							\
 	pic_error(pic, #op " got non-number operands");		\
-	goto L_RAISE;						\
       }								\
       NEXT;							\
     }
@@ -931,14 +916,8 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
     CASE(OP_STOP) {
       pic_value val;
 
-    L_STOP:
       val = POP();
 
-      pic->jmp = prev_jmp;
-      if (pic->err) {
-        pic_throw(pic, pic->err);
-      }
-
 #if VM_DEBUG
       puts("**VM END STATE**");
       printf("stbase\t= %p\nsp\t= %p\n", (void *)stbase, (void *)pic->sp);

From af80ba6b365b585887165f2c36cd266480331216 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 15:14:54 +0900
Subject: [PATCH 12/16] pic_gc_protect now returns a value

---
 include/picrin.h | 2 +-
 src/gc.c         | 6 ++++--
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/include/picrin.h b/include/picrin.h
index 6c18fe27..0d250f7b 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -121,7 +121,7 @@ struct pic_object *pic_obj_alloc_unsafe(pic_state *, size_t, enum pic_tt);
 void pic_free(pic_state *, void *);
 
 void pic_gc_run(pic_state *);
-void pic_gc_protect(pic_state *, pic_value);
+pic_value pic_gc_protect(pic_state *, pic_value);
 int pic_gc_arena_preserve(pic_state *);
 void pic_gc_arena_restore(pic_state *, int);
 
diff --git a/src/gc.c b/src/gc.c
index 97b45195..2d42ade6 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -183,17 +183,19 @@ gc_protect(pic_state *pic, struct pic_object *obj)
   pic->arena[pic->arena_idx++] = obj;
 }
 
-void
+pic_value
 pic_gc_protect(pic_state *pic, pic_value v)
 {
   struct pic_object *obj;
 
   if (pic_vtype(v) != PIC_VTYPE_HEAP) {
-    return;
+    return v;
   }
   obj = pic_obj_ptr(v);
 
   gc_protect(pic, obj);
+
+  return v;
 }
 
 int

From 9dcdc45ab697886fc46271ec9ac94a5d51a6f756 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 15:15:08 +0900
Subject: [PATCH 13/16] cleanup

---
 src/vm.c | 11 +++--------
 1 file changed, 3 insertions(+), 8 deletions(-)

diff --git a/src/vm.c b/src/vm.c
index 01f64423..4cefff0b 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -914,15 +914,12 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
     DEFINE_COMP_OP(OP_LE, <=);
 
     CASE(OP_STOP) {
-      pic_value val;
-
-      val = POP();
 
 #if VM_DEBUG
       puts("**VM END STATE**");
       printf("stbase\t= %p\nsp\t= %p\n", (void *)stbase, (void *)pic->sp);
       printf("cibase\t= %p\nci\t= %p\n", (void *)cibase, (void *)pic->ci);
-      if (stbase < pic->sp) {
+      if (stbase < pic->sp - 1) {
 	pic_value *sp;
 	printf("* stack trace:");
 	for (sp = stbase; pic->sp != sp; ++sp) {
@@ -930,14 +927,12 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 	  puts("");
 	}
       }
-      if (stbase > pic->sp) {
+      if (stbase > pic->sp - 1) {
 	puts("*** stack underflow!");
       }
 #endif
 
-      pic_gc_protect(pic, val);
-
-      return val;
+      return pic_gc_protect(pic, POP());
     }
   } VM_LOOP_END;
 }

From b29832d2c5c7168a63aae0219a0e8cee6d4df9f9 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 15:27:03 +0900
Subject: [PATCH 14/16] refactor macroexpand

---
 src/macro.c | 70 +++++++++++++++++++----------------------------------
 1 file changed, 25 insertions(+), 45 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index 89a2a3d3..2672883d 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -224,17 +224,10 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
           pic_in_library(pic, pic_cadr(pic, expr));
 
           pic_for_each (v, pic_cddr(pic, expr)) {
-            struct pic_proc *proc;
             int ai = pic_gc_arena_preserve(pic);
 
-            proc = pic_compile(pic, v);
-            if (proc == NULL) {
-              abort();
-            }
-            pic_apply_argv(pic, proc, 0);
-            if (pic_undef_p(v)) {
-              abort();
-            }
+            pic_eval(pic, v);
+
             pic_gc_arena_restore(pic, ai);
           }
 
@@ -271,7 +264,6 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 
       else if (tag == pic->sDEFINE_SYNTAX) {
 	pic_value var, val;
-	struct pic_proc *proc;
         pic_sym uniq;
         struct pic_macro *mac;
 
@@ -290,16 +282,12 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
         xh_put_int(senv->name, pic_sym(var), uniq);
 
 	val = pic_cadr(pic, pic_cdr(pic, expr));
-	proc = pic_compile(pic, val);
-	if (pic->err) {
-	  printf("macroexpand error: %s\n", pic_errmsg(pic));
-	  abort();
-	}
-	v = pic_apply(pic, proc, pic_nil_value());
-	if (pic->err) {
-	  printf("macroexpand error: %s\n", pic_errmsg(pic));
-	  abort();
-	}
+
+        pic_try {
+          v = pic_eval(pic, val);
+        } pic_catch {
+	  pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
+        }
 	assert(pic_proc_p(v));
 
         mac = macro_new(pic, pic_proc_ptr(v), senv);
@@ -311,7 +299,6 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 
       else if (tag == pic->sDEFINE_MACRO) {
 	pic_value var, val;
-	struct pic_proc *proc;
         pic_sym uniq;
         struct pic_macro *mac;
 
@@ -339,16 +326,11 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
         uniq = pic_gensym(pic, pic_sym(var));
         xh_put_int(senv->name, pic_sym(var), uniq);
 
-	proc = pic_compile(pic, val);
-	if (pic->err) {
-	  printf("macroexpand error: %s\n", pic_errmsg(pic));
-	  abort();
-	}
-	v = pic_apply(pic, proc, pic_nil_value());
-	if (pic->err) {
-	  printf("macroexpand error: %s\n", pic_errmsg(pic));
-	  abort();
-	}
+        pic_try {
+          v = pic_eval(pic, val);
+        } pic_catch {
+	  pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
+        }
 	assert(pic_proc_p(v));
 
         mac = macro_new(pic, pic_proc_ptr(v), NULL);
@@ -441,7 +423,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 
       /* macro */
       if ((e = xh_get_int(pic->macros, tag)) != NULL) {
-        pic_value v;
+        pic_value v, args;
         struct pic_macro *mac;
 
 #if DEBUG
@@ -452,19 +434,17 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 
         mac = (struct pic_macro *)e->val;
 	if (mac->senv == NULL) { /* legacy macro */
-	  v = pic_apply(pic, mac->proc, pic_cdr(pic, expr));
-	  if (pic->err) {
-	    printf("macroexpand error: %s\n", pic_errmsg(pic));
-	    abort();
-	  }
-	}
-	else {
-	  v = pic_apply_argv(pic, mac->proc, 3, expr, pic_obj_value(senv), pic_obj_value(mac->senv));
-	  if (pic->err) {
-	    printf("macroexpand error: %s\n", pic_errmsg(pic));
-	    abort();
-	  }
-	}
+          args = pic_cdr(pic, expr);
+        }
+        else {
+          args = pic_list3(pic, expr, pic_obj_value(senv), pic_obj_value(mac->senv));
+        }
+
+        pic_try {
+          v = pic_apply(pic, mac->proc, args);
+        } pic_catch {
+          pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
+        }
 	pic_gc_arena_restore(pic, ai);
 	pic_gc_protect(pic, v);
 

From b61da9bc471a91eee697472c91d55db6a901eeb5 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 15:30:32 +0900
Subject: [PATCH 15/16] use UNREACHABLE macro

---
 src/macro.c | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index 2672883d..6142570f 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -488,8 +488,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
     pic_error(pic, "unexpected value type");
     return pic_undef_value();	/* unreachable */
   }
-  /* suppress warnings, never be called */
-  abort();
+  UNREACHABLE();
 }
 
 static pic_value

From bccfc1f08dab5b2224ee3db191b06a18e0bea24d Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 24 Mar 2014 15:30:44 +0900
Subject: [PATCH 16/16] throw error when macro definition evaluates to
 non-procedure object

---
 src/macro.c | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index 6142570f..e6f5db1d 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -288,7 +288,10 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
         } pic_catch {
 	  pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
         }
-	assert(pic_proc_p(v));
+
+        if (! pic_proc_p(v)) {
+          pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
+        }
 
         mac = macro_new(pic, pic_proc_ptr(v), senv);
         xh_put_int(pic->macros, uniq, (long)mac);
@@ -331,7 +334,10 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
         } pic_catch {
 	  pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
         }
-	assert(pic_proc_p(v));
+
+        if (! pic_proc_p(v)) {
+          pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
+        }
 
         mac = macro_new(pic, pic_proc_ptr(v), NULL);
         xh_put_int(pic->macros, uniq, (long)mac);