error report is propagated through pic->err

include/picrin.h

@@ -110,7 +110,7 @@ typedef struct {
   struct pic_lib *lib;
 
   jmp_buf *jmp;
-  const char *errmsg;
+  struct pic_error *err;
 
   struct pic_heap *heap;
   struct pic_object *arena[PIC_ARENA_SIZE];
@@ -210,6 +210,8 @@ NORETURN void pic_error(pic_state *, const char *);
 NORETURN void pic_errorf(pic_state *, const char *, size_t, ...);
 void pic_warn(pic_state *, const char *);
 
+const char *pic_errmsg(pic_state *);
+
 void pic_debug(pic_state *, pic_value);
 void pic_fdebug(pic_state *, pic_value, XFILE *);
 

include/picrin/error.h

@@ -14,9 +14,10 @@ struct pic_error {
   enum pic_error_kind {
     PIC_ERROR_OTHER,
     PIC_ERROR_FILE,
-    PIC_ERROR_READ
+    PIC_ERROR_READ,
+    PIC_ERROR_RAISED
   } type;
-  char *msg;
+  struct pic_string *msg;
   pic_value irrs;
 };
 

src/error.c

@@ -11,10 +11,25 @@
 #include "picrin/proc.h"
 #include "picrin/error.h"
 
+const char *
+pic_errmsg(pic_state *pic)
+{
+  assert(pic->err != NULL);
+
+  return pic->err->msg->str;
+}
+
 void
 pic_error(pic_state *pic, const char *msg)
 {
-  pic->errmsg = msg;
+  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 = pic_str_new_cstr(pic, msg);
+  e->irrs = pic_nil_value();
+
+  pic->err = e;
   if (! pic->jmp) {
     puts(msg);
     abort();
@@ -131,7 +146,7 @@ pic_error_error(pic_state *pic)
 
   e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TT_ERROR);
   e->type = PIC_ERROR_OTHER;
-  e->msg = pic_strdup(pic, str);
+  e->msg = pic_str_new_cstr(pic, str);
   e->irrs = pic_list_by_array(pic, argc, argv);
 
   pic_raise(pic, pic_obj_value(e));
@@ -154,7 +169,7 @@ pic_error_error_object_message(pic_state *pic)
 
   pic_get_args(pic, "e", &e);
 
-  return pic_obj_value(pic_str_new_cstr(pic, e->msg));
+  return pic_obj_value(e->msg);
 }
 
 static pic_value

src/gc.c

@@ -335,7 +335,9 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     break;
   }
   case PIC_TT_ERROR: {
-    gc_mark(pic, ((struct pic_error *)obj)->irrs);
+    struct pic_error *err = (struct pic_error *)obj;
+    gc_mark_object(pic,(struct pic_object *)err->msg);
+    gc_mark(pic, err->irrs);
     break;
   }
   case PIC_TT_STRING: {
@@ -497,6 +499,11 @@ gc_mark_phase(pic_state *pic)
     gc_mark_object(pic, (struct pic_object *)pic->rescue[i]);
   }
 
