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

remove pic_get_backtrace

This commit is contained in:
Yuichi Nishiwaki 2017-04-09 15:05:59 +09:00
parent c634948bf1
commit 1d28290c14
8 changed files with 100 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lib/debug.c
View File

@ -6,34 +6,6 @@
#include "object.h"
#include "state.h"
pic_value
pic_get_backtrace(pic_state *pic)
{
size_t ai = pic_enter(pic);
struct callinfo *ci;
pic_value trace;
trace = pic_lit_value(pic, "");
for (ci = pic->ci; ci != pic->cibase; --ci) {
pic_value proc = ci->fp[0];
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " at "));
trace = pic_str_cat(pic, trace, pic_lit_value(pic, "(anonymous lambda)"));
if (pic_proc_func_p(pic, proc)) {
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (native function)\n"));
} else {
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (unknown location)\n")); /* TODO */
}
}
pic_leave(pic, ai);
pic_protect(pic, trace);
return trace;
}
#if PIC_USE_WRITE
void
@ -54,7 +26,7 @@ pic_print_error(pic_state *pic, pic_value port, pic_value err)
pic_for_each (elem, e->irrs, it) { /* print error irritants */
pic_fprintf(pic, port, " ~s", elem);
}
pic_fprintf(pic, port, "\n%s", pic_str(pic, obj_value(pic, e->stack), NULL));
pic_fprintf(pic, port, "\n");
}
}

5
lib/error.c
View File

@ -83,15 +83,12 @@ pic_value
pic_make_error(pic_state *pic, const char *type, const char *msg, pic_value irrs)
{
struct error *e;
pic_value stack, ty = pic_intern_cstr(pic, type);
stack = pic_get_backtrace(pic);
pic_value ty = pic_intern_cstr(pic, type);
e = (struct error *)pic_obj_alloc(pic, sizeof(struct error), PIC_TYPE_ERROR);
e->type = sym_ptr(pic, ty);
e->msg = str_ptr(pic, pic_cstr_value(pic, msg));
e->irrs = irrs;
e->stack = str_ptr(pic, stack);
return obj_value(pic, e);
}

3
lib/gc.c
View File

