JL_DLLEXPORT jl_value_t *jl_backtrace_from_here(int returnsp)
{
jl_svec_t *tp = NULL;
jl_array_t *ip = NULL;
jl_array_t *sp = NULL;
JL_GC_PUSH3(&tp, &ip, &sp);
if (array_ptr_void_type == NULL) {
tp = jl_svec2(jl_voidpointer_type, jl_box_long(1));
array_ptr_void_type = jl_apply_type((jl_value_t*)jl_array_type, tp);
}
ip = jl_alloc_array_1d(array_ptr_void_type, 0);
sp = returnsp ? jl_alloc_array_1d(array_ptr_void_type, 0) : NULL;
const size_t maxincr = 1000;
bt_context_t context;
bt_cursor_t cursor;
memset(&context, 0, sizeof(context));
jl_unw_get(&context);
if (jl_unw_init(&cursor, &context)) {
size_t n = 0, offset = 0;
do {
jl_array_grow_end(ip, maxincr);
if (returnsp) jl_array_grow_end(sp, maxincr);
n = jl_unw_stepn(&cursor, (uintptr_t*)jl_array_data(ip) + offset,
returnsp ? (uintptr_t*)jl_array_data(sp) + offset : NULL, maxincr);
offset += maxincr;
} while (n > maxincr);
jl_array_del_end(ip, maxincr - n);
if (returnsp) jl_array_del_end(sp, maxincr - n);
}
jl_value_t *bt = returnsp ? (jl_value_t*)jl_svec2(ip, sp) : (jl_value_t*)ip;
JL_GC_POP();
return bt;
}
// this is for parsing one expression out of a string, keeping track of
// the current position.
JL_DLLEXPORT jl_value_t *jl_parse_string(const char *str, size_t len,
int pos0, int greedy)
{
JL_TIMING(PARSING);
if (pos0 < 0 || pos0 > len) {
jl_array_t *buf = jl_pchar_to_array(str, len);
JL_GC_PUSH1(&buf);
// jl_bounds_error roots the arguments.
jl_bounds_error((jl_value_t*)buf, jl_box_long(pos0));
}
jl_ast_context_t *ctx = jl_ast_ctx_enter();
fl_context_t *fl_ctx = &ctx->fl;
value_t s = cvalue_static_cstrn(fl_ctx, str, len);
value_t p = fl_applyn(fl_ctx, 3, symbol_value(symbol(fl_ctx, "jl-parse-one-string")),
s, fixnum(pos0), greedy?fl_ctx->T:fl_ctx->F);
jl_value_t *expr=NULL, *pos1=NULL;
JL_GC_PUSH2(&expr, &pos1);
value_t e = car_(p);
if (e == fl_ctx->FL_EOF)
expr = jl_nothing;
else
expr = scm_to_julia(fl_ctx, e, NULL);
pos1 = jl_box_long(tosize(fl_ctx, cdr_(p), "parse"));
jl_ast_ctx_leave(ctx);
jl_value_t *result = (jl_value_t*)jl_svec2(expr, pos1);
JL_GC_POP();
return result;
}
JL_DLLEXPORT jl_value_t *jl_apply_array_type(jl_datatype_t *type, size_t dim)
{
jl_value_t *boxed_dim = jl_box_long(dim);
JL_GC_PUSH1(&boxed_dim);
jl_value_t *ret = jl_apply_type((jl_value_t*)jl_array_type, jl_svec2(type, boxed_dim));
JL_GC_POP();
return ret;
}
JL_DLLEXPORT jl_value_t *jl_get_backtrace(void)
{
jl_svec_t *tp = NULL;
jl_array_t *bt = NULL;
JL_GC_PUSH2(&tp, &bt);
if (array_ptr_void_type == NULL) {
tp = jl_svec2(jl_voidpointer_type, jl_box_long(1));
array_ptr_void_type = jl_apply_type((jl_value_t*)jl_array_type, tp);
}
bt = jl_alloc_array_1d(array_ptr_void_type, jl_bt_size);
memcpy(bt->data, jl_bt_data, jl_bt_size * sizeof(void*));
JL_GC_POP();
return (jl_value_t*)bt;
}
static jl_datatype_t* julia_type()
{
static jl_tvar_t* this_tvar = jl_new_typevar(jl_symbol("T"), (jl_value_t*)jl_bottom_type, (jl_value_t*)jl_any_type);
return (jl_datatype_t*)jl_apply_type((jl_value_t*)jl_type_type,
jl_svec1(jl_apply_type((jl_value_t*)jl_array_type, jl_svec2(this_tvar, jl_box_long(2)))));
}