+  /* error object */
+  if (pic->err) {
+    gc_mark_object(pic, (struct pic_object *)pic->err);
+  }
+
   /* arena */
   for (j = 0; j < pic->arena_idx; ++j) {
     gc_mark_object(pic, pic->arena[j]);
@@ -547,7 +554,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     break;
   }
   case PIC_TT_ERROR: {
-    pic_free(pic, ((struct pic_error *)obj)->msg);
     break;
   }
   case PIC_TT_CONT: {

src/init.c

@@ -42,7 +42,7 @@ pic_load_stdlib(pic_state *pic)
   else {
     /* error! */
     fputs("fatal error: failure in loading built-in.scm\n", stderr);
-    fputs(pic->errmsg, stderr);
+    fputs(pic_errmsg(pic), stderr);
     abort();
   }
 

src/macro.c

@@ -368,13 +368,13 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 
 	val = pic_cadr(pic, pic_cdr(pic, expr));
 	proc = pic_compile(pic, val);
-	if (pic->errmsg) {
+	if (pic->err) {
-	  printf("macroexpand error: %s\n", pic->errmsg);
+	  printf("macroexpand error: %s\n", pic_errmsg(pic));
 	  abort();
 	}
 	v = pic_apply(pic, proc, pic_nil_value());
-	if (pic->errmsg) {
+	if (pic->err) {
-	  printf("macroexpand error: %s\n", pic->errmsg);
+	  printf("macroexpand error: %s\n", pic_errmsg(pic));
 	  abort();
 	}
 	assert(pic_proc_p(v));
@@ -410,13 +410,13 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 	}
 
 	proc = pic_compile(pic, val);
-	if (pic->errmsg) {
+	if (pic->err) {
-	  printf("macroexpand error: %s\n", pic->errmsg);
+	  printf("macroexpand error: %s\n", pic_errmsg(pic));
 	  abort();
 	}
 	v = pic_apply(pic, proc, pic_nil_value());
-	if (pic->errmsg) {
+	if (pic->err) {
-	  printf("macroexpand error: %s\n", pic->errmsg);
+	  printf("macroexpand error: %s\n", pic_errmsg(pic));
 	  abort();
 	}
 	assert(pic_proc_p(v));
@@ -428,15 +428,15 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
       case PIC_STX_MACRO: {
 	if (pic_syntax(car)->senv == NULL) { /* legacy macro */
 	  v = pic_apply(pic, pic_syntax(car)->macro, pic_cdr(pic, expr));
-	  if (pic->errmsg) {
+	  if (pic->err) {
-	    printf("macroexpand error: %s\n", pic->errmsg);
+	    printf("macroexpand error: %s\n", pic_errmsg(pic));
 	    abort();
 	  }
 	}
 	else {
 	  v = pic_apply_argv(pic, pic_syntax(car)->macro, 3, expr, pic_obj_value(senv), pic_obj_value(pic_syntax(car)->senv));
-	  if (pic->errmsg) {
+	  if (pic->err) {
-	    printf("macroexpand error: %s\n", pic->errmsg);
+	    printf("macroexpand error: %s\n", pic_errmsg(pic));
 	    abort();
 	  }
 	}

src/state.c

@@ -70,7 +70,7 @@ pic_open(int argc, char *argv[], char **envp)
 
   /* error handling */
   pic->jmp = NULL;
-  pic->errmsg = NULL;
+  pic->err = NULL;
 
   /* GC arena */
   pic->arena_idx = 0;

src/vm.c

@@ -539,8 +539,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 #if DEBUG
 	pic_debug(pic, x);
 #endif
-	pic->errmsg = "invalid application";
+	pic_error(pic, "invalid application");
-	goto L_RAISE;
       }
       proc = pic_proc_ptr(x);
 
@@ -586,8 +585,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 
 	if (ci->argc != proc->u.irep->argc) {
 	  if (! (proc->u.irep->varg && ci->argc >= proc->u.irep->argc)) {
-	    pic->errmsg = "wrong number of arguments";
+            pic_error(pic, "wrong number of arguments");
-	    goto L_RAISE;
 	  }
 	}
 	/* prepare rest args */
@@ -643,7 +641,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       pic_value v;
       pic_callinfo *ci;
 
-      if (pic->errmsg) {
+      if (pic->err) {
 
       L_RAISE:
 	goto L_STOP;
@@ -726,8 +724,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 	PUSH(pic_float_value(pic_float(a) op pic_int(b)));	\
       }								\
       else {							\
-	pic->errmsg = #op " got non-number operands";		\
+	pic_error(pic, #op " got non-number operands");		\
-	goto L_RAISE;						\
       }								\
       NEXT;							\
     }
@@ -747,7 +744,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 	PUSH(pic_float_value(-pic_float(n)));
       }
       else {
-	pic->errmsg = "unary - got a non-number operand";
+	pic_error(pic, "unary - got a non-number operand");
       }
       NEXT;
     }
@@ -770,7 +767,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 	PUSH(pic_bool_value(pic_float(a) op pic_int(b)));	\
       }								\
       else {							\
-	pic->errmsg = #op " got non-number operands";		\
+	pic_error(pic, #op " got non-number operands");		\
 	goto L_RAISE;						\
       }								\
       NEXT;							\
@@ -787,7 +784,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       val = POP();
 
       pic->jmp = prev_jmp;
-      if (pic->errmsg) {
+      if (pic->err) {
 	return pic_undef_value();
       }
 

tools/main.c

@@ -124,14 +124,14 @@ repl(pic_state *pic)
       /* eval */
       proc = pic_compile(pic, v);
       if (proc == NULL) {
-	printf("compilation error: %s\n", pic->errmsg);
+	printf("compilation error: %s\n", pic_errmsg(pic));
-	pic->errmsg = NULL;
+	pic->err = NULL;
 	goto next;
       }
       v = pic_apply(pic, proc, pic_nil_value());
       if (pic_undef_p(v)) {
-	printf("runtime error: %s\n", pic->errmsg);
+	printf("runtime error: %s\n", pic_errmsg(pic));
-	pic->errmsg = NULL;
+	pic->err = NULL;
 	goto next;
       }
 
@@ -185,14 +185,14 @@ exec_file(pic_state *pic, const char *fname)
 
     proc = pic_compile(pic, v);
     if (proc == NULL) {
-      fputs(pic->errmsg, stderr);
+      fputs(pic_errmsg(pic), stderr);
       fprintf(stderr, "fatal error: %s compilation failure\n", fname);
       goto abort;
     }
 
     v = pic_apply(pic, proc, pic_nil_value());
     if (pic_undef_p(v)) {
-      fputs(pic->errmsg, stderr);
+      fputs(pic_errmsg(pic), stderr);
       fprintf(stderr, "fatal error: %s evaluation failure\n", fname);
       goto abort;
     }