Merge branch 'fix-try-catch'

cont.c

@@ -57,25 +57,8 @@ pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, st
   return val;
 }
 
-struct pic_escape {
+void
-  jmp_buf jmp;
+pic_save_point(pic_state *pic, struct pic_escape *escape)
-
-  bool valid;
-
-  struct pic_winder *wind;
-
-  ptrdiff_t sp_offset;
-  ptrdiff_t ci_offset;
-  ptrdiff_t xp_offset;
-  int arena_idx;
-
-  pic_code *ip;
-
-  pic_value results;
-};
-
-static int
-save_point(pic_state *pic, struct pic_escape *escape)
 {
   escape->valid = true;
 
@@ -88,12 +71,10 @@ save_point(pic_state *pic, struct pic_escape *escape)
   escape->ip = pic->ip;
 
   escape->results = pic_undef_value();
-
-  return setjmp(escape->jmp);
 }
 
-noreturn static void
+void
-load_point(pic_state *pic, struct pic_escape *escape)
+pic_load_point(pic_state *pic, struct pic_escape *escape)
 {
   if (! escape->valid) {
     pic_errorf(pic, "calling dead escape continuation");
@@ -109,7 +90,7 @@ load_point(pic_state *pic, struct pic_escape *escape)
   pic->arena_idx = escape->arena_idx;
   pic->ip = escape->ip;
 
-  longjmp(escape->jmp, 1);
+  escape->valid = false;
 }
 
 noreturn static pic_value
@@ -123,33 +104,42 @@ escape_call(pic_state *pic)
 
   e = pic_data_ptr(pic_attr_ref(pic, pic_get_proc(pic), "@@escape"));
 
-  load_point(pic, e->data);
+  pic_load_point(pic, e->data);
+
+  longjmp(((struct pic_escape *)e->data)->jmp, 1);
+}
+
+struct pic_proc *
+pic_make_econt(pic_state *pic, struct pic_escape *escape)
+{
+  static const pic_data_type escape_type = { "escape", pic_free, NULL };
+  struct pic_proc *cont;
+  struct pic_data *e;
+
+  cont = pic_make_proc(pic, escape_call, "<escape-procedure>");
+
+  e = pic_data_alloc(pic, &escape_type, escape);
+
+  /* save the escape continuation in proc */
+  pic_attr_set(pic, cont, "@@escape", pic_obj_value(e));
+
+  return cont;
 }
 
 pic_value
 pic_escape(pic_state *pic, struct pic_proc *proc)
 {
-  static const pic_data_type escape_type = { "escape", pic_free, NULL };
+  struct pic_escape *escape = pic_alloc(pic, sizeof(struct pic_escape));
-  struct pic_escape *escape;
 
-  escape = pic_alloc(pic, sizeof(struct pic_escape));
+  pic_save_point(pic, escape);
 
-  if (save_point(pic, escape)) {
+  if (setjmp(escape->jmp)) {
     return pic_values_by_list(pic, escape->results);
   }
   else {
-    struct pic_proc *c;
     pic_value val;
-    struct pic_data *e;
 
-    c = pic_make_proc(pic, escape_call, "<escape-procedure>");
+    val = pic_apply1(pic, proc, pic_obj_value(pic_make_econt(pic, escape)));
-
-    e = pic_data_alloc(pic, &escape_type, escape);
-
-    /* save the escape continuation in proc */
-    pic_attr_set(pic, c, "@@escape", pic_obj_value(e));
-
-    val = pic_apply1(pic, proc, pic_obj_value(c));
 
     escape->valid = false;
 

error.c

@@ -10,6 +10,7 @@
 #include "picrin/pair.h"
 #include "picrin/proc.h"
 #include "picrin/cont.h"
+#include "picrin/data.h"
 #include "picrin/string.h"
 #include "picrin/error.h"
 
@@ -68,7 +69,7 @@ pic_errmsg(pic_state *pic)
   return pic_str_cstr(str);
 }
 
-static pic_value
+noreturn static pic_value
 native_exception_handler(pic_state *pic)
 {
   pic_value err;
@@ -85,13 +86,13 @@ native_exception_handler(pic_state *pic)
   UNREACHABLE();
 }
 
-static pic_value
+void
-native_push_try(pic_state *pic)
+pic_push_try(pic_state *pic, struct pic_escape *escape)
 {
   struct pic_proc *cont, *handler;
   size_t xp_len, xp_offset;
 
-  pic_get_args(pic, "l", &cont);
+  cont = pic_make_econt(pic, escape);
 
   handler = pic_make_proc(pic, native_exception_handler, "(native-exception-handler)");
 
@@ -106,24 +107,24 @@ native_push_try(pic_state *pic)
   }
 
   *pic->xp++ = handler;
-
-  return pic_true_value();
-}
-
-bool
-pic_push_try(pic_state *pic)
-{
-  pic_value val;
-
-  val = pic_escape(pic, pic_make_proc(pic, native_push_try, "(native-push-try)"));
-
-  return pic_test(val);
 }
 
 void
 pic_pop_try(pic_state *pic)
 {
-  --pic->xp;
+  pic_value cont, escape;
+
+  assert(pic->xp > pic->xpbase);
+
+  cont = pic_attr_ref(pic, *--pic->xp, "@@escape");
+
+  assert(pic_proc_p(cont));
+
+  escape = pic_attr_ref(pic, pic_proc_ptr(cont), "@@escape");
+
+  assert(pic_data_p(escape));
+
+  ((struct pic_escape *)pic_data_ptr(escape)->data)->valid = false;
 }
 
 struct pic_error *

include/picrin/cont.h

@@ -9,6 +9,28 @@
 extern "C" {
 #endif
 
+struct pic_escape {
+  jmp_buf jmp;
+
+  bool valid;
+
+  struct pic_winder *wind;
+
+  ptrdiff_t sp_offset;
+  ptrdiff_t ci_offset;
+  ptrdiff_t xp_offset;
+  int arena_idx;
+
+  pic_code *ip;
+
+  pic_value results;
+};
+
+void pic_save_point(pic_state *, struct pic_escape *);
+void pic_load_point(pic_state *, struct pic_escape *);
+
+struct pic_proc *pic_make_econt(pic_state *, struct pic_escape *);
+
 void pic_wind(pic_state *, struct pic_winder *, struct pic_winder *);
 pic_value pic_dynamic_wind(pic_state *, struct pic_proc *, struct pic_proc *, struct pic_proc *);
 

include/picrin/error.h

@@ -9,6 +9,8 @@
 extern "C" {
 #endif
 
+#include "picrin/cont.h"
+
 struct pic_error {
   PIC_OBJECT_HEADER
   pic_sym type;
@@ -25,14 +27,19 @@ struct pic_error *pic_make_error(pic_state *, pic_sym, const char *, pic_list);
 /* do not return from try block! */
 
 #define pic_try                                 \
-  if (pic_push_try(pic))                        \
+  pic_try_(GENSYM(escape))
+#define pic_try_(escape)                                                \
+  struct pic_escape *escape = pic_alloc(pic, sizeof(struct pic_escape)); \
+  pic_save_point(pic, escape);                                          \
+  if (setjmp(escape->jmp) == 0) {                                       \
+    pic_push_try(pic, escape);                                          \
     do
 #define pic_catch                                         \
-    while (pic_pop_try(pic), 0);                \
+    while (0);                                            \
-  else                                          \
+    pic_pop_try(pic);                                     \
-    if (pic_pop_try(pic), 1)
+  } else
 
-bool pic_push_try(pic_state *);
+void pic_push_try(pic_state *, struct pic_escape *);
 void pic_pop_try(pic_state *);
 
 pic_value pic_raise_continuable(pic_state *, pic_value);