void jl_depwarn(const char *msg, jl_value_t *sym)
{
static jl_value_t *depwarn_func = NULL;
if (!depwarn_func && jl_base_module) {
depwarn_func = jl_get_global(jl_base_module, jl_symbol("depwarn"));
}
if (!depwarn_func) {
jl_safe_printf("WARNING: %s\n", msg);
return;
}
jl_value_t **depwarn_args;
JL_GC_PUSHARGS(depwarn_args, 3);
depwarn_args[0] = depwarn_func;
depwarn_args[1] = jl_cstr_to_string(msg);
depwarn_args[2] = sym;
jl_apply(depwarn_args, 3);
JL_GC_POP();
}
JL_DLLEXPORT void jl_set_ARGS(int argc, char **argv)
{
if (jl_core_module != NULL) {
jl_array_t *args = (jl_array_t*)jl_get_global(jl_core_module, jl_symbol("ARGS"));
if (args == NULL) {
args = jl_alloc_vec_any(0);
JL_GC_PUSH1(&args);
jl_set_const(jl_core_module, jl_symbol("ARGS"), (jl_value_t*)args);
JL_GC_POP();
}
assert(jl_array_len(args) == 0);
jl_array_grow_end(args, argc);
int i;
for (i=0; i < argc; i++) {
jl_value_t *s = (jl_value_t*)jl_cstr_to_string(argv[i]);
jl_arrayset(args, s, i);
}
}
}
static jl_module_t *eval_import_path_(jl_array_t *args, int retrying)
{
// in A.B.C, first find a binding for A in the chain of module scopes
// following parent links. then evaluate the rest of the path from there.
jl_sym_t *var = (jl_sym_t*)jl_cellref(args,0);
assert(jl_is_symbol(var));
jl_module_t *m = jl_current_module;
while (1) {
jl_binding_t *mb = jl_get_binding(m, var);
if (mb != NULL) {
if (mb->value == NULL || !jl_is_module(mb->value))
jl_errorf("invalid module path");
m = (jl_module_t*)mb->value;
break;
}
if (m == jl_main_module) {
if (!retrying) {
if (require_func == NULL && jl_base_module != NULL)
require_func = jl_get_global(jl_base_module, jl_symbol("require"));
if (require_func != NULL) {
jl_value_t *str = jl_cstr_to_string(var->name);
JL_GC_PUSH(&str);
jl_apply((jl_function_t*)require_func, &str, 1);
JL_GC_POP();
return eval_import_path_(args, 1);
}
}
jl_errorf("in module path: %s not defined", var->name);
}
m = m->parent;
}
for(size_t i=1; i < jl_array_len(args)-1; i++) {
jl_value_t *s = jl_cellref(args,i);
assert(jl_is_symbol(s));
m = (jl_module_t*)jl_eval_global_var(m, (jl_sym_t*)s);
if (!jl_is_module(m))
jl_errorf("invalid import statement");
}
return m;
}
static jl_value_t *scm_to_julia(value_t e)
{
#ifdef JL_GC_MARKSWEEP
int en = jl_gc_is_enabled();
jl_gc_disable();
#endif
jl_value_t *v;
JL_TRY {
v = scm_to_julia_(e);
}
JL_CATCH {
// if expression cannot be converted, replace with error expr
jl_expr_t *ex = jl_exprn(error_sym, 1);
jl_cellset(ex->args, 0, jl_cstr_to_string("invalid AST"));
v = (jl_value_t*)ex;
}
#ifdef JL_GC_MARKSWEEP
if (en) jl_gc_enable();
#endif
return v;
}
static jl_value_t *jl_vexceptionf(jl_datatype_t *exception_type,
const char *fmt, va_list args)
{
if (exception_type == NULL) {
jl_printf(JL_STDERR, "ERROR: ");
jl_vprintf(JL_STDERR, fmt, args);
jl_printf(JL_STDERR, "\n");
jl_exit(1);
}
char *str = NULL;
int ok = vasprintf(&str, fmt, args);
jl_value_t *msg;
if (ok < 0) { // vasprintf failed
msg = jl_cstr_to_string("internal error: could not display error message");
}
else {
msg = jl_pchar_to_string(str, strlen(str));
free(str);
}
JL_GC_PUSH1(&msg);
jl_value_t *e = jl_new_struct(exception_type, msg);
JL_GC_POP();
return e;
}
int jl_array_isdefined(jl_value_t **args0, int nargs)
{
assert(jl_is_array(args0[0]));
jl_value_t **depwarn_args;
JL_GC_PUSHARGS(depwarn_args, 3);
depwarn_args[0] = jl_get_global(jl_base_module, jl_symbol("depwarn"));
depwarn_args[1] = jl_cstr_to_string("isdefined(a::Array, i::Int) is deprecated, use isassigned(a, i) instead");
depwarn_args[2] = (jl_value_t*) jl_symbol("isdefined");
jl_apply(depwarn_args, 3);
JL_GC_POP();
jl_array_t *a = (jl_array_t*)args0[0];
jl_value_t **args = &args0[1];
size_t nidxs = nargs-1;
size_t i=0;
size_t k, stride=1;
size_t nd = jl_array_ndims(a);
for(k=0; k < nidxs; k++) {
if (!jl_is_long(args[k]))
jl_type_error("isdefined", (jl_value_t*)jl_long_type, args[k]);
size_t ii = jl_unbox_long(args[k])-1;
i += ii * stride;
size_t d = k>=nd ? 1 : jl_array_dim(a, k);
if (k < nidxs-1 && ii >= d)
return 0;
stride *= d;
}
for(; k < nd; k++)
stride *= jl_array_dim(a, k);
if (i >= stride)
return 0;
if (a->flags.ptrarray)
return ((jl_value_t**)jl_array_data(a))[i] != NULL;
return 1;
}
// Encoding for individual strings is handled by Julia. Julia strings are immutable.
inline jl_value_t* box(const std::string& val) { return jl_cstr_to_string(val.c_str()); }
static NOINLINE int true_main(int argc, char *argv[])
{
if (jl_core_module != NULL) {
jl_array_t *args = (jl_array_t*)jl_get_global(jl_core_module, jl_symbol("ARGS"));
if (args == NULL) {
args = jl_alloc_cell_1d(0);
JL_GC_PUSH1(&args);
jl_set_const(jl_core_module, jl_symbol("ARGS"), (jl_value_t*)args);
JL_GC_POP();
}
assert(jl_array_len(args) == 0);
jl_array_grow_end(args, argc);
int i;
for (i=0; i < argc; i++) {
jl_value_t *s = (jl_value_t*)jl_cstr_to_string(argv[i]);
jl_set_typeof(s,jl_utf8_string_type);
jl_arrayset(args, s, i);
}
}
jl_function_t *start_client = jl_base_module ?
(jl_function_t*)jl_get_global(jl_base_module, jl_symbol("_start")) : NULL;
if (start_client) {
jl_apply(&start_client, 1);
return 0;
}
// run program if specified, otherwise enter REPL
if (argc > 0) {
if (strcmp(argv[0], "-")) {
return exec_program(argv[0]);
}
}
ios_puts("WARNING: Base._start not defined, falling back to economy mode repl.\n", ios_stdout);
if (!jl_errorexception_type)
ios_puts("WARNING: jl_errorexception_type not defined; any errors will be fatal.\n", ios_stdout);
while (!ios_eof(ios_stdin)) {
char *volatile line = NULL;
JL_TRY {
ios_puts("\njulia> ", ios_stdout);
ios_flush(ios_stdout);
line = ios_readline(ios_stdin);
jl_value_t *val = (jl_value_t*)jl_eval_string(line);
if (jl_exception_occurred()) {
jl_printf(JL_STDERR, "error during run:\n");
jl_static_show(JL_STDERR, jl_exception_in_transit);
jl_exception_clear();
}
else if (val) {
jl_static_show(JL_STDOUT, val);
}
jl_printf(JL_STDOUT, "\n");
free(line);
line = NULL;
uv_run(jl_global_event_loop(),UV_RUN_NOWAIT);
}
JL_CATCH {
if (line) {
free(line);
line = NULL;
}
jl_printf(JL_STDERR, "\nparser error:\n");
jl_static_show(JL_STDERR, jl_exception_in_transit);
jl_printf(JL_STDERR, "\n");
jlbacktrace();
}
}
return 0;
}
static jl_value_t *R_Julia_MD_NA(SEXP Var, const char *VarName)
{
if ((LENGTH(Var)) != 0)
{
jl_tuple_t *dims = RDims_JuliaTuple(Var);
switch (TYPEOF(Var))
{
case LGLSXP:
{
jl_array_t *ret = CreateArray(jl_bool_type, jl_tuple_len(dims), dims);
jl_array_t *ret1 = CreateArray(jl_bool_type, jl_tuple_len(dims), dims);
JL_GC_PUSH(&ret, &ret1);
char *retData = (char *)jl_array_data(ret);
bool *retData1 = (bool *)jl_array_data(ret1);
for (size_t i = 0; i < jl_array_len(ret); i++)
{
if (LOGICAL(Var)[i] == NA_LOGICAL)
{
retData[i] = 1;
retData1[i] = true;
}
else
{
retData[i] = LOGICAL(Var)[i];
retData1[i] = false;
}
}
JL_GC_POP();
return TransArrayToDataArray(ret, ret1, VarName);
break;
};
case INTSXP:
{
jl_array_t *ret = CreateArray(jl_int32_type, jl_tuple_len(dims), dims);
jl_array_t *ret1 = CreateArray(jl_bool_type, jl_tuple_len(dims), dims);
JL_GC_PUSH(&ret, &ret1);
int *retData = (int *)jl_array_data(ret);
bool *retData1 = (bool *)jl_array_data(ret1);
for (size_t i = 0; i < jl_array_len(ret); i++)
{
if (INTEGER(Var)[i] == NA_INTEGER)
{
retData[i] = 999;
retData1[i] = true;
}
else
{
retData[i] = INTEGER(Var)[i];
retData1[i] = false;
}
}
JL_GC_POP();
return TransArrayToDataArray(ret, ret1, VarName);
break;
}
case REALSXP:
{
jl_array_t *ret = CreateArray(jl_float64_type, jl_tuple_len(dims), dims);
jl_array_t *ret1 = CreateArray(jl_bool_type, jl_tuple_len(dims), dims);
JL_GC_PUSH(&ret, &ret1);
double *retData = (double *)jl_array_data(ret);
bool *retData1 = (bool *)jl_array_data(ret1);
for (size_t i = 0; i < jl_array_len(ret); i++)
{
if (ISNAN(REAL(Var)[i]))
{
retData[i] = 999.01;
retData1[i] = true;
}
else
{
retData[i] = REAL(Var)[i];
retData1[i] = false;
}
}
JL_GC_POP();
return TransArrayToDataArray(ret, ret1, VarName);
break;
}
case STRSXP:
{
jl_array_t *ret;
if (!IS_ASCII(Var))
ret = CreateArray(jl_utf8_string_type, jl_tuple_len(dims), dims);
else
ret = CreateArray(jl_ascii_string_type, jl_tuple_len(dims), dims);
jl_array_t *ret1 = CreateArray(jl_bool_type, jl_tuple_len(dims), dims);
JL_GC_PUSH(&ret, &ret1);
jl_value_t **retData = jl_array_data(ret);
bool *retData1 = (bool *)jl_array_data(ret1);
for (size_t i = 0; i < jl_array_len(ret); i++)
{
if (STRING_ELT(Var, i) == NA_STRING)
{
retData[i] = jl_cstr_to_string("999");
retData1[i] = true;
}
else
{
if (!IS_ASCII(Var))
retData[i] = jl_cstr_to_string(translateChar0(STRING_ELT(Var, i)));
else
retData[i] = jl_cstr_to_string(CHAR(STRING_ELT(Var, i)));
retData1[i] = false;
}
}
JL_GC_POP();
return TransArrayToDataArray(ret, ret1, VarName);
break;
}
default:
return (jl_value_t *) jl_nothing;
break;
}//case end
return (jl_value_t *) jl_nothing;
}//if length !=0
return (jl_value_t *) jl_nothing;
}
JL_DLLEXPORT jl_value_t *jl_get_julia_bin(void)
{
return jl_cstr_to_string(jl_options.julia_bin);
}
JL_DLLEXPORT jl_value_t *jl_get_image_file(void)
{
return jl_cstr_to_string(jl_options.image_file);
}
DLLEXPORT jl_value_t *jl_get_image_file(void)
{
return jl_cstr_to_string(jl_compileropts.image_file);
}
static jl_value_t *R_Julia_MD(SEXP Var, const char *VarName)
{
if ((LENGTH(Var)) != 0)
{
jl_tuple_t *dims = RDims_JuliaTuple(Var);
switch (TYPEOF( Var))
{
case LGLSXP:
{
jl_array_t *ret = CreateArray(jl_bool_type, jl_tuple_len(dims), dims);
JL_GC_PUSH1(&ret);
char *retData = (char *)jl_array_data(ret);
for (size_t i = 0; i < jl_array_len(ret); i++)
retData[i] = LOGICAL(Var)[i];
jl_set_global(jl_main_module, jl_symbol(VarName), (jl_value_t *)ret);
return (jl_value_t *) ret;
JL_GC_POP();
break;
};
case INTSXP:
{
jl_array_t *ret = CreateArray(jl_int32_type, jl_tuple_len(dims), dims);
JL_GC_PUSH1(&ret);
int *retData = (int *)jl_array_data(ret);
for (size_t i = 0; i < jl_array_len(ret); i++)
retData[i] = INTEGER(Var)[i];
jl_set_global(jl_main_module, jl_symbol(VarName), (jl_value_t *)ret);
return (jl_value_t *) ret;
JL_GC_POP();
break;
}
case REALSXP:
{
jl_array_t *ret = CreateArray(jl_float64_type, jl_tuple_len(dims), dims);
JL_GC_PUSH1(&ret);
double *retData = (double *)jl_array_data(ret);
for (size_t i = 0; i < jl_array_len(ret); i++)
retData[i] = REAL(Var)[i];
jl_set_global(jl_main_module, jl_symbol(VarName), (jl_value_t *)ret);
JL_GC_POP();
return (jl_value_t *) ret;
break;
}
case STRSXP:
{
jl_array_t *ret;
if (!IS_ASCII(Var))
ret = CreateArray(jl_utf8_string_type, jl_tuple_len(dims), dims);
else
ret = CreateArray(jl_ascii_string_type, jl_tuple_len(dims), dims);
JL_GC_PUSH1(&ret);
jl_value_t **retData = jl_array_data(ret);
for (size_t i = 0; i < jl_array_len(ret); i++)
if (!IS_ASCII(Var))
retData[i] = jl_cstr_to_string(translateChar0(STRING_ELT(Var, i)));
else
retData[i] = jl_cstr_to_string(CHAR(STRING_ELT(Var, i)));
jl_set_global(jl_main_module, jl_symbol(VarName), (jl_value_t *)ret);
JL_GC_POP();
return (jl_value_t *) ret;
break;
}
case VECSXP:
{
char eltcmd[eltsize];
jl_tuple_t *ret = jl_alloc_tuple(length(Var));
JL_GC_PUSH1(&ret);
for (int i = 0; i < length(Var); i++)
{
snprintf(eltcmd, eltsize, "%selement%d", VarName, i);
jl_tupleset(ret, i, R_Julia_MD(VECTOR_ELT(Var, i), eltcmd));
}
jl_set_global(jl_main_module, jl_symbol(VarName), (jl_value_t *)ret);
JL_GC_POP();
return (jl_value_t *) ret;
}
default:
{
return (jl_value_t *) jl_nothing;
}
break;
}
return (jl_value_t *) jl_nothing;
}
return (jl_value_t *) jl_nothing;
}
DLLEXPORT jl_value_t *jl_get_julia_bin(void)
{
return jl_cstr_to_string(jl_compileropts.julia_bin);
}
inline jl_value_t* box(const char* val) { return jl_cstr_to_string(val); }
//-| mode=="rcqls" is for rcqls development, mode="tty" is for initialization of STDOUT, STDERR with C API)
//-| other value of mode mean standard jlapi.c
DLLEXPORT void jlapi_init(char *julia_home_dir, char* mode) {
libsupport_init();
char *image_file = jl_locate_sysimg(julia_home_dir);
printf("image-file=%s\n",image_file);
julia_init(image_file);
jlapi_mode=mode;
jl_set_const(jl_core_module, jl_symbol("JULIA_HOME"),
jl_cstr_to_string(julia_home));
jl_module_export(jl_core_module, jl_symbol("JULIA_HOME"));
//-| This avoid LD_PRELOAD on linux since shared objects not exported
//-| Maybe fix this in a better way with options compilation.
char julia_api_libname[512];
#if defined(_OS_WINDOWS_)
const char *shlib_ext=".dll";
const char *sep="\\";
#elif defined(__APPLE__)
const char *shlib_ext=".dylib";
const char *sep="/";
#else
const char *shlib_ext=".so";
const char *sep="/";
#endif
snprintf(julia_api_libname, sizeof(julia_api_libname), "%s%s%s%s%s%s",
julia_home_dir, sep,"julia",sep,"libjulia-api",shlib_ext);
load_library_permanently(julia_api_libname);
if(strcmp(mode,"rcqls")<=0) { // cqls, rcqls
//-| Called first to fix the DL_LOAD_PATH needed to (dl)open library (libpcre for example)
//-| Replacement of Base.init_load_path()
//-| Update 01/08/2013: No need to set DL_LOAD_PATH, just push
//-| jl_set_global(jl_base_module,jl_symbol("DL_LOAD_PATH"),jl_eval_string("ByteString[join([JULIA_HOME,\"..\",\"lib\",\"julia\"],Base.path_separator)]"));
jl_eval_string("Base.push!(DL_LOAD_PATH,join([JULIA_HOME,\"..\",\"lib\",\"julia\"],Base.path_separator))");
//-| DL_LOAD_PATH is a global constant already defined before and then not overloaded by julia
//-| Only LOAD_PATH would be initialized (needs libpcre because of abspath)!
jl_eval_string("vers = \"v$(VERSION.major).$(VERSION.minor)\"");
jl_set_global(jl_base_module,jl_symbol("LOAD_PATH"),jl_eval_string("ByteString[abspath(JULIA_HOME,\"..\",\"local\",\"share\",\"julia\",\"site\",vers),abspath(JULIA_HOME,\"..\",\"share\",\"julia\",\"site\",vers)]"));
} else jl_eval_string("Base.init_load_path()");
if(strcmp(mode,"tty")==0) {
jl_eval_string("Base.reinit_stdio()");
jl_set_global(jl_base_module,jl_symbol("STDIN"),jl_eval_string("Base.init_stdio(ccall(:jl_stdin_stream ,Ptr{Void},()),0)"));
//-| 2 next lines fails even it is if no more necessary
//-| Update 27/07/13: no more crash but stuck when print.
jl_set_global(jl_base_module,jl_symbol("STDOUT"),jl_eval_string("Base.init_stdio(ccall(:jl_stdout_stream,Ptr{Void},()),1)"));
jl_set_global(jl_base_module,jl_symbol("STDERR"),jl_eval_string("Base.init_stdio(ccall(:jl_stderr_stream,Ptr{Void},()),2)"));
} else if(strcmp(mode,"rcqls")<=0) { //cqls, rcqls
jl_eval_string("Base.reinit_stdio()");
//-| STDIN, STDOUT and STDERR not properly loaded
//-| I prefer redirection of STDOUT and STDERR in IOBuffer (maybe STDIN ???)
jl_set_global(jl_base_module,jl_symbol("STDIN"),jl_eval_string("Base.init_stdio(ccall(:jl_stdin_stream ,Ptr{Void},()),0)"));
//jl_set_global(jl_base_module,jl_symbol("STDIN"),jl_eval_string("IOBuffer()"));
jl_set_global(jl_base_module,jl_symbol("STDOUT"),jl_eval_string("IOBuffer()"));
jl_set_global(jl_base_module,jl_symbol("STDERR"),jl_eval_string("IOBuffer()"));
} else jl_eval_string("Base.reinit_stdio()");
jl_eval_string("Base.fdwatcher_reinit()");
jl_eval_string("Base.Random.librandom_init()");
jl_eval_string("Base.check_blas()");
jl_eval_string("LinAlg.init()");
jl_eval_string("Sys.init()");
jl_eval_string("Base.init_sched()");
jl_eval_string("Base.init_head_sched()");
jl_eval_string("Base.try_include(abspath(ENV[\"HOME\"],\".juliarc.jl\"))");
if(strcmp(mode,"rcqls")==0) {
jl_eval_string("println(\"Julia initialized!\")");
jlapi_print_stdout();
}
}
DLLEXPORT jl_value_t *jl_get_julia_home(void)
{
return jl_cstr_to_string(jl_options.julia_home);
}
static jl_module_t *eval_import_path_(jl_array_t *args, int retrying)
{
// in .A.B.C, first find a binding for A in the chain of module scopes
// following parent links. then evaluate the rest of the path from there.
// in A.B, look for A in Main first.
jl_sym_t *var = (jl_sym_t*)jl_cellref(args,0);
size_t i=1;
if (!jl_is_symbol(var)) jl_type_error("import or using", (jl_value_t*)jl_sym_type, (jl_value_t*)var);
jl_module_t *m;
if (var != dot_sym) {
m = jl_main_module;
}
else {
m = jl_current_module;
while (1) {
var = (jl_sym_t*)jl_cellref(args,i);
if (!jl_is_symbol(var)) jl_type_error("import or using", (jl_value_t*)jl_sym_type, (jl_value_t*)var);
i++;
if (var != dot_sym) {
if (i == jl_array_len(args))
return m;
else
break;
}
m = m->parent;
}
}
while (1) {
if (jl_binding_resolved_p(m, var)) {
jl_binding_t *mb = jl_get_binding(m, var);
jl_module_t *m0 = m;
assert(mb != NULL);
if (mb->owner == m0 || mb->imported) {
m = (jl_module_t*)mb->value;
if ((mb->owner == m0 && m != NULL && !jl_is_module(m)) ||
(mb->imported && (m == NULL || !jl_is_module(m))))
jl_errorf("invalid module path (%s does not name a module)", var->name);
// If the binding has been resolved but is (1) undefined, and (2) owned
// by the module we're importing into, then allow the import into the
// undefined variable (by setting m back to m0).
if (m == NULL)
m = m0;
else
break;
}
}
if (m == jl_main_module) {
if (!retrying && i==1) { // (i==1) => no require() for relative imports
if (require_func == NULL && jl_base_module != NULL)
require_func = jl_get_global(jl_base_module, jl_symbol("require"));
if (require_func != NULL) {
jl_value_t *str = jl_cstr_to_string(var->name);
JL_GC_PUSH1(&str);
jl_apply((jl_function_t*)require_func, &str, 1);
JL_GC_POP();
return eval_import_path_(args, 1);
}
}
}
if (retrying && require_func) {
JL_PRINTF(JL_STDERR, "Warning: requiring \"%s\" did not define a corresponding module.\n", var->name);
return NULL;
}
else {
jl_errorf("in module path: %s not defined", var->name);
}
}
for(; i < jl_array_len(args)-1; i++) {
jl_value_t *s = jl_cellref(args,i);
assert(jl_is_symbol(s));
m = (jl_module_t*)jl_eval_global_var(m, (jl_sym_t*)s);
if (!jl_is_module(m))
jl_errorf("invalid import statement");
}
return m;
}