pic_str * pic_get_backtrace(pic_state *pic) { size_t ai = pic_gc_arena_preserve(pic); pic_callinfo *ci; pic_str *trace; trace = pic_make_str(pic, NULL, 0); for (ci = pic->ci; ci != pic->cibase; --ci) { struct pic_proc *proc = pic_proc_ptr(ci->fp[0]); trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " at ")); trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, pic_symbol_name(pic, pic_proc_name(proc)))); if (pic_proc_func_p(proc)) { trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (native function)\n")); } else if (pic_proc_irep_p(proc)) { trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (unknown location)\n")); /* TODO */ } } pic_gc_arena_restore(pic, ai); pic_gc_protect(pic, pic_obj_value(trace)); return trace; }
static pic_value pic_system_getenvs(pic_state *pic) { char **envp; pic_value data = pic_nil_value(); size_t ai = pic_gc_arena_preserve(pic); pic_get_args(pic, ""); if (! pic->envp) { return pic_nil_value(); } for (envp = pic->envp; *envp; ++envp) { pic_str *key, *val; size_t i; for (i = 0; (*envp)[i] != '='; ++i) ; key = pic_make_str(pic, *envp, i); val = pic_make_str_cstr(pic, getenv(pic_str_cstr(key))); /* push */ data = pic_acons(pic, pic_obj_value(key), pic_obj_value(val), data); pic_gc_arena_restore(pic, ai); pic_gc_protect(pic, data); } return data; }
static pic_value pic_system_getenv(pic_state *pic) { char *str, *val; pic_get_args(pic, "z", &str); val = getenv(str); if (val == NULL) return pic_nil_value(); else return pic_obj_value(pic_make_str_cstr(pic, val)); }
struct pic_error * pic_make_error(pic_state *pic, pic_sym *type, const char *msg, pic_value irrs) { 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; e->msg = pic_make_str_cstr(pic, msg); e->irrs = irrs; e->stack = stack; return e; }
static pic_value pic_system_cmdline(pic_state *pic) { pic_value v = pic_nil_value(); int i; pic_get_args(pic, ""); for (i = 0; i < pic->argc; ++i) { size_t ai = pic_gc_arena_preserve(pic); v = pic_cons(pic, pic_obj_value(pic_make_str_cstr(pic, pic->argv[i])), v); pic_gc_arena_restore(pic, ai); } return pic_reverse(pic, v); }