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; }
void pic_str_set(pic_state *pic, pic_str *str, int i, char c) { pic_str *x, *y, *z, *tmp; char buf[1]; if (pic_str_len(str) <= i) { pic_errorf(pic, "index out of range %d", i); } buf[0] = c; x = pic_str_sub(pic, str, 0, i); y = pic_make_str(pic, buf, 1); z = pic_str_sub(pic, str, i + 1, pic_str_len(str)); tmp = pic_str_cat(pic, x, pic_str_cat(pic, y, z)); pic_rope_incref(pic, tmp->rope); pic_rope_decref(pic, str->rope); str->rope = tmp->rope; }
static pic_value pic_str_string_append(pic_state *pic) { int argc, i; pic_value *argv; pic_str *str; pic_get_args(pic, "*", &argc, &argv); str = pic_make_str(pic, NULL, 0); for (i = 0; i < argc; ++i) { if (! pic_str_p(argv[i])) { pic_errorf(pic, "type error"); } str = pic_str_cat(pic, str, pic_str_ptr(argv[i])); } return pic_obj_value(str); }