@ -370,9 +370,8 @@ gc_mark_object(pic_state *pic, struct object *obj)
}
case PIC_TYPE_ERROR: {
gc_mark_object(pic, (struct object *)obj->u.err.type);
gc_mark_object(pic, (struct object *)obj->u.err.msg);
gc_mark(pic, obj->u.err.irrs);
LOOP(obj->u.err.stack);
LOOP(obj->u.err.msg);
break;
}
case PIC_TYPE_STRING: {

1
lib/include/picrin.h
View File

@ -297,7 +297,6 @@ pic_value pic_raise_continuable(pic_state *pic, pic_value err);
PIC_NORETURN void pic_raise(pic_state *, pic_value v);
PIC_NORETURN void pic_error(pic_state *, const char *msg, int n, ...);
pic_value pic_make_error(pic_state *, const char *type, const char *msg, pic_value irrs);
pic_value pic_get_backtrace(pic_state *); /* deprecated */
#define pic_try pic_try_(PIC_GENSYM(cont), PIC_GENSYM(jmp))
#define pic_try_(cont, jmp) \
do { \

3
lib/object.h
View File

@ -151,7 +151,6 @@ struct error {
struct symbol *type;
struct string *msg;
pic_value irrs;
struct string *stack;
};
#define TYPENAME_int "integer"
@ -260,7 +259,7 @@ DEFPTR(irep, struct irep)
struct object *pic_obj_alloc(pic_state *, size_t, int type);
pic_value pic_make_proc(pic_state *, pic_func_t, int, pic_value *);
pic_value pic_make_proc_func(pic_state *, pic_func_t, int, pic_value *);
pic_value pic_make_proc_irep(pic_state *, struct irep *, struct context *);
pic_value pic_make_record(pic_state *, pic_value type, pic_value datum);
pic_value pic_record_type(pic_state *pic, pic_value record);

166
lib/proc.c
View File

@ -28,7 +28,33 @@ pic_vlambda(pic_state *pic, pic_func_t f, int n, va_list ap)
for (i = 0; i < n; ++i) {
env[i] = va_arg(ap, pic_value);
}
return pic_make_proc(pic, f, n, env);
return pic_make_proc_func(pic, f, n, env);
}
pic_value
pic_make_proc_func(pic_state *pic, pic_func_t func, int n, pic_value *env)
{
struct proc *proc;
int i;
proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals) + sizeof(pic_value) * n, PIC_TYPE_PROC_FUNC);
proc->u.f.func = func;
proc->u.f.localc = n;
for (i = 0; i < n; ++i) {
proc->locals[i] = env[i];
}
return obj_value(pic, proc);
}
pic_value
pic_make_proc_irep(pic_state *pic, struct irep *irep, struct context *cxt)
{
struct proc *proc;
proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals), PIC_TYPE_PROC_IREP);
proc->u.i.irep = irep;
proc->u.i.cxt = cxt;
return obj_value(pic, proc);
}
PIC_NORETURN static void
@ -285,6 +311,30 @@ pic_closure_set(pic_state *pic, int n, pic_value v)
proc_ptr(pic, self)->locals[n] = v;
}
pic_value
pic_call(pic_state *pic, pic_value proc, int n, ...)
{
pic_value r;
va_list ap;
va_start(ap, n);
r = pic_vcall(pic, proc, n, ap);
va_end(ap);
return r;
}
pic_value
pic_vcall(pic_state *pic, pic_value proc, int n, va_list ap)
{
pic_value *args = pic_alloca(pic, sizeof(pic_value) * n);
int i;
for (i = 0; i < n; ++i) {
args[i] = va_arg(ap, pic_value);
}
return pic_apply(pic, proc, n, args);
}
static void
vm_push_cxt(pic_state *pic)
{
@ -327,26 +377,6 @@ pic_vm_tear_off(pic_state *pic)
}
}
#if PIC_DIRECT_THREADED_VM
# define VM_LOOP JUMP;
# define CASE(x) L_##x:
# define NEXT pic->ip++; JUMP;
# define JUMP c = *pic->ip; goto *oplabels[c.insn];
# define VM_LOOP_END
#else
# define VM_LOOP for (;;) { c = *pic->ip; switch (c.insn) {
# define CASE(x) case x:
# define NEXT pic->ip++; break
# define JUMP break
# define VM_LOOP_END } }
#endif
#define PUSH(v) ((*pic->sp = (v)), pic->sp++)
#define POP() (*--pic->sp)
#define PUSHCI() (++pic->ci)
#define POPCI() (pic->ci--)
/* for arithmetic instructions */
pic_value pic_add(pic_state *, pic_value, pic_value);
pic_value pic_sub(pic_state *, pic_value, pic_value);
@ -366,6 +396,38 @@ pic_apply(pic_state *pic, pic_value proc, int argc, pic_value *argv)
struct code boot[2];
int i;
#define PUSH(v) ((*pic->sp = (v)), pic->sp++)
#define POP() (*--pic->sp)
#define PUSHCI() (++pic->ci)
#define POPCI() (pic->ci--)
PUSH(proc);
for (i = 0; i < argc; ++i) {
PUSH(argv[i]);
}
/* boot! */
boot[0].insn = OP_CALL;
boot[0].a = argc + 1;
boot[1].insn = OP_STOP;
pic->ip = boot;
#if PIC_DIRECT_THREADED_VM
# define VM_LOOP JUMP;
# define CASE(x) L_##x:
# define NEXT pic->ip++; JUMP;
# define JUMP c = *pic->ip; goto *oplabels[c.insn];
# define VM_LOOP_END
#else
# define VM_LOOP for (;;) { c = *pic->ip; switch (c.insn) {
# define CASE(x) case x:
# define NEXT pic->ip++; break
# define JUMP break
# define VM_LOOP_END } }
#endif
#if PIC_DIRECT_THREADED_VM
static const void *oplabels[] = {
&&L_OP_NOP, &&L_OP_POP, &&L_OP_PUSHUNDEF, &&L_OP_PUSHNIL, &&L_OP_PUSHTRUE,
@ -380,18 +442,6 @@ pic_apply(pic_state *pic, pic_value proc, int argc, pic_value *argv)
};
#endif
PUSH(proc);
for (i = 0; i < argc; ++i) {
PUSH(argv[i]);
}
/* boot! */
boot[0].insn = OP_CALL;
boot[0].a = argc + 1;
boot[1].insn = OP_STOP;
pic->ip = boot;
VM_LOOP {
CASE(OP_NOP) {
NEXT;
@ -793,56 +843,6 @@ pic_applyk(pic_state *pic, pic_value proc, int argc, pic_value *args)
}
}
pic_value
pic_call(pic_state *pic, pic_value proc, int n, ...)
{
pic_value r;
va_list ap;
va_start(ap, n);
r = pic_vcall(pic, proc, n, ap);
va_end(ap);
return r;
}
pic_value
pic_vcall(pic_state *pic, pic_value proc, int n, va_list ap)
{
pic_value *args = pic_alloca(pic, sizeof(pic_value) * n);
int i;
for (i = 0; i < n; ++i) {
args[i] = va_arg(ap, pic_value);
}
return pic_apply(pic, proc, n, args);
}
pic_value
pic_make_proc(pic_state *pic, pic_func_t func, int n, pic_value *env)
{
struct proc *proc;
int i;
proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals) + sizeof(pic_value) * n, PIC_TYPE_PROC_FUNC);
proc->u.f.func = func;
proc->u.f.localc = n;
for (i = 0; i < n; ++i) {
proc->locals[i] = env[i];
}
return obj_value(pic, proc);
}
pic_value
pic_make_proc_irep(pic_state *pic, struct irep *irep, struct context *cxt)
{
struct proc *proc;
proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals), PIC_TYPE_PROC_IREP);
proc->u.i.irep = irep;
proc->u.i.cxt = cxt;
return obj_value(pic, proc);
}
static pic_value
pic_proc_proc_p(pic_state *pic)
{

27
lib/state.c
View File

@ -164,9 +164,6 @@ pic_open(pic_allocf allocf, void *userdata)
/* user data */
pic->userdata = userdata;
/* turn off GC */
pic->gc_enable = false;
/* continuation chain */
pic->cc = NULL;
@ -186,7 +183,7 @@ pic_open(pic_allocf allocf, void *userdata)
goto EXIT_CI;
}
/* GC arena */
/* arena */
pic->arena = allocf(userdata, NULL, PIC_ARENA_SIZE * sizeof(struct object *));
pic->arena_size = PIC_ARENA_SIZE;
pic->arena_idx = 0;
@ -195,6 +192,9 @@ pic_open(pic_allocf allocf, void *userdata)
goto EXIT_ARENA;
}
/* turn off GC */
pic->gc_enable = false;
/* memory heap */
pic->heap = pic_heap_open(pic);
@ -202,22 +202,20 @@ pic_open(pic_allocf allocf, void *userdata)
kh_init(oblist, &pic->oblist);
/* global variables */
pic->globals = pic_invalid_value(pic);
pic->globals = pic_make_dict(pic);
/* features */
pic->features = pic_nil_value(pic);
/* dynamic environment */
pic->dyn_env = pic_invalid_value(pic);
/* raised error object */
pic->panicf = NULL;
pic->err = pic_invalid_value(pic);
/* root tables */
pic->globals = pic_make_dict(pic);
pic->dyn_env = pic_list(pic, 1, pic_make_weak(pic));
/* panic handler */
pic->panicf = NULL;
/* error object */
pic->err = pic_invalid_value(pic);
/* turn on GC */
pic->gc_enable = true;
@ -266,7 +264,6 @@ pic_close(pic_state *pic)
/* free GC arena */
allocf(pic->userdata, pic->arena, 0);
allocf(pic->userdata, pic, 0);
}
@ -320,7 +317,7 @@ pic_define(pic_state *pic, const char *name, pic_value val)
void
pic_defun(pic_state *pic, const char *name, pic_func_t f)
{
pic_define(pic, name, pic_make_proc(pic, f, 0, NULL));
pic_define(pic, name, pic_make_proc_func(pic, f, 0, NULL));
}
void

3
lib/state.h
View File

@ -41,8 +41,7 @@ struct pic_state {
pic_value dyn_env;
pic_value features;
pic_value features; /* list of symbols */
khash_t(oblist) oblist; /* string to symbol */
pic_value globals; /* dict */