conservatory/picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

error report is propagated through pic->err

Browse Source
This commit is contained in:
Yuichi Nishiwaki
2014-02-11 13:21:00 +09:00
parent 468e1b4d1f
commit 372fd3157b
9 changed files with 59 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/error.c
+18 -3
View File
@@ -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
+8 -2
View File
@@ -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
+1 -1
View File
@@ -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
+12 -12
View File
@@ -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) {
printf("macroexpand error: %s\n", pic->errmsg);
if (pic->err) {
printf("macroexpand error: %s\n", pic_errmsg(pic));
abort();
}
v = pic_apply(pic, proc, pic_nil_value());
if (pic->errmsg) {
printf("macroexpand error: %s\n", pic->errmsg);
if (pic->err) {
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) {
printf("macroexpand error: %s\n", pic->errmsg);
if (pic->err) {
printf("macroexpand error: %s\n", pic_errmsg(pic));
abort();
}
v = pic_apply(pic, proc, pic_nil_value());
if (pic->errmsg) {
printf("macroexpand error: %s\n", pic->errmsg);
if (pic->err) {
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) {
printf("macroexpand error: %s\n", pic->errmsg);
if (pic->err) {
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) {
printf("macroexpand error: %s\n", pic->errmsg);
if (pic->err) {
printf("macroexpand error: %s\n", pic_errmsg(pic));
abort();
}
}
src/state.c
+1 -1
View File
@@ -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
+7 -10
View File
@@ -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";
goto L_RAISE;
pic_error(pic, "invalid application");
}
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";
goto L_RAISE;
pic_error(pic, "wrong number of arguments");
}
}
/* 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"; \
goto L_RAISE; \
pic_error(pic, #op " got non-number operands"); \
} \
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();
}