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);
}
