Merge branch 'issue-99'. close #99

include/picrin.h

@@ -187,6 +187,7 @@ noreturn void pic_abort(pic_state *, const char *);
 noreturn void pic_errorf(pic_state *, const char *, ...);
 void pic_warnf(pic_state *, const char *, ...);
 pic_str *pic_get_backtrace(pic_state *);
+void pic_print_backtrace(pic_state *, struct pic_error *);
 
 /* obsoleted */
 noreturn static inline void pic_error(pic_state *pic, const char *msg)

include/picrin/error.h

@@ -11,6 +11,9 @@ extern "C" {
 
 struct pic_jmpbuf {
   jmp_buf here;
+  pic_callinfo *ci;
+  pic_value *sp;
+  pic_code *ip;
   jmp_buf *prev_jmp;
   struct pic_jmpbuf *prev;
 };
@@ -41,6 +44,7 @@ struct pic_error {
   } type;
   struct pic_string *msg;
   pic_value irrs;
+  pic_str *stack;
 };
 
 #define pic_error_p(v) (pic_type(v) == PIC_TT_ERROR)

src/debug.c

@@ -14,11 +14,38 @@ pic_get_backtrace(pic_state *pic)
   pic_callinfo *ci;
   pic_str *trace;
 
+  trace = pic_str_new(pic, NULL, 0);
+
+  for (ci = pic->ci; ci != pic->cibase; --ci) {
+    struct pic_proc *proc = pic_proc_ptr(ci->fp[0]);
+
+    trace = pic_strcat(pic, trace, pic_str_new_cstr(pic, "  at "));
+    trace = pic_strcat(pic, trace, pic_str_new_cstr(pic, pic_symbol_name(pic, pic_proc_name(proc))));
+
+    if (pic_proc_func_p(proc)) {
+      trace = pic_strcat(pic, trace, pic_str_new_cstr(pic, " (native function)\n"));
+    } else if (pic_proc_irep_p(proc)) {
+      trace = pic_strcat(pic, trace, pic_str_new_cstr(pic, " (unknown location)\n")); /* TODO */
+    }
+  }
+
+  pic_gc_arena_restore(pic, ai);
+  pic_gc_protect(pic, pic_obj_value(trace));
+
+  return trace;
+}
+
+void
+pic_print_backtrace(pic_state *pic, struct pic_error *e)
+{
+  int ai = pic_gc_arena_preserve(pic);
+  pic_str *trace;
+
   assert(pic->err != NULL);
 
   trace = pic_str_new(pic, NULL, 0);
 
-  switch (pic->err->type) {
+  switch (e->type) {
   case PIC_ERROR_OTHER:
     trace = pic_strcat(pic, trace, pic_str_new_cstr(pic, "error: "));
     break;
@@ -33,25 +60,15 @@ pic_get_backtrace(pic_state *pic)
     break;
   }
 
-  trace = pic_strcat(pic, trace, pic->err->msg);
+  trace = pic_strcat(pic, trace, e->msg);
 
   /* TODO: print error irritants */
 
-  for (ci = pic->ci; ci != pic->cibase; --ci) {
-    struct pic_proc *proc = pic_proc_ptr(ci->fp[0]);
+  trace = pic_strcat(pic, trace, pic_str_new(pic, "\n", 1));
+  trace = pic_strcat(pic, trace, e->stack);
 
-    trace = pic_strcat(pic, trace, pic_str_new_cstr(pic, "\n  at "));
-    trace = pic_strcat(pic, trace, pic_str_new_cstr(pic, pic_symbol_name(pic, pic_proc_name(proc))));
-
-    if (pic_proc_func_p(proc)) {
-      trace = pic_strcat(pic, trace, pic_str_new_cstr(pic, " (native function)"));
-    } else if (pic_proc_irep_p(proc)) {
-      trace = pic_strcat(pic, trace, pic_str_new_cstr(pic, " (unknown location)")); /* TODO */
-    }
-  }
+  /* print! */
+  printf("%s", pic_str_cstr(trace));
 
   pic_gc_arena_restore(pic, ai);
-  pic_gc_protect(pic, pic_obj_value(trace));
-
-  return trace;
 }

src/error.c

@@ -41,6 +41,10 @@ pic_push_try(pic_state *pic)
 
   try_jmp = pic_alloc(pic, sizeof(struct pic_jmpbuf));
 
+  try_jmp->ci = pic->ci;
+  try_jmp->sp = pic->sp;
+  try_jmp->ip = pic->ip;
+
   try_jmp->prev_jmp = pic->jmp;
   pic->jmp = &try_jmp->here;
 
@@ -55,6 +59,10 @@ pic_pop_try(pic_state *pic)
 
   assert(pic->jmp == &pic->try_jmps->here);
 
+  pic->ci = pic->try_jmps->ci;
+  pic->sp = pic->try_jmps->sp;
+  pic->ip = pic->try_jmps->ip;
+
   pic->jmp = pic->try_jmps->prev_jmp;
 
   prev = pic->try_jmps->prev;
@@ -96,6 +104,7 @@ pic_errorf(pic_state *pic, const char *fmt, ...)
   e->type = PIC_ERROR_OTHER;
   e->msg = pic_str_ptr(pic_car(pic, err_line));
   e->irrs = pic_cdr(pic, err_line);
+  e->stack = pic_get_backtrace(pic);
 
   pic_throw(pic, e);
 }
@@ -133,6 +142,7 @@ pic_error_raise(pic_state *pic)
   e->type = PIC_ERROR_RAISED;
   e->msg = pic_str_new_cstr(pic, "object is raised");
   e->irrs = pic_list1(pic, v);
+  e->stack = pic_get_backtrace(pic);
 
   pic_throw(pic, e);
 }
@@ -151,6 +161,7 @@ pic_error_error(pic_state *pic)
   e->type = PIC_ERROR_OTHER;
   e->msg = str;
   e->irrs = pic_list_by_array(pic, argc, argv);
+  e->stack = pic_get_backtrace(pic);
 
   pic_throw(pic, e);
 }

src/gc.c

@@ -391,6 +391,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     struct pic_error *err = (struct pic_error *)obj;
     gc_mark_object(pic,(struct pic_object *)err->msg);
     gc_mark(pic, err->irrs);
+    gc_mark_object(pic, (struct pic_object *)err->stack);
     break;
   }
   case PIC_TT_STRING: {

tools/main.c

@@ -142,7 +142,7 @@ repl(pic_state *pic)
       }
     }
     pic_catch {
-      printf("%s\n", pic_str_cstr(pic_get_backtrace(pic)));
+      pic_print_backtrace(pic, pic->err);
       pic->err = NULL;
       code[0] = '\0';
     }