// 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;
}
static jl_tuple_t *RDims_JuliaTuple(SEXP Var)
{
jl_tuple_t *d;
SEXP dims = getAttrib(Var, R_DimSymbol);
//array or matrix
if (dims != R_NilValue)
{
int ndims = LENGTH(dims);
d = jl_alloc_tuple(ndims);
JL_GC_PUSH1(&d);
size_t i;
for (i = 0; i < ndims; i++)
{
jl_tupleset(d, i, jl_box_long(INTEGER(dims)[i]));
}
JL_GC_POP();
}
else //vector
{
d = jl_alloc_tuple(1);
JL_GC_PUSH1(&d);
jl_tupleset(d, 0, jl_box_long(LENGTH(Var)));
JL_GC_POP();
}
return d;
}
JL_DLLEXPORT jl_value_t *jl_lookup_code_address(void *ip, int skipC)
{
char *func_name;
size_t line_num;
char *file_name;
size_t inlinedat_line;
char *inlinedat_file;
jl_lambda_info_t *outer_linfo;
int fromC = frame_info_from_ip(&func_name, &file_name, &line_num,
&inlinedat_file, &inlinedat_line, &outer_linfo,
(size_t)ip, skipC, 0);
jl_value_t *r = (jl_value_t*)jl_alloc_svec(8);
JL_GC_PUSH1(&r);
jl_svecset(r, 0, jl_symbol(func_name));
jl_svecset(r, 1, jl_symbol(file_name));
jl_svecset(r, 2, jl_box_long(line_num));
jl_svecset(r, 3, jl_symbol(inlinedat_file ? inlinedat_file : ""));
jl_svecset(r, 4, jl_box_long(inlinedat_file ? inlinedat_line : -1));
jl_svecset(r, 5, outer_linfo != NULL ? (jl_value_t*)outer_linfo : jl_nothing);
jl_svecset(r, 6, jl_box_bool(fromC));
jl_svecset(r, 7, jl_box_long((intptr_t)ip));
free(func_name);
free(file_name);
free(inlinedat_file);
JL_GC_POP();
return r;
}
JL_DLLEXPORT jl_value_t *jl_lookup_code_address(void *ip, int skipC)
{
jl_ptls_t ptls = jl_get_ptls_states();
jl_frame_t *frames = NULL;
int8_t gc_state = jl_gc_safe_enter(ptls);
int n = jl_getFunctionInfo(&frames, (uintptr_t)ip, skipC, 0);
jl_gc_safe_leave(ptls, gc_state);
jl_value_t *rs = (jl_value_t*)jl_alloc_svec(n);
JL_GC_PUSH1(&rs);
for (int i = 0; i < n; i++) {
jl_frame_t frame = frames[i];
jl_value_t *r = (jl_value_t*)jl_alloc_svec(7);
jl_svecset(rs, i, r);
if (frame.func_name)
jl_svecset(r, 0, jl_symbol(frame.func_name));
else
jl_svecset(r, 0, empty_sym);
free(frame.func_name);
if (frame.file_name)
jl_svecset(r, 1, jl_symbol(frame.file_name));
else
jl_svecset(r, 1, empty_sym);
free(frame.file_name);
jl_svecset(r, 2, jl_box_long(frame.line));
jl_svecset(r, 3, frame.linfo != NULL ? (jl_value_t*)frame.linfo : jl_nothing);
jl_svecset(r, 4, jl_box_bool(frame.fromC));
jl_svecset(r, 5, jl_box_bool(frame.inlined));
jl_svecset(r, 6, jl_box_long((intptr_t)ip));
}
free(frames);
JL_GC_POP();
return rs;
}
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;
}
JL_DLLEXPORT void JL_NORETURN jl_bounds_error_int(jl_value_t *v, size_t i)
{
jl_value_t *t = NULL;
JL_GC_PUSH2(&v, &t); // root arguments so the caller doesn't need to
t = jl_box_long(i);
jl_throw(jl_new_struct((jl_datatype_t*)jl_boundserror_type, v, t));
}
// load toplevel expressions, from (file ...)
void jl_load_file_expr(char *fname, jl_value_t *ast)
{
jl_array_t *b = ((jl_expr_t*)ast)->args;
size_t i;
volatile size_t lineno=0;
if (((jl_expr_t*)ast)->head == jl_continue_sym) {
jl_errorf("syntax error: %s", jl_string_data(jl_exprarg(ast,0)));
}
JL_TRY {
jl_register_toplevel_eh();
// handle syntax error
if (((jl_expr_t*)ast)->head == error_sym) {
jl_interpret_toplevel_expr(ast);
}
for(i=0; i < b->length; i++) {
// process toplevel form
jl_value_t *form = jl_cellref(b, i);
if (jl_is_linenode(form)) {
lineno = jl_linenode_line(form);
}
else {
(void)jl_toplevel_eval_flex(form, 0, &lineno);
}
}
}
JL_CATCH {
jl_value_t *fn=NULL, *ln=NULL;
JL_GC_PUSH(&fn, &ln);
fn = jl_pchar_to_string(fname, strlen(fname));
ln = jl_box_long(lineno);
jl_raise(jl_new_struct(jl_loaderror_type, fn, ln,
jl_exception_in_transit));
}
}
DLLEXPORT
jl_lambda_info_t *jl_new_lambda_info(jl_value_t *ast, jl_tuple_t *sparams)
{
jl_lambda_info_t *li =
(jl_lambda_info_t*)newobj((jl_type_t*)jl_lambda_info_type,
LAMBDA_INFO_NW);
li->ast = ast;
li->file = (jl_value_t*)null_sym;
li->line = jl_box_long(0);
if (ast != NULL && jl_is_expr(ast)) {
jl_expr_t *body1 = (jl_expr_t*)jl_exprarg(jl_lam_body((jl_expr_t*)ast),0);
if (jl_is_expr(body1) && ((jl_expr_t*)body1)->head == line_sym) {
li->file = jl_exprarg(body1, 1);
li->line = jl_exprarg(body1, 0);
}
}
li->module = jl_current_module;
li->sparams = sparams;
li->tfunc = (jl_value_t*)jl_null;
li->fptr = &jl_trampoline;
li->roots = NULL;
li->functionObject = NULL;
li->specTypes = NULL;
li->inferred = jl_false;
li->inInference = 0;
li->inCompile = 0;
li->unspecialized = NULL;
li->specializations = NULL;
li->name = anonymous_sym;
return li;
}
// repeatedly call jl_parse_next and eval everything
void jl_parse_eval_all(char *fname)
{
//ios_printf(ios_stderr, "***** loading %s\n", fname);
int lineno=0;
jl_value_t *fn=NULL, *ln=NULL, *form=NULL;
JL_GC_PUSH(&fn, &ln, &form);
JL_TRY {
jl_register_toplevel_eh();
// handle syntax error
while (1) {
form = jl_parse_next(&lineno);
if (form == NULL)
break;
if (jl_is_expr(form)) {
if (((jl_expr_t*)form)->head == jl_continue_sym) {
jl_errorf("syntax error: %s", jl_string_data(jl_exprarg(form,0)));
}
if (((jl_expr_t*)form)->head == error_sym) {
jl_interpret_toplevel_expr(form);
}
}
(void)jl_toplevel_eval_flex(form, 1, &lineno);
}
}
JL_CATCH {
jl_stop_parsing();
fn = jl_pchar_to_string(fname, strlen(fname));
ln = jl_box_long(lineno);
jl_raise(jl_new_struct(jl_loaderror_type, fn, ln,
jl_exception_in_transit));
}
jl_stop_parsing();
JL_GC_POP();
}
SEXP jr_data_array(jl_value_t *tt) {
SEXP ans = R_NilValue;
jl_function_t *func = jl_get_function(jl_base_module, "getindex");
jl_value_t *u = jl_get_nth_field(tt, 0);
jl_value_t *v = jl_get_nth_field(tt, 1);
JL_GC_PUSH2(&u, &v);
size_t len = jl_array_len(u);
ans = jr_array(u);
int ty = TYPEOF(ans);
for(size_t i=0; i<len; i++){
if (jl_unbox_bool(jl_call2(func, v, jl_box_long(i+1)))){
switch(ty) {
case LGLSXP:
LOGICAL(ans)[i] = NA_LOGICAL;
break;
case INTSXP:
INTEGER(ans)[i] = NA_INTEGER;
break;
case REALSXP:
REAL(ans)[i] = NA_REAL;
break;
case STRSXP:
SET_STRING_ELT(ans, i, NA_STRING);
break;
default:
LOGICAL(ans)[i] = NA_LOGICAL;
}
}
}
JL_GC_POP();
return ans;
}
// wrap expr in a thunk AST
jl_lambda_info_t *jl_wrap_expr(jl_value_t *expr)
{
// `(lambda () (() () () ()) ,expr)
jl_expr_t *le=NULL, *bo=NULL; jl_value_t *vi=NULL;
jl_value_t *mt = jl_an_empty_vec_any;
jl_lambda_info_t *li = NULL;
JL_GC_PUSH4(&le, &vi, &bo, &li);
le = jl_exprn(lambda_sym, 3);
jl_array_ptr_set(le->args, 0, mt);
vi = (jl_value_t*)jl_alloc_vec_any(4);
jl_array_ptr_set(vi, 0, mt);
jl_array_ptr_set(vi, 1, mt);
// front end always wraps toplevel exprs with ssavalues in (thunk (lambda () ...))
jl_array_ptr_set(vi, 2, jl_box_long(0));
jl_array_ptr_set(vi, 3, mt);
jl_array_ptr_set(le->args, 1, vi);
if (!jl_is_expr(expr) || ((jl_expr_t*)expr)->head != body_sym) {
bo = jl_exprn(body_sym, 1);
jl_array_ptr_set(bo->args, 0, (jl_value_t*)jl_exprn(return_sym, 1));
jl_array_ptr_set(((jl_expr_t*)jl_exprarg(bo,0))->args, 0, expr);
expr = (jl_value_t*)bo;
}
jl_array_ptr_set(le->args, 2, expr);
li = jl_new_lambda_info_from_ast(le);
JL_GC_POP();
return li;
}
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 void JL_NORETURN jl_bounds_error_unboxed_int(void *data, jl_value_t *vt, size_t i)
{
jl_value_t *t = NULL, *v = NULL;
// data is expected to be gc-safe (either gc-rooted, or alloca)
// vt is expected to be gc-rooted (in a linfo-root probably)
JL_GC_PUSH2(&v, &t);
v = jl_new_bits(vt, data);
t = jl_box_long(i);
jl_throw(jl_new_struct((jl_datatype_t*)jl_boundserror_type, v, t));
}
// handle a command line input event
void handle_input(jl_value_t *ast, int end, int show_value)
{
if (end) {
show_value = -1;
ast = jl_nothing;
}
jl_value_t *f = jl_get_global(jl_base_module,jl_symbol("repl_callback"));
assert(f);
jl_value_t *fargs[] = { ast, jl_box_long(show_value) };
jl_apply((jl_function_t*)f, fargs, 2);
}
static jl_value_t *jl_invoke_julia_macro(jl_array_t *args, jl_module_t *inmodule, jl_module_t **ctx)
{
jl_ptls_t ptls = jl_get_ptls_states();
JL_TIMING(MACRO_INVOCATION);
size_t nargs = jl_array_len(args) + 1;
JL_NARGSV("macrocall", 3); // macro name, location, and module
jl_value_t **margs;
JL_GC_PUSHARGS(margs, nargs);
int i;
margs[0] = jl_array_ptr_ref(args, 0);
// __source__ argument
jl_value_t *lno = jl_array_ptr_ref(args, 1);
margs[1] = lno;
if (!jl_typeis(lno, jl_linenumbernode_type)) {
margs[1] = jl_new_struct(jl_linenumbernode_type, jl_box_long(0), jl_nothing);
}
margs[2] = (jl_value_t*)inmodule;
for (i = 3; i < nargs; i++)
margs[i] = jl_array_ptr_ref(args, i - 1);
size_t last_age = ptls->world_age;
size_t world = jl_world_counter;
ptls->world_age = world;
jl_value_t *result;
JL_TRY {
margs[0] = jl_toplevel_eval(*ctx, margs[0]);
jl_method_instance_t *mfunc = jl_method_lookup(jl_gf_mtable(margs[0]), margs, nargs, 1, world);
if (mfunc == NULL) {
jl_method_error((jl_function_t*)margs[0], margs, nargs, world);
// unreachable
}
*ctx = mfunc->def.method->module;
result = mfunc->invoke(mfunc, margs, nargs);
}
JL_CATCH {
if (jl_loaderror_type == NULL) {
jl_rethrow();
}
else {
jl_value_t *lno = margs[1];
jl_value_t *file = jl_fieldref(lno, 1);
if (jl_is_symbol(file))
margs[0] = jl_cstr_to_string(jl_symbol_name((jl_sym_t*)file));
else
margs[0] = jl_cstr_to_string("<macrocall>");
margs[1] = jl_fieldref(lno, 0); // extract and allocate line number
jl_rethrow_other(jl_new_struct(jl_loaderror_type, margs[0], margs[1],
ptls->exception_in_transit));
}
}
ptls->world_age = last_age;
JL_GC_POP();
return result;
}
// copy a :lambda Expr into its LambdaInfo representation
static void jl_lambda_info_set_ast(jl_lambda_info_t *li, jl_expr_t *ast)
{
assert(jl_is_expr(ast));
jl_expr_t *bodyex = (jl_expr_t*)jl_exprarg(ast, 2);
assert(jl_is_expr(bodyex));
jl_array_t *body = bodyex->args;
li->code = (jl_value_t*)body; jl_gc_wb(li, li->code);
if (has_meta(body, pure_sym))
li->pure = 1;
jl_array_t *vinfo = (jl_array_t*)jl_exprarg(ast, 1);
jl_array_t *vis = (jl_array_t*)jl_array_ptr_ref(vinfo, 0);
size_t nslots = jl_array_len(vis);
jl_value_t *ssavalue_types = jl_array_ptr_ref(vinfo, 2);
assert(jl_is_long(ssavalue_types));
size_t nssavalue = jl_unbox_long(ssavalue_types);
li->slotnames = jl_alloc_vec_any(nslots);
jl_gc_wb(li, li->slotnames);
li->slottypes = jl_nothing;
li->slotflags = jl_alloc_array_1d(jl_array_uint8_type, nslots);
jl_gc_wb(li, li->slotflags);
li->ssavaluetypes = jl_box_long(nssavalue);
jl_gc_wb(li, li->ssavaluetypes);
int i;
for(i=0; i < nslots; i++) {
jl_value_t *vi = jl_array_ptr_ref(vis, i);
jl_sym_t *name = (jl_sym_t*)jl_array_ptr_ref(vi, 0);
assert(jl_is_symbol(name));
char *str = jl_symbol_name(name);
if (i > 0 && name != unused_sym) {
if (str[0] == '#') {
// convention for renamed variables: #...#original_name
char *nxt = strchr(str + 1, '#');
if (nxt)
name = jl_symbol(nxt+1);
else if (str[1] == 's') // compiler-generated temporaries, #sXXX
name = compiler_temp_sym;
}
}
jl_array_ptr_set(li->slotnames, i, name);
jl_array_uint8_set(li->slotflags, i, jl_unbox_long(jl_array_ptr_ref(vi, 2)));
}
jl_array_t *sparams = (jl_array_t*)jl_array_ptr_ref(vinfo, 3);
assert(jl_is_array(sparams));
li->sparam_syms = jl_alloc_svec_uninit(jl_array_len(sparams));
jl_gc_wb(li, li->sparam_syms);
for(i=0; i < jl_array_len(sparams); i++) {
jl_svecset(li->sparam_syms, i, jl_array_ptr_ref(sparams, i));
}
jl_array_t *args = (jl_array_t*)jl_exprarg(ast, 0);
size_t narg = jl_array_len(args);
li->nargs = narg;
li->isva = narg > 0 && jl_is_rest_arg(jl_array_ptr_ref(args, narg - 1));
}
JL_DLLEXPORT void JL_NORETURN jl_bounds_error_ints(jl_value_t *v, size_t *idxs, size_t nidxs)
{
size_t i;
jl_value_t *t = NULL;
JL_GC_PUSH2(&v, &t); // root arguments so the caller doesn't need to
t = (jl_value_t*)jl_alloc_svec(nidxs);
for (i = 0; i < nidxs; i++) {
jl_svecset(t, i, jl_box_long(idxs[i]));
}
t = jl_f_tuple(NULL, jl_svec_data(t), nidxs);
jl_throw(jl_new_struct((jl_datatype_t*)jl_boundserror_type, v, t));
}
static jl_methtable_t *new_method_table(void)
{
jl_methtable_t *mt = (jl_methtable_t*)allocobj(sizeof(jl_methtable_t));
mt->type = (jl_type_t*)jl_methtable_type;
mt->defs = NULL;
mt->cache = NULL;
mt->cache_arg1 = NULL;
mt->cache_targ = NULL;
mt->max_args = jl_box_long(0);
#ifdef JL_GF_PROFILE
mt->ncalls = 0;
#endif
return mt;
}
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;
}
// fetch references to things defined in boot.j
void jl_get_builtin_hooks(void)
{
jl_nothing = global("nothing");
jl_root_task->tls = jl_nothing;
jl_char_type = (jl_bits_type_t*)global("Char");
jl_int8_type = (jl_bits_type_t*)global("Int8");
jl_uint8_type = (jl_bits_type_t*)global("Uint8");
jl_int16_type = (jl_bits_type_t*)global("Int16");
jl_uint16_type = (jl_bits_type_t*)global("Uint16");
jl_uint32_type = (jl_bits_type_t*)global("Uint32");
jl_uint64_type = (jl_bits_type_t*)global("Uint64");
jl_float32_type = (jl_bits_type_t*)global("Float32");
jl_float64_type = (jl_bits_type_t*)global("Float64");
jl_weakref_type = (jl_struct_type_t*)global("WeakRef");
jl_weakref_type->fptr = jl_weakref_ctor;
jl_weakref_type->env = NULL;
jl_weakref_type->linfo = NULL;
jl_string_type = (jl_tag_type_t*)global("String");
jl_ascii_string_type = (jl_struct_type_t*)global("ASCIIString");
jl_utf8_string_type = (jl_struct_type_t*)global("UTF8String");
jl_errorexception_type = (jl_struct_type_t*)global("ErrorException");
jl_typeerror_type = (jl_struct_type_t*)global("TypeError");
jl_loaderror_type = (jl_struct_type_t*)global("LoadError");
jl_uniontoocomplex_type = (jl_struct_type_t*)global("UnionTooComplexError");
jl_backtrace_type = (jl_struct_type_t*)global("BackTrace");
jl_symbolnode_type = (jl_struct_type_t*)global("SymbolNode");
jl_stackovf_exception =
jl_apply((jl_function_t*)global("StackOverflowError"), NULL, 0);
jl_divbyzero_exception =
jl_apply((jl_function_t*)global("DivideByZeroError"), NULL, 0);
jl_undefref_exception =
jl_apply((jl_function_t*)global("UndefRefError"),NULL,0);
jl_interrupt_exception =
jl_apply((jl_function_t*)global("InterruptException"),NULL,0);
jl_memory_exception =
jl_apply((jl_function_t*)global("MemoryError"),NULL,0);
jl_append_any_func = (jl_function_t*)global("append_any");
jl_method_missing_func = (jl_function_t*)global("method_missing");
jl_array_uint8_type =
(jl_type_t*)jl_apply_type((jl_value_t*)jl_array_type,
jl_tuple2(jl_uint8_type,
jl_box_long(1)));
}
// handle a command line input event
void handle_input(jl_value_t *ast, int end, int show_value)
{
if (end) {
show_value = -1;
ast = jl_nothing;
}
jl_value_t *f = jl_get_global(jl_base_module,jl_symbol("repl_callback"));
assert(f);
jl_value_t **fargs;
JL_GC_PUSHARGS(fargs, 2);
fargs[0] = ast;
fargs[1] = jl_box_long(show_value);
jl_apply((jl_function_t*)f, fargs, 2);
JL_GC_POP();
}
// fetch references to things defined in boot.jl
void jl_get_builtin_hooks(void)
{
jl_nothing = core("nothing");
jl_root_task->tls = jl_nothing;
jl_root_task->consumers = jl_nothing;
jl_root_task->donenotify = jl_nothing;
jl_root_task->exception = jl_nothing;
jl_char_type = (jl_datatype_t*)core("Char");
jl_int8_type = (jl_datatype_t*)core("Int8");
jl_uint8_type = (jl_datatype_t*)core("Uint8");
jl_int16_type = (jl_datatype_t*)core("Int16");
jl_uint16_type = (jl_datatype_t*)core("Uint16");
jl_uint32_type = (jl_datatype_t*)core("Uint32");
jl_uint64_type = (jl_datatype_t*)core("Uint64");
jl_float32_type = (jl_datatype_t*)core("Float32");
jl_float64_type = (jl_datatype_t*)core("Float64");
jl_floatingpoint_type = (jl_datatype_t*)core("FloatingPoint");
jl_stackovf_exception =
jl_apply((jl_function_t*)core("StackOverflowError"), NULL, 0);
jl_diverror_exception =
jl_apply((jl_function_t*)core("DivideError"), NULL, 0);
jl_domain_exception =
jl_apply((jl_function_t*)core("DomainError"), NULL, 0);
jl_overflow_exception =
jl_apply((jl_function_t*)core("OverflowError"), NULL, 0);
jl_inexact_exception =
jl_apply((jl_function_t*)core("InexactError"), NULL, 0);
jl_undefref_exception =
jl_apply((jl_function_t*)core("UndefRefError"),NULL,0);
jl_interrupt_exception =
jl_apply((jl_function_t*)core("InterruptException"),NULL,0);
jl_bounds_exception =
jl_apply((jl_function_t*)core("BoundsError"),NULL,0);
jl_memory_exception =
jl_apply((jl_function_t*)core("MemoryError"),NULL,0);
jl_ascii_string_type = (jl_datatype_t*)core("ASCIIString");
jl_utf8_string_type = (jl_datatype_t*)core("UTF8String");
jl_symbolnode_type = (jl_datatype_t*)core("SymbolNode");
jl_getfieldnode_type = (jl_datatype_t*)core("GetfieldNode");
jl_array_uint8_type = jl_apply_type((jl_value_t*)jl_array_type,
jl_tuple2(jl_uint8_type,
jl_box_long(1)));
}
// load toplevel expressions, from (file ...)
void jl_load_file_expr(char *fname, jl_value_t *ast)
{
jl_array_t *b = ((jl_expr_t*)ast)->args;
size_t i;
volatile size_t lineno=0;
if (((jl_expr_t*)ast)->head == jl_continue_sym) {
jl_errorf("syntax error: %s", jl_string_data(jl_exprarg(ast,0)));
}
char oldcwd[512];
char newcwd[512];
get_cwd(oldcwd, sizeof(oldcwd));
char *sep = strrchr(fname, PATHSEP);
if (sep) {
size_t n = (sep - fname)+1;
if (n > sizeof(newcwd)-1) n = sizeof(newcwd)-1;
strncpy(newcwd, fname, n);
newcwd[n] = '\0';
set_cwd(newcwd);
}
JL_TRY {
jl_register_toplevel_eh();
// handle syntax error
if (((jl_expr_t*)ast)->head == error_sym) {
jl_interpret_toplevel_expr(ast);
}
for(i=0; i < b->length; i++) {
// process toplevel form
jl_value_t *form = jl_cellref(b, i);
if (jl_is_linenode(form)) {
lineno = jl_linenode_line(form);
}
else {
(void)jl_toplevel_eval_flex(form, 0, &lineno);
}
}
}
JL_CATCH {
if (sep) set_cwd(oldcwd);
jl_value_t *fn=NULL, *ln=NULL;
JL_GC_PUSH(&fn, &ln);
fn = jl_pchar_to_string(fname, strlen(fname));
ln = jl_box_long(lineno);
jl_raise(jl_new_struct(jl_loaderror_type, fn, ln,
jl_exception_in_transit));
}
if (sep) set_cwd(oldcwd);
}
// repeatedly call jl_parse_next and eval everything
jl_value_t *jl_parse_eval_all(const char *fname, size_t len)
{
//jl_printf(JL_STDERR, "***** loading %s\n", fname);
int last_lineno = jl_lineno;
const char *last_filename = jl_filename;
jl_lineno = 0;
jl_filename = fname;
jl_value_t *fn=NULL, *ln=NULL, *form=NULL, *result=jl_nothing;
JL_GC_PUSH4(&fn, &ln, &form, &result);
JL_TRY {
// handle syntax error
while (1) {
form = jl_parse_next();
if (form == NULL)
break;
if (jl_is_expr(form)) {
if (((jl_expr_t*)form)->head == jl_incomplete_sym) {
jl_errorf("syntax: %s", jl_string_data(jl_exprarg(form,0)));
}
if (((jl_expr_t*)form)->head == error_sym) {
jl_interpret_toplevel_expr(form);
}
}
result = jl_toplevel_eval_flex(form, 1);
}
}
JL_CATCH {
jl_stop_parsing();
fn = jl_pchar_to_string(fname, len);
ln = jl_box_long(jl_lineno);
jl_lineno = last_lineno;
jl_filename = last_filename;
if (jl_loaderror_type == NULL) {
jl_rethrow();
}
else {
jl_rethrow_other(jl_new_struct(jl_loaderror_type, fn, ln,
jl_exception_in_transit));
}
}
jl_stop_parsing();
jl_lineno = last_lineno;
jl_filename = last_filename;
JL_GC_POP();
return result;
}
JL_DLLEXPORT void jl_depwarn_partial_indexing(size_t n)
{
static jl_value_t *depwarn_func = NULL;
if (!depwarn_func && jl_base_module) {
depwarn_func = jl_get_global(jl_base_module, jl_symbol("_depwarn_for_trailing_indices"));
}
if (!depwarn_func) {
jl_safe_printf("WARNING: omitting indices for non-singleton trailing dimensions is deprecated. Use "
"`reshape(A, Val(%zd))` or add trailing `1` indices to make the dimensionality of the array match "
"the number of indices\n", n);
return;
}
jl_value_t **depwarn_args;
JL_GC_PUSHARGS(depwarn_args, 2);
depwarn_args[0] = depwarn_func;
depwarn_args[1] = jl_box_long(n);
jl_apply(depwarn_args, 2);
JL_GC_POP();
}
// this is for parsing one expression out of a string, keeping track of
// the current position.
DLLEXPORT jl_value_t *jl_parse_string(const char *str, int pos0, int greedy)
{
value_t s = cvalue_static_cstring(str);
value_t p = fl_applyn(3, symbol_value(symbol("jl-parse-one-string")),
s, fixnum(pos0), greedy?FL_T:FL_F);
jl_value_t *expr=NULL, *pos1=NULL;
JL_GC_PUSH(&expr, &pos1);
value_t e = car_(p);
if (e == FL_T || e == FL_F || e == FL_EOF) {
expr = (jl_value_t*)jl_null;
}
else {
expr = scm_to_julia(e);
}
pos1 = jl_box_long(toulong(cdr_(p),"parse"));
jl_value_t *result = (jl_value_t*)jl_tuple2(expr, pos1);
JL_GC_POP();
return result;
}
// fetch references to things defined in boot.jl
void jl_get_builtin_hooks(void)
{
jl_nothing = core("nothing");
jl_root_task->tls = jl_nothing;
jl_char_type = (jl_bits_type_t*)core("Char");
jl_int8_type = (jl_bits_type_t*)core("Int8");
jl_uint8_type = (jl_bits_type_t*)core("Uint8");
jl_int16_type = (jl_bits_type_t*)core("Int16");
jl_uint16_type = (jl_bits_type_t*)core("Uint16");
jl_uint32_type = (jl_bits_type_t*)core("Uint32");
jl_uint64_type = (jl_bits_type_t*)core("Uint64");
jl_float32_type = (jl_bits_type_t*)core("Float32");
jl_float64_type = (jl_bits_type_t*)core("Float64");
jl_stackovf_exception =
jl_apply((jl_function_t*)core("StackOverflowError"), NULL, 0);
jl_divbyzero_exception =
jl_apply((jl_function_t*)core("DivideByZeroError"), NULL, 0);
jl_undefref_exception =
jl_apply((jl_function_t*)core("UndefRefError"),NULL,0);
jl_interrupt_exception =
jl_apply((jl_function_t*)core("InterruptException"),NULL,0);
jl_memory_exception =
jl_apply((jl_function_t*)core("MemoryError"),NULL,0);
jl_weakref_type = (jl_struct_type_t*)core("WeakRef");
jl_ascii_string_type = (jl_struct_type_t*)core("ASCIIString");
jl_utf8_string_type = (jl_struct_type_t*)core("UTF8String");
jl_symbolnode_type = (jl_struct_type_t*)core("SymbolNode");
jl_array_uint8_type =
(jl_type_t*)jl_apply_type((jl_value_t*)jl_array_type,
jl_tuple2(jl_uint8_type,
jl_box_long(1)));
}
/*
static void clear_method_caches(void)
{
htable_t *t = &jl_system_module->bindings;
size_t i;
for(i=0; i < t->size; i+=2) {
if (t->table[i+1] == HT_NOTFOUND)
continue;
jl_binding_t *b = (jl_binding_t*)t->table[i+1];
if (b->value != NULL && jl_is_func(b->value) && jl_is_gf(b->value)) {
jl_function_t *f = (jl_function_t*)b->value;
jl_methtable_t *mt = jl_gf_mtable(f);
mt->cache = NULL;
}
}
}
*/
DLLEXPORT void jl_enable_inference(void)
{
if (jl_boundp(jl_system_module, jl_symbol("typeinf_ext"))) {
//clear_method_caches();
jl_typeinf_func =
(jl_function_t*)*(jl_get_bindingp(jl_system_module,
jl_symbol("typeinf_ext")));
// warm up type inference to put the latency up front
jl_value_t *one = jl_box_long(1);
jl_apply((jl_function_t*)*(jl_get_bindingp(jl_system_module,
jl_symbol("+"))),
&one, 1);
/*
cached t-functions and inferred ASTs need to be cleared at
this point, because during bootstrapping we might not be
able to inline optimally. the reason is that we cache an AST
before doing inlining, to prevent infinite recursion.
for example, consider this function:
> (x::Real, y::Real) = (y < x)
after doing inference on this >, we cache its AST "(y < x)".
now we begin inlining. the problem is that the inlining code
itself will trigger compilation of functions that use >, so
"(y < x)" will be inlined into those functions. ultimately
we inline the definition of < into "(y < x)", but by then it's
too late, since "(y < x)" has already been inlined into some
functions.
to fix this, we clear the t-function cache after all
type-inference related code has been compiled. now we can
inline everything fully without compilation of the compiler
itself interfering.
*/
clear_tfunc_caches();
}
}
static void jl_serialize_value_(ios_t *s, jl_value_t *v)
{
if (v == NULL) {
write_uint8(s, Null_tag);
return;
}
void **bp = ptrhash_bp(&ser_tag, v);
if (*bp != HT_NOTFOUND) {
write_as_tag(s, (uint8_t)(ptrint_t)*bp);
return;
}
if (tree_literal_values) {
// compressing tree
if (!is_ast_node(v)) {
writetag(s, (jl_value_t*)LiteralVal_tag);
write_uint16(s, literal_val_id(v));
return;
}
}
else {
bp = ptrhash_bp(&backref_table, v);
if (*bp != HT_NOTFOUND) {
write_uint8(s, BackRef_tag);
write_int32(s, (ptrint_t)*bp);
return;
}
ptrhash_put(&backref_table, v, (void*)(ptrint_t)ios_pos(s));
}
size_t i;
if (jl_is_tuple(v)) {
size_t l = ((jl_tuple_t*)v)->length;
if (l <= 255) {
writetag(s, jl_tuple_type);
write_uint8(s, (uint8_t)l);
}
else {
writetag(s, (jl_value_t*)LongTuple_tag);
write_int32(s, l);
}
for(i=0; i < l; i++) {
jl_serialize_value(s, jl_tupleref(v, i));
}
}
else if (jl_is_symbol(v)) {
size_t l = strlen(((jl_sym_t*)v)->name);
if (l <= 255) {
writetag(s, jl_symbol_type);
write_uint8(s, (uint8_t)l);
}
else {
writetag(s, (jl_value_t*)LongSymbol_tag);
write_int32(s, l);
}
ios_write(s, ((jl_sym_t*)v)->name, l);
}
else if (jl_is_array(v)) {
jl_array_t *ar = (jl_array_t*)v;
writetag(s, (jl_value_t*)jl_array_type);
jl_serialize_value(s, ar->type);
jl_value_t *elty = jl_tparam0(ar->type);
for (i=0; i < ar->ndims; i++)
jl_serialize_value(s, jl_box_long(jl_array_dim(ar,i)));
if (jl_is_bits_type(elty)) {
size_t tot = ar->length * ar->elsize;
ios_write(s, ar->data, tot);
}
else {
for(i=0; i < ar->length; i++) {
jl_serialize_value(s, jl_cellref(v, i));
}
}
}
else if (jl_is_expr(v)) {
jl_expr_t *e = (jl_expr_t*)v;
size_t l = e->args->length;
if (l <= 255) {
writetag(s, jl_expr_type);
write_uint8(s, (uint8_t)l);
}
else {
writetag(s, (jl_value_t*)LongExpr_tag);
write_int32(s, l);
}
jl_serialize_value(s, e->head);
jl_serialize_value(s, e->etype);
for(i=0; i < l; i++) {
jl_serialize_value(s, jl_exprarg(e, i));
}
}
else if (jl_is_some_tag_type(v)) {
jl_serialize_tag_type(s, v);
}
else if (jl_is_typevar(v)) {
writetag(s, jl_tvar_type);
jl_serialize_value(s, ((jl_tvar_t*)v)->name);
jl_serialize_value(s, ((jl_tvar_t*)v)->lb);
jl_serialize_value(s, ((jl_tvar_t*)v)->ub);
write_int8(s, ((jl_tvar_t*)v)->bound);
}
else if (jl_is_function(v)) {
writetag(s, jl_func_kind);
jl_serialize_value(s, v->type);
jl_function_t *f = (jl_function_t*)v;
jl_serialize_value(s, (jl_value_t*)f->linfo);
jl_serialize_value(s, f->env);
if (f->linfo && f->linfo->ast &&
(jl_is_expr(f->linfo->ast) || jl_is_tuple(f->linfo->ast)) &&
f->fptr != &jl_trampoline) {
write_int32(s, 0);
}
else {
jl_serialize_fptr(s, f->fptr);
}
}
else if (jl_is_lambda_info(v)) {
writetag(s, jl_lambda_info_type);
jl_lambda_info_t *li = (jl_lambda_info_t*)v;
jl_serialize_value(s, li->ast);
jl_serialize_value(s, (jl_value_t*)li->sparams);
// don't save cached type info for code in the Base module, because
// it might reference types in the old System module.
if (li->module == jl_base_module)
jl_serialize_value(s, (jl_value_t*)jl_null);
else
jl_serialize_value(s, (jl_value_t*)li->tfunc);
jl_serialize_value(s, (jl_value_t*)li->name);
jl_serialize_value(s, (jl_value_t*)li->specTypes);
jl_serialize_value(s, (jl_value_t*)li->specializations);
jl_serialize_value(s, (jl_value_t*)li->inferred);
jl_serialize_value(s, (jl_value_t*)li->file);
jl_serialize_value(s, (jl_value_t*)li->line);
jl_serialize_value(s, (jl_value_t*)li->module);
}
else if (jl_typeis(v, jl_module_type)) {
jl_serialize_module(s, (jl_module_t*)v);
}
else if (jl_typeis(v, jl_methtable_type)) {
writetag(s, jl_methtable_type);
jl_methtable_t *mt = (jl_methtable_t*)v;
jl_serialize_methlist(s, mt->defs);
jl_serialize_methlist(s, mt->cache);
jl_serialize_value(s, mt->cache_1arg);
write_int32(s, mt->max_args);
}
else if (jl_typeis(v, jl_task_type)) {
jl_error("Task cannot be serialized");
}
else {
jl_value_t *t = (jl_value_t*)jl_typeof(v);
if (jl_is_bits_type(t)) {
void *data = jl_bits_data(v);
if (t == (jl_value_t*)jl_int64_type &&
*(int64_t*)data >= S32_MIN && *(int64_t*)data <= S32_MAX) {
writetag(s, (jl_value_t*)SmallInt64_tag);
write_int32(s, (int32_t)*(int64_t*)data);
}
else {
int nb = ((jl_bits_type_t*)t)->nbits;
writetag(s, jl_bits_kind);
jl_serialize_value(s, t);
ios_write(s, data, nb/8);
}
}
else if (jl_is_struct_type(t)) {
writetag(s, jl_struct_kind);
jl_serialize_value(s, t);
size_t nf = ((jl_struct_type_t*)t)->names->length;
size_t i;
for(i=0; i < nf; i++) {
jl_value_t *fld = ((jl_value_t**)v)[i+1];
jl_serialize_value(s, fld);
}
if (t == jl_idtable_type) {
jl_cell_1d_push(idtable_list, v);
}
}
else {
assert(0);
}
}
}
JL_DLLEXPORT jl_value_t *jl_arraylen(jl_value_t *a)
{
return jl_box_long(jl_array_len((jl_array_t*)a));
}