picrin/extlib/benz/error.c

251 lines
4.6 KiB
C
Raw Normal View History

2014-08-25 00:38:09 -04:00
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
void
2015-05-28 04:06:41 -04:00
pic_panic(pic_state PIC_UNUSED(*pic), const char *msg)
2014-08-25 00:38:09 -04:00
{
2015-07-19 13:52:47 -04:00
extern PIC_NORETURN void abort();
2015-05-27 13:12:26 -04:00
#if DEBUG
2014-08-25 00:38:09 -04:00
fprintf(stderr, "abort: %s\n", msg);
2015-05-27 13:12:26 -04:00
#else
2015-05-28 04:06:41 -04:00
(void)msg;
2015-05-27 13:12:26 -04:00
#endif
PIC_ABORT(pic);
2014-08-25 00:38:09 -04:00
}
void
pic_warnf(pic_state *pic, const char *fmt, ...)
{
va_list ap;
pic_value err_line;
va_start(ap, fmt);
2014-08-26 00:30:08 -04:00
err_line = pic_xvformat(pic, fmt, ap);
2014-08-25 00:38:09 -04:00
va_end(ap);
2015-06-18 13:05:56 -04:00
xfprintf(pic, pic_stderr(pic)->file, "warn: %s\n", pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line))));
2014-08-25 00:38:09 -04:00
}
2014-09-17 08:58:51 -04:00
void
pic_errorf(pic_state *pic, const char *fmt, ...)
{
va_list ap;
pic_value err_line, irrs;
const char *msg;
va_start(ap, fmt);
err_line = pic_xvformat(pic, fmt, ap);
va_end(ap);
msg = pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line)));
2014-09-17 08:58:51 -04:00
irrs = pic_cdr(pic, err_line);
pic_error(pic, msg, irrs);
}
2015-06-01 18:57:52 -04:00
pic_value
pic_native_exception_handler(pic_state *pic)
{
pic_value err;
struct pic_proc *cont;
pic_get_args(pic, "o", &err);
pic->err = err;
2015-06-01 06:47:40 -04:00
cont = pic_proc_ptr(pic_proc_env_ref(pic, pic_get_proc(pic), "cont"));
pic_apply1(pic, cont, pic_false_value());
2015-01-07 16:11:48 -05:00
PIC_UNREACHABLE();
}
2014-09-24 07:21:28 -04:00
void
2015-06-01 18:57:52 -04:00
pic_push_handler(pic_state *pic, struct pic_proc *handler)
2014-08-25 00:38:09 -04:00
{
size_t xp_len;
ptrdiff_t xp_offset;
2014-09-24 07:21:28 -04:00
if (pic->xp >= pic->xpend) {
xp_len = (size_t)(pic->xpend - pic->xpbase) * 2;
2014-09-24 07:21:28 -04:00
xp_offset = pic->xp - pic->xpbase;
pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct pic_proc *) * xp_len);
pic->xp = pic->xpbase + xp_offset;
pic->xpend = pic->xpbase + xp_len;
}
2014-09-24 07:21:28 -04:00
*pic->xp++ = handler;
}
2014-08-25 00:38:09 -04:00
2015-06-01 18:57:52 -04:00
struct pic_proc *
pic_pop_handler(pic_state *pic)
{
2015-06-01 18:57:52 -04:00
if (pic->xp == pic->xpbase) {
pic_panic(pic, "no exception handler registered");
}
return *--pic->xp;
2014-08-25 00:38:09 -04:00
}
2014-09-16 11:43:03 -04:00
struct pic_error *
2015-01-20 02:02:28 -05:00
pic_make_error(pic_state *pic, pic_sym *type, const char *msg, pic_value irrs)
2014-08-25 00:38:09 -04:00
{
struct pic_error *e;
pic_str *stack;
stack = pic_get_backtrace(pic);
e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TT_ERROR);
e->type = type;
2014-09-16 11:43:03 -04:00
e->msg = pic_make_str_cstr(pic, msg);
2014-08-25 00:38:09 -04:00
e->irrs = irrs;
e->stack = stack;
return e;
}
2014-09-17 08:58:51 -04:00
pic_value
pic_raise_continuable(pic_state *pic, pic_value err)
{
struct pic_proc *handler;
2014-09-17 08:58:51 -04:00
pic_value v;
2015-06-01 18:57:52 -04:00
handler = pic_pop_handler(pic);
pic_gc_protect(pic, pic_obj_value(handler));
2014-09-18 01:50:01 -04:00
v = pic_apply1(pic, handler, err);
2015-06-01 18:57:52 -04:00
pic_push_handler(pic, handler);
return v;
}
2015-01-07 16:11:48 -05:00
void
pic_raise(pic_state *pic, pic_value err)
{
pic_value val;
2014-08-25 00:38:09 -04:00
val = pic_raise_continuable(pic, err);
2014-08-25 00:38:09 -04:00
2015-06-01 18:57:52 -04:00
pic_pop_handler(pic);
2014-08-25 00:38:09 -04:00
pic_errorf(pic, "error handler returned with ~s on error ~s", val, err);
2014-08-25 00:38:09 -04:00
}
2015-01-07 16:11:48 -05:00
void
2015-06-04 00:23:20 -04:00
pic_error(pic_state *pic, const char *msg, pic_value irrs)
2014-08-25 00:38:09 -04:00
{
struct pic_error *e;
2015-07-12 19:16:04 -04:00
e = pic_make_error(pic, pic_intern(pic, ""), msg, irrs);
2014-08-25 00:38:09 -04:00
2014-09-16 11:28:55 -04:00
pic_raise(pic, pic_obj_value(e));
}
2014-08-25 00:38:09 -04:00
static pic_value
pic_error_with_exception_handler(pic_state *pic)
{
struct pic_proc *handler, *thunk;
2014-09-16 11:28:55 -04:00
pic_value val;
2014-08-25 00:38:09 -04:00
pic_get_args(pic, "ll", &handler, &thunk);
2015-06-01 18:57:52 -04:00
pic_push_handler(pic, handler);
val = pic_apply0(pic, thunk);
2015-06-01 18:57:52 -04:00
pic_pop_handler(pic);
2014-09-16 11:28:55 -04:00
return val;
2014-08-25 00:38:09 -04:00
}
2015-01-07 16:11:48 -05:00
static pic_value
2014-08-25 00:38:09 -04:00
pic_error_raise(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
2014-09-16 11:28:55 -04:00
pic_raise(pic, v);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_error_raise_continuable(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
2014-09-17 08:58:51 -04:00
return pic_raise_continuable(pic, v);
2014-08-25 00:38:09 -04:00
}
2015-01-07 16:11:48 -05:00
static pic_value
2014-08-25 00:38:09 -04:00
pic_error_error(pic_state *pic)
{
const char *str;
2015-08-26 06:04:27 -04:00
int argc;
2014-08-25 00:38:09 -04:00
pic_value *argv;
pic_get_args(pic, "z*", &str, &argc, &argv);
2014-09-16 11:28:55 -04:00
pic_error(pic, str, pic_list_by_array(pic, argc, argv));
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_error_error_object_p(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
return pic_bool_value(pic_error_p(v));
}
static pic_value
pic_error_error_object_message(pic_state *pic)
{
struct pic_error *e;
pic_get_args(pic, "e", &e);
return pic_obj_value(e->msg);
}
static pic_value
pic_error_error_object_irritants(pic_state *pic)
{
struct pic_error *e;
pic_get_args(pic, "e", &e);
return e->irrs;
}
static pic_value
pic_error_error_object_type(pic_state *pic)
2014-08-25 00:38:09 -04:00
{
struct pic_error *e;
pic_get_args(pic, "e", &e);
2014-09-16 11:28:55 -04:00
2015-01-18 21:08:27 -05:00
return pic_obj_value(e->type);
2014-08-25 00:38:09 -04:00
}
void
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);
pic_defun(pic, "error-object-irritants", pic_error_error_object_irritants);
pic_defun(pic, "error-object-type", pic_error_error_object_type);
2014-08-25 00:38:09 -04:00
}