From 1d28290c14adb7ab3ac96ffb422fb9fc1d035fa9 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sun, 9 Apr 2017 15:05:59 +0900 Subject: [PATCH] remove pic_get_backtrace --- lib/debug.c | 30 +------- lib/error.c | 5 +- lib/gc.c | 3 +- lib/include/picrin.h | 1 - lib/object.h | 3 +- lib/proc.c | 166 +++++++++++++++++++++---------------------- lib/state.c | 27 ++++--- lib/state.h | 3 +- 8 files changed, 100 insertions(+), 138 deletions(-) diff --git a/lib/debug.c b/lib/debug.c index b76d37e0..5b29271a 100644 --- a/lib/debug.c +++ b/lib/debug.c @@ -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"); } } diff --git a/lib/error.c b/lib/error.c index d96c3e5b..23c2f000 100644 --- a/lib/error.c +++ b/lib/error.c @@ -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); } diff --git a/lib/gc.c b/lib/gc.c index b3a3933b..41ba8279 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -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: { diff --git a/lib/include/picrin.h b/lib/include/picrin.h index 6dda3e81..ab24054a 100644 --- a/lib/include/picrin.h +++ b/lib/include/picrin.h @@ -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 { \ diff --git a/lib/object.h b/lib/object.h index 1b0e7d75..2d645c1d 100644 --- a/lib/object.h +++ b/lib/object.h @@ -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); diff --git a/lib/proc.c b/lib/proc.c index d6c7b053..56644d79 100644 --- a/lib/proc.c +++ b/lib/proc.c @@ -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) { diff --git a/lib/state.c b/lib/state.c index 67c65956..94da5cc5 100644 --- a/lib/state.c +++ b/lib/state.c @@ -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 diff --git a/lib/state.h b/lib/state.h index 22901517..32f079a6 100644 --- a/lib/state.h +++ b/lib/state.h @@ -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 */