picrin/extlib/benz/debug.c

67 lines
1.6 KiB
C
Raw Normal View History

2014-08-25 00:38:09 -04:00
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
2016-02-20 10:58:58 -05:00
#include "picrin/extra.h"
2016-02-20 11:13:16 -05:00
#include "picrin/private/object.h"
#include "picrin/private/state.h"
2014-08-25 00:38:09 -04:00
2016-02-19 13:26:52 -05:00
pic_value
2014-08-25 00:38:09 -04:00
pic_get_backtrace(pic_state *pic)
{
2016-02-19 02:17:13 -05:00
size_t ai = pic_enter(pic);
2016-02-21 06:32:00 -05:00
struct callinfo *ci;
2016-02-19 13:26:52 -05:00
pic_value trace;
2014-08-25 00:38:09 -04:00
trace = pic_lit_value(pic, "");
2014-08-25 00:38:09 -04:00
for (ci = pic->ci; ci != pic->cibase; --ci) {
2016-02-19 10:03:16 -05:00
pic_value proc = ci->fp[0];
2014-08-25 00:38:09 -04:00
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " at "));
trace = pic_str_cat(pic, trace, pic_lit_value(pic, "(anonymous lambda)"));
2014-08-25 00:38:09 -04:00
2016-02-23 06:50:26 -05:00
if (pic_func_p(pic, proc)) {
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (native function)\n"));
2016-02-19 10:03:16 -05:00
} else {
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (unknown location)\n")); /* TODO */
2014-08-25 00:38:09 -04:00
}
}
2016-02-19 02:17:13 -05:00
pic_leave(pic, ai);
2016-02-19 13:26:52 -05:00
pic_protect(pic, trace);
2014-08-25 00:38:09 -04:00
return trace;
}
2016-02-22 14:37:58 -05:00
#if PIC_USE_WRITE
2014-08-25 00:38:09 -04:00
void
pic_print_error(pic_state *pic, xFILE *file)
2014-08-25 00:38:09 -04:00
{
pic_value err = pic_err(pic), port = pic_open_port(pic, file);
2014-08-25 00:38:09 -04:00
assert(! pic_invalid_p(pic, err));
if (! pic_error_p(pic, err)) {
2016-02-23 00:15:42 -05:00
pic_fprintf(pic, port, "raise: ~s", err);
2014-09-16 11:28:55 -04:00
} else {
2016-02-21 06:32:00 -05:00
struct error *e;
2015-06-19 13:34:00 -04:00
pic_value elem, it;
2014-08-25 00:38:09 -04:00
e = pic_error_ptr(pic, err);
2016-02-20 01:31:14 -05:00
if (! pic_eq_p(pic, pic_obj_value(e->type), pic_intern_lit(pic, ""))) {
2016-02-23 00:15:42 -05:00
pic_fprintf(pic, port, "~s-", pic_obj_value(e->type));
2014-09-16 11:28:55 -04:00
}
2016-02-23 00:15:42 -05:00
pic_fprintf(pic, port, "error: ~s", pic_obj_value(e->msg));
2014-08-25 00:38:09 -04:00
2015-06-19 13:34:00 -04:00
pic_for_each (elem, e->irrs, it) { /* print error irritants */
pic_fprintf(pic, port, " ~s", elem);
2015-06-19 13:34:00 -04:00
}
2016-02-23 00:15:42 -05:00
pic_fprintf(pic, port, "\n%s", pic_str(pic, pic_obj_value(e->stack)));
2014-09-16 11:28:55 -04:00
}
2014-08-25 00:38:09 -04:00
}
2016-02-22 14:37:58 -05:00
#endif