static void show_type(jl_value_t *st, jl_value_t *t)
{
ios_t *s = (ios_t*)jl_iostr_data(st);
if (jl_is_union_type(t)) {
if (t == (jl_value_t*)jl_bottom_type) {
JL_WRITE(s, "None", 4);
}
else if (t == jl_top_type) {
JL_WRITE(s, "Top", 3);
}
else {
JL_WRITE(s, "Union", 5);
jl_show_tuple(st, ((jl_uniontype_t*)t)->types, '(', ')', 0);
}
}
else if (jl_is_seq_type(t)) {
jl_show(st, jl_tparam0(t));
JL_WRITE(s, "...", 3);
}
else if (jl_is_typector(t)) {
jl_show(st, (jl_value_t*)((jl_typector_t*)t)->body);
}
else {
assert(jl_is_some_tag_type(t));
jl_tag_type_t *tt = (jl_tag_type_t*)t;
JL_PUTS(tt->name->name->name, s);
jl_tuple_t *p = tt->parameters;
if (jl_tuple_len(p) > 0)
jl_show_tuple(st, p, '{', '}', 0);
}
}
int true_main(int argc, char *argv[])
{
if (lisp_prompt) {
jl_lisp_prompt();
return 0;
}
jl_array_t *args = jl_alloc_cell_1d(argc);
jl_set_global(jl_current_module, jl_symbol("ARGS"), (jl_value_t*)args);
int i;
for (i=0; i < argc; i++) {
jl_arrayset(args, i, (jl_value_t*)jl_cstr_to_string(argv[i]));
}
jl_set_const(jl_current_module, jl_symbol("JULIA_HOME"),
jl_cstr_to_string(julia_home));
// run program if specified, otherwise enter REPL
if (program) {
return exec_program();
}
init_repl_environment();
jl_function_t *start_client =
(jl_function_t*)jl_get_global(jl_base_module, jl_symbol("_start"));
if (start_client) {
jl_apply(start_client, NULL, 0);
return 0;
}
// client event loop not available; use fallback blocking version
int iserr = 0;
again:
;
JL_TRY {
if (iserr) {
jl_show(jl_exception_in_transit);
ios_printf(ios_stdout, "\n\n");
iserr = 0;
}
while (1) {
char *input = read_expr("julia> ");
if (!input || ios_eof(ios_stdin)) {
ios_printf(ios_stdout, "\n");
break;
}
jl_value_t *ast = jl_parse_input_line(input);
jl_value_t *value = jl_toplevel_eval(ast);
jl_show(value);
ios_printf(ios_stdout, "\n\n");
}
}
JL_CATCH {
iserr = 1;
goto again;
}
return 0;
}
static void run_finalizer(jl_value_t *o, jl_value_t *ff)
{
jl_function_t *f;
while (jl_is_tuple(ff)) {
f = (jl_function_t*)jl_t0(ff);
assert(jl_is_function(f));
JL_TRY {
jl_apply(f, (jl_value_t**)&o, 1);
}
JL_CATCH {
JL_PRINTF(JL_STDERR, "error in running finalizer: ");
jl_show(jl_stderr_obj(), jl_exception_in_transit);
JL_PUTC('\n',JL_STDERR);
}
ff = jl_t1(ff);
}
f = (jl_function_t*)ff;
assert(jl_is_function(f));
JL_TRY {
jl_apply(f, (jl_value_t**)&o, 1);
}
JL_CATCH {
JL_PRINTF(JL_STDERR, "error in running finalizer: ");
jl_show(jl_stderr_obj(), jl_exception_in_transit);
JL_PUTC('\n',JL_STDERR);
}
}
static int exec_program(char *program)
{
int err = 0;
again: ;
JL_TRY {
if (err) {
jl_value_t *errs = jl_stderr_obj();
jl_value_t *e = jl_exception_in_transit;
if (errs != NULL) {
jl_show(errs, e);
}
else {
jl_printf(JL_STDERR, "error during bootstrap:\n");
jl_static_show(JL_STDERR, e);
jl_printf(JL_STDERR, "\n");
jlbacktrace();
}
jl_printf(JL_STDERR, "\n");
JL_EH_POP();
return 1;
}
jl_load(program, strlen(program));
}
JL_CATCH {
err = 1;
goto again;
}
return 0;
}
DLLEXPORT void jl_show_any(jl_value_t *v)
{
// fallback for printing some other builtin types
ios_t *s = jl_current_output_stream();
if (jl_is_tuple(v)) {
show_tuple((jl_tuple_t*)v, '(', ')', 1);
}
else if (jl_is_type(v)) {
show_type(v);
}
else if (jl_is_func(v)) {
show_function(v);
}
else if (jl_typeis(v,jl_intrinsic_type)) {
ios_printf(s, "#<intrinsic-function %d>", *(uint32_t*)jl_bits_data(v));
}
else {
jl_value_t *t = (jl_value_t*)jl_typeof(v);
if (jl_is_struct_type(t)) {
jl_struct_type_t *st = (jl_struct_type_t*)t;
ios_puts(st->name->name->name, s);
ios_putc('(', s);
size_t i;
size_t n = st->names->length;
for(i=0; i < n; i++) {
jl_show(nth_field(v, i));
if (i < n-1)
ios_putc(',', s);
}
ios_putc(')', s);
}
}
}
DLLEXPORT void jl_show_any(jl_value_t *str, jl_value_t *v)
{
ios_t *s = (ios_t*)jl_iostr_data(str);
// fallback for printing some other builtin types
if (jl_is_tuple(v)) {
jl_show_tuple(str, (jl_tuple_t*)v, '(', ')', 1);
}
else if (jl_is_type(v)) {
show_type(str, v);
}
else if (jl_is_func(v)) {
show_function(s, v);
}
else if (jl_typeis(v,jl_intrinsic_type)) {
JL_PRINTF(s, "#<intrinsic-function %d>", *(uint32_t*)jl_bits_data(v));
}
else {
jl_value_t *t = (jl_value_t*)jl_typeof(v);
if (jl_is_struct_type(t)) {
jl_struct_type_t *st = (jl_struct_type_t*)t;
JL_PUTS(st->name->name->name, s);
JL_PUTC('(', s);
size_t i;
size_t n = jl_tuple_len(st->names);
for(i=0; i < n; i++) {
jl_show(str, nth_field(v, i));
if (i < n-1)
JL_PUTC(',', s);
}
JL_PUTC(')', s);
}
}
}
static int exec_program(void)
{
int err = 0;
again: ;
JL_TRY {
if (err) {
//jl_lisp_prompt();
//return 1;
jl_value_t *errs = jl_stderr_obj();
jl_value_t *e = jl_exception_in_transit;
if (errs != NULL) {
jl_show(jl_stderr_obj(), e);
}
else {
jl_printf(JL_STDERR, "error during bootstrap: ");
jl_static_show(JL_STDERR, e);
}
jl_printf(JL_STDERR, "\n");
JL_EH_POP();
return 1;
}
jl_load(program);
}
JL_CATCH {
err = 1;
goto again;
}
return 0;
}
static void show_type(jl_value_t *t)
{
ios_t *s = jl_current_output_stream();
if (jl_is_func_type(t)) {
if (t == (jl_value_t*)jl_any_func) {
ios_puts("Function", s);
}
else {
jl_show((jl_value_t*)((jl_func_type_t*)t)->from);
ios_write(s, "-->", 3);
jl_show((jl_value_t*)((jl_func_type_t*)t)->to);
}
}
else if (t == (jl_value_t*)jl_function_type) {
ios_puts("Function", s);
}
else if (jl_is_union_type(t)) {
if (t == (jl_value_t*)jl_bottom_type) {
ios_write(s, "None", 4);
}
else if (t == jl_top_type) {
ios_write(s, "Top", 3);
}
else {
ios_write(s, "Union", 5);
show_tuple(((jl_uniontype_t*)t)->types, '(', ')', 0);
}
}
else if (jl_is_seq_type(t)) {
jl_show(jl_tparam0(t));
ios_write(s, "...", 3);
}
else if (jl_is_typector(t)) {
jl_show((jl_value_t*)((jl_typector_t*)t)->body);
}
else {
assert(jl_is_some_tag_type(t));
jl_tag_type_t *tt = (jl_tag_type_t*)t;
ios_puts(tt->name->name->name, s);
jl_tuple_t *p = tt->parameters;
if (p->length > 0)
show_tuple(p, '{', '}', 0);
}
}
int true_main(int argc, char *argv[])
{
if (lisp_prompt) {
jl_lisp_prompt();
return 0;
}
jl_array_t *args = jl_alloc_cell_1d(argc);
jl_set_global(jl_system_module, jl_symbol("ARGS"), (jl_value_t*)args);
int i;
for (i=0; i < argc; i++) {
jl_arrayset(args, i, (jl_value_t*)jl_cstr_to_string(argv[i]));
}
jl_set_const(jl_system_module, jl_symbol("JULIA_HOME"),
jl_cstr_to_string(julia_home));
// run program if specified, otherwise enter REPL
if (program) {
return exec_program();
}
init_repl_environment();
have_color = detect_color();
char *prompt = have_color ? jl_prompt_color : jl_prompt_plain;
prompt_length = strlen(jl_prompt_plain);
prompt_string = prompt;
jl_function_t *start_client =
(jl_function_t*)
jl_get_global(jl_system_module, jl_symbol("_start"));
if (start_client == NULL) {
repl_print_prompt();
// client event loop not available; use fallback blocking version
int iserr = 0;
again:
;
JL_TRY {
if (iserr) {
if (have_color) {
ios_printf(ios_stdout, jl_color_normal);
}
jl_show(jl_exception_in_transit);
ios_printf(ios_stdout, "\n\n");
iserr = 0;
}
while (1) {
read_expr(prompt);
}
}
JL_CATCH {
iserr = 1;
goto again;
}
}
int true_main(int argc, char *argv[])
{
if (jl_base_module != NULL) {
jl_array_t *args = (jl_array_t*)jl_get_global(jl_base_module, jl_symbol("ARGS"));
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]);
s->type = (jl_value_t*)jl_utf8_string_type;
jl_arrayset(args, s, i);
}
}
// run program if specified, otherwise enter REPL
if (program) {
int ret = exec_program();
uv_tty_reset_mode();
return ret;
}
jl_function_t *start_client =
(jl_function_t*)jl_get_global(jl_base_module, jl_symbol("_start"));
//uv_read_start(jl_stdin_tty,jl_alloc_read_buffer,&read_buffer);
if (start_client) {
jl_apply(start_client, NULL, 0);
//rl_cleanup_after_signal();
return 0;
}
// client event loop not available; use fallback blocking version
//install_read_event_handler(&echoBack);
int iserr = 0;
again:
;
JL_TRY {
if (iserr) {
//jl_show(jl_exception_in_transit);# What if the error was in show?
jl_printf(JL_STDERR, "\n\n");
iserr = 0;
}
uv_run(jl_global_event_loop(),UV_RUN_DEFAULT);
}
JL_CATCH {
iserr = 1;
JL_PUTS("error during run:\n",JL_STDERR);
jl_show(jl_stderr_obj(),jl_exception_in_transit);
JL_PUTS("\n",JL_STDOUT);
goto again;
}
uv_tty_reset_mode();
return iserr;
}
int true_main(int argc, char *argv[])
{
if (jl_base_module != NULL) {
jl_array_t *args = (jl_array_t*)jl_get_global(jl_base_module, jl_symbol("ARGS"));
if (args == NULL) {
args = jl_alloc_cell_1d(0);
jl_set_const(jl_base_module, jl_symbol("ARGS"), (jl_value_t*)args);
}
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]);
s->type = (jl_value_t*)jl_utf8_string_type;
jl_arrayset(args, s, i);
}
}
// run program if specified, otherwise enter REPL
if (program) {
int ret = exec_program();
uv_tty_reset_mode();
return ret;
}
jl_function_t *start_client =
(jl_function_t*)jl_get_global(jl_base_module, jl_symbol("_start"));
if (start_client) {
jl_apply(start_client, NULL, 0);
return 0;
}
int iserr = 0;
again:
;
JL_TRY {
if (iserr) {
//jl_show(jl_exception_in_transit);# What if the error was in show?
jl_printf(JL_STDERR, "\n\n");
iserr = 0;
}
uv_run(jl_global_event_loop(),UV_RUN_DEFAULT);
}
JL_CATCH {
iserr = 1;
JL_PUTS("error during run:\n",JL_STDERR);
jl_show(jl_stderr_obj(),jl_exception_in_transit);
JL_PUTS("\n",JL_STDOUT);
goto again;
}
uv_tty_reset_mode();
return iserr;
}
static void print_obj_profile(void)
{
jl_value_t *errstream = jl_stderr_obj();
for(int i=0; i < obj_counts.size; i+=2) {
if (obj_counts.table[i+1] != HT_NOTFOUND) {
ios_printf(ios_stderr, "%d ", obj_counts.table[i+1]-1);
jl_show(errstream, obj_counts.table[i]);
ios_printf(ios_stderr, "\n");
}
}
}
// comma_one prints a comma for 1 element, e.g. "(x,)"
static void show_tuple(jl_tuple_t *t, char opn, char cls, int comma_one)
{
ios_t *s = jl_current_output_stream();
ios_putc(opn, s);
size_t i, n=t->length;
for(i=0; i < n; i++) {
jl_show(jl_tupleref(t, i));
if ((i < n-1) || (n==1 && comma_one))
ios_putc(',', s);
}
ios_putc(cls, s);
}
// comma_one prints a comma for 1 element, e.g. "(x,)"
void jl_show_tuple(jl_value_t *st, jl_tuple_t *t, char opn, char cls, int comma_one)
{
JL_STREAM *s = ((JL_STREAM**)st)[1];
JL_PUTC(opn, s);
size_t i, n=jl_tuple_len(t);
for(i=0; i < n; i++) {
jl_show(st, jl_tupleref(t, i));
if ((i < n-1) || (n==1 && comma_one))
JL_PUTC(',', s);
}
JL_PUTC(cls, s);
}
// comma_one prints a comma for 1 element, e.g. "(x,)"
void jl_show_tuple(jl_value_t *st, jl_tuple_t *t, char opn, char cls, int comma_one)
{
ios_t *s = (ios_t*)jl_iostr_data(st);
JL_PUTC(opn, s);
size_t i, n=jl_tuple_len(t);
for(i=0; i < n; i++) {
jl_show(st, jl_tupleref(t, i));
if ((i < n-1) || (n==1 && comma_one))
JL_PUTC(',', s);
}
JL_PUTC(cls, s);
}
/*
warn about ambiguous method priorities
the relative priority of A and B is ambiguous if
!subtype(A,B) && !subtype(B,A) && no corresponding tuple
elements are disjoint.
for example, (AbstractArray, AbstractMatrix) and (AbstractMatrix, AbstractArray) are ambiguous.
however, (AbstractArray, AbstractMatrix, Foo) and (AbstractMatrix, AbstractArray, Bar) are fine
since Foo and Bar are disjoint, so there would be no confusion over
which one to call.
There is also this kind of ambiguity: foo{T,S}(T, S) vs. foo(Any,Any)
In this case jl_types_equal() is true, but one is jl_type_morespecific
or jl_type_match_morespecific than the other.
To check this, jl_types_equal_generic needs to be more sophisticated
so (T,T) is not equivalent to (Any,Any). (TODO)
*/
static void check_ambiguous(jl_methlist_t *ml, jl_tuple_t *type,
jl_tuple_t *sig, jl_sym_t *fname)
{
// we know !jl_args_morespecific(type, sig)
if ((type->length==sig->length ||
(type->length==sig->length+1 && is_va_tuple(type)) ||
(type->length+1==sig->length && is_va_tuple(sig))) &&
!jl_args_morespecific((jl_value_t*)sig, (jl_value_t*)type)) {
jl_value_t *isect = jl_type_intersection((jl_value_t*)type,
(jl_value_t*)sig);
if (isect == (jl_value_t*)jl_bottom_type)
return;
JL_GC_PUSH(&isect);
jl_methlist_t *l = ml;
while (l != NULL) {
if (sigs_eq(isect, (jl_value_t*)l->sig))
goto done_chk_amb; // ok, intersection is covered
l = l->next;
}
char *n = fname->name;
jl_value_t *errstream = jl_get_global(jl_system_module,
jl_symbol("stderr_stream"));
JL_TRY {
if (errstream)
jl_set_current_output_stream_obj(errstream);
ios_t *s = jl_current_output_stream();
ios_printf(s, "Warning: New definition %s", n);
jl_show((jl_value_t*)type);
ios_printf(s, " is ambiguous with %s", n);
jl_show((jl_value_t*)sig);
ios_printf(s, ".\n Make sure %s", n);
jl_show(isect);
ios_printf(s, " is defined first.\n");
}
JL_CATCH {
jl_raise(jl_exception_in_transit);
}
done_chk_amb:
JL_GC_POP();
}
//try load julia DataArrays and DataFrames packages
SEXP Julia_LoadDataArrayFrame()
{
jl_eval_string("using DataArrays,DataFrames");
if (jl_exception_occurred())
{
jl_show(jl_stderr_obj(), jl_exception_occurred());
Rprintf("\n");
jl_exception_clear();
}
else
DataArrayFrameInited = 1;
return R_NilValue;
}
DLLEXPORT void jl_show_any(jl_value_t *str, jl_value_t *v)
{
ios_t *s = (ios_t*)jl_iostr_data(str);
// fallback for printing some other builtin types
if (jl_is_tuple(v)) {
jl_show_tuple(str, (jl_tuple_t*)v, '(', ')', 1);
}
else if (jl_is_type(v)) {
show_type(str, v);
}
else if (jl_is_func(v)) {
show_function(s, v);
}
else if (jl_typeis(v,jl_intrinsic_type)) {
JL_PRINTF(s, "#<intrinsic-function %d>", *(uint32_t*)jl_bits_data(v));
}
else {
jl_value_t *t = (jl_value_t*)jl_typeof(v);
assert(jl_is_struct_type(t) || jl_is_bits_type(t));
jl_tag_type_t *tt = (jl_tag_type_t*)t;
JL_PUTS(tt->name->name->name, s);
if (tt->parameters != jl_null) {
jl_show_tuple(str, tt->parameters, '{', '}', 0);
}
JL_PUTC('(', s);
if (jl_is_struct_type(tt)) {
jl_struct_type_t *st = (jl_struct_type_t*)tt;
size_t i;
size_t n = jl_tuple_len(st->names);
for(i=0; i < n; i++) {
jl_value_t *fval = jl_get_nth_field(v, i);
if (fval == NULL)
JL_PUTS("#undef", s);
else
jl_show(str, fval);
if (i < n-1)
JL_PUTC(',', s);
}
}
else {
size_t nb = jl_bitstype_nbits(tt)/8;
char *data = (char*)jl_bits_data(v);
JL_PUTS("0x", s);
for(int i=nb-1; i >= 0; --i)
ios_printf(s, "%02hhx", data[i]);
}
JL_PUTC(')', s);
}
}
//first pass creat array then convert it to DataArray
//second pass assign NA to element
static jl_value_t *TransArrayToDataArray(jl_array_t *mArray, jl_array_t *mboolArray, const char *VarName)
{
char evalcmd[evalsize];
jl_set_global(jl_main_module, jl_symbol("TransVarName"), (jl_value_t *)mArray);
jl_set_global(jl_main_module, jl_symbol("TransVarNamebool"), (jl_value_t *)mboolArray);
snprintf(evalcmd, evalsize, "%s=DataArray(TransVarName,TransVarNamebool)", VarName);
jl_value_t *ret = jl_eval_string(evalcmd);
if (jl_exception_occurred())
{
jl_show(jl_stderr_obj(), jl_exception_occurred());
Rprintf("\n");
jl_exception_clear();
return (jl_value_t *) jl_nothing;
}
return ret;
}
DLLEXPORT void uv_atexit_hook()
{
#if defined(JL_GC_MARKSWEEP) && defined(GC_FINAL_STATS)
jl_print_gc_stats(JL_STDERR);
#endif
if (jl_base_module) {
jl_value_t *f = jl_get_global(jl_base_module, jl_symbol("_atexit"));
if (f!=NULL && jl_is_function(f)) {
JL_TRY {
jl_apply((jl_function_t*)f, NULL, 0);
}
JL_CATCH {
JL_PRINTF(JL_STDERR, "\natexit hook threw an error: ");
jl_show(jl_stderr_obj(),jl_exception_in_transit);
}
}
}
DLLEXPORT void jl_show_any(jl_value_t *str, jl_value_t *v)
{
uv_stream_t *s = ((uv_stream_t**)str)[1];
// fallback for printing some other builtin types
if (jl_is_tuple(v)) {
jl_show_tuple(str, (jl_tuple_t*)v, '(', ')', 1);
}
else if (jl_is_type(v)) {
show_type(str, v);
}
else if (jl_is_func(v)) {
show_function(s, v);
}
else if (jl_typeis(v,jl_intrinsic_type)) {
JL_PRINTF(s, "# intrinsic function %d", *(uint32_t*)jl_data_ptr(v));
}
else {
jl_value_t *t = (jl_value_t*)jl_typeof(v);
assert(jl_is_datatype(t));
jl_datatype_t *dt = (jl_datatype_t*)t;
show_type(str, t);
JL_PUTC('(', s);
if (jl_tuple_len(dt->names)>0 || dt->size==0) {
size_t i;
size_t n = jl_tuple_len(dt->names);
for(i=0; i < n; i++) {
jl_value_t *fval = jl_get_nth_field(v, i);
if (fval == NULL)
JL_PUTS("#undef", s);
else
jl_show(str, fval);
if (i < n-1)
JL_PUTC(',', s);
}
}
else {
size_t nb = jl_datatype_size(dt);
char *data = (char*)jl_data_ptr(v);
JL_PUTS("0x", s);
for(int i=nb-1; i >= 0; --i)
jl_printf(s, "%02hhx", data[i]);
}
JL_PUTC(')', s);
}
}
static int exec_program(void)
{
int err = 0;
again: ;
JL_TRY {
jl_register_toplevel_eh();
if (err) {
//jl_lisp_prompt();
//return 1;
jl_value_t *errs = jl_stderr_obj();
jl_value_t *e = jl_exception_in_transit;
if (errs != NULL) {
jl_show(jl_stderr_obj(), e);
}
else {
while (1) {
if (jl_typeof(e) == (jl_type_t*)jl_loaderror_type) {
e = jl_fieldref(e, 2);
// TODO: show file and line
}
else if (jl_typeof(e) == (jl_type_t*)jl_backtrace_type) {
e = jl_fieldref(e, 0);
}
else break;
}
if (jl_typeof(e) == (jl_type_t*)jl_errorexception_type) {
ios_printf(ios_stderr, "error during bootstrap: %s\n",
jl_string_data(jl_fieldref(e,0)));
}
else {
ios_printf(ios_stderr, "error during bootstrap\n");
}
}
ios_printf(ios_stderr, "\n");
JL_EH_POP();
return 1;
}
jl_load(program);
}
JL_CATCH {
err = 1;
goto again;
}
return 0;
}
static void repl_show_value(jl_value_t *v)
{
if (jl_is_function(v) && !jl_is_struct_type(v)) {
// show method table when a function is shown at the top level.
jl_show_full_function(v);
return;
}
jl_show(v);
if (jl_is_struct_type(v)) {
ios_t *s = jl_current_output_stream();
// for convenience, show constructor methods when
// a type is shown at the top level.
if (jl_is_gf(v)) {
ios_putc('\n', s);
jl_show_full_function(v);
}
}
}
static void print_obj_profile(void)
{
jl_value_t *errstream = jl_get_global(jl_base_module,
jl_symbol("stderr_stream"));
JL_TRY {
if (errstream)
jl_set_current_output_stream_obj(errstream);
ios_t *s = jl_current_output_stream();
for(int i=0; i < obj_counts.size; i+=2) {
if (obj_counts.table[i+1] != HT_NOTFOUND) {
ios_printf(s, "%d ", obj_counts.table[i+1]-1);
jl_show(obj_counts.table[i]);
ios_printf(s, "\n");
}
}
}
JL_CATCH {
}
}
DLLEXPORT void jl_eval_user_input(jl_value_t *ast, int show_value)
{
if (jl_have_event_loop) {
// with multi.j loaded the command line input callback can return
// before the command finishes running, so we have to
// disable rl to prevent the prompt from reappearing too soon.
repl_callback_disable();
}
JL_GC_PUSH(&ast);
assert(ast != NULL);
int iserr = 0;
again:
;
JL_TRY {
jl_register_toplevel_eh();
if (have_color) {
ios_printf(ios_stdout, jl_color_normal);
}
if (iserr) {
jl_show(jl_exception_in_transit);
ios_printf(ios_stdout, "\n");
JL_EH_POP();
break; // leave JL_TRY
}
jl_value_t *value = jl_toplevel_eval(ast);
jl_set_global(jl_system_module, jl_symbol("ans"), value);
if (value != (jl_value_t*)jl_nothing && show_value) {
if (have_color) {
ios_printf(ios_stdout, jl_answer_color());
}
repl_show_value(value);
ios_printf(ios_stdout, "\n");
}
}
JL_CATCH {
iserr = 1;
goto again;
}
ios_printf(ios_stdout, "\n");
JL_GC_POP();
repl_callback_enable();
}
static int exec_program(void)
{
int err = 0;
again: ;
JL_TRY {
jl_register_toplevel_eh();
if (err) {
jl_show(jl_exception_in_transit);
ios_printf(ios_stdout, "\n");
JL_EH_POP();
return 1;
}
jl_load(program);
}
JL_CATCH {
err = 1;
goto again;
}
return 0;
}
//basically factor in R is 1-dim INTSXP and contain levels
static jl_value_t *TransArrayToPoolDataArray(jl_array_t *mArray, jl_array_t *mpoolArray, size_t len, const char *VarName)
{
char evalcmd[evalsize];
jl_set_global(jl_main_module, jl_symbol("varpools"), (jl_value_t *)mpoolArray);
jl_set_global(jl_main_module, jl_symbol("varrefs"), (jl_value_t *)mArray);
snprintf(evalcmd, evalsize, "%s=PooledDataArray(ASCIIString,Uint32,%d)", VarName, len);
jl_eval_string(evalcmd);
snprintf(evalcmd, evalsize, "%s.pool=%s", VarName, "varpools");
jl_eval_string(evalcmd);
snprintf(evalcmd, evalsize, "%s.refs=%s", VarName, "varrefs");
jl_eval_string(evalcmd);
jl_value_t *ret = jl_eval_string((char *)VarName);
if (jl_exception_occurred())
{
jl_show(jl_stderr_obj(), jl_exception_occurred());
Rprintf("\n");
jl_exception_clear();
return (jl_value_t *) jl_nothing;
}
return ret;
}
value_t fl_invoke_julia_macro(value_t *args, uint32_t nargs)
{
if (nargs < 1)
argcount("invoke-julia-macro", nargs, 1);
(void)tosymbol(args[0], "invoke-julia-macro");
jl_sym_t *name = jl_symbol(symbol_name(args[0]));
jl_function_t *f = jl_get_expander(jl_current_module, name);
if (f == NULL)
return FL_F;
jl_value_t **margs;
int na = nargs-1;
if (na > 0)
margs = alloca(na * sizeof(jl_value_t*));
else
margs = NULL;
int i;
for(i=0; i < na; i++) margs[i] = NULL;
JL_GC_PUSHARGS(margs, na);
for(i=0; i < na; i++) margs[i] = scm_to_julia(args[i+1]);
jl_value_t *result;
JL_TRY {
result = jl_apply(f, margs, na);
}
JL_CATCH {
JL_GC_POP();
jl_show(jl_exception_in_transit);
ios_putc('\n', jl_current_output_stream());
return fl_cons(symbol("error"), FL_NIL);
}
// protect result from GC, otherwise it could be freed during future
// macro expansions, since it will be referenced only from scheme and
// not julia.
// all calls to invoke-julia-macro happen under a single call to jl_expand,
// so the preserved value stack is popped there.
jl_gc_preserve(result);
value_t scm = julia_to_scm(result);
JL_GC_POP();
return scm;
}
static jl_value_t *R_Julia_MD_NA_DataFrame(SEXP Var, const char *VarName)
{
SEXP names = getAttrib(Var, R_NamesSymbol);
size_t len = LENGTH(Var);
if (TYPEOF(Var) != VECSXP || len == 0 || names == R_NilValue)
return (jl_value_t *) jl_nothing;
char evalcmd[evalsize];
char eltcmd[eltsize];
const char *onename;
SEXP elt;
for (size_t i = 0; i < len; i++)
{
snprintf(eltcmd, eltsize, "%sdfelt%d", VarName, i + 1);
elt = VECTOR_ELT(Var, i);
//vector is factor or not
if (getAttrib(elt, R_LevelsSymbol) != R_NilValue)
R_Julia_MD_NA_Factor(elt, eltcmd);
else
R_Julia_MD_NA(elt, eltcmd);
onename = CHAR(STRING_ELT(names, i));
if (i == 0)
snprintf(evalcmd, evalsize, "%s=DataFrame(%s =%s)", VarName, onename, eltcmd);
else
snprintf(evalcmd, evalsize, "%s[symbol(\"%s\")]=%s", VarName, onename, eltcmd);
//Rprintf("%s\n",evalcmd);
jl_eval_string(evalcmd);
if (jl_exception_occurred())
{
jl_show(jl_stderr_obj(), jl_exception_occurred());
Rprintf("\n");
jl_exception_clear();
return (jl_value_t *) jl_nothing;
}
}
return (jl_value_t *) jl_nothing;;
}
void julia_init(char *imageFile)
{
jl_page_size = jl_getpagesize();
jl_find_stack_bottom();
jl_dl_handle = jl_load_dynamic_library(NULL, JL_RTLD_DEFAULT);
#ifdef __WIN32__
uv_dlopen("ntdll.dll",jl_ntdll_handle); //bypass julia's pathchecking for system dlls
uv_dlopen("Kernel32.dll",jl_kernel32_handle);
uv_dlopen("msvcrt.dll",jl_crtdll_handle);
uv_dlopen("Ws2_32.dll",jl_winsock_handle);
_jl_exe_handle.handle = GetModuleHandleA(NULL);
#endif
jl_io_loop = uv_default_loop(); //this loop will internal events (spawining process etc.)
init_stdio();
#if defined(__linux__)
int ncores = jl_cpu_cores();
if (ncores > 1) {
cpu_set_t cpumask;
CPU_ZERO(&cpumask);
for(int i=0; i < ncores; i++) {
CPU_SET(i, &cpumask);
}
sched_setaffinity(0, sizeof(cpu_set_t), &cpumask);
}
#endif
#ifdef JL_GC_MARKSWEEP
jl_gc_init();
jl_gc_disable();
#endif
jl_init_frontend();
jl_init_types();
jl_init_tasks(jl_stack_lo, jl_stack_hi-jl_stack_lo);
jl_init_codegen();
jl_an_empty_cell = (jl_value_t*)jl_alloc_cell_1d(0);
jl_init_serializer();
if (!imageFile) {
jl_main_module = jl_new_module(jl_symbol("Main"));
jl_main_module->parent = jl_main_module;
jl_core_module = jl_new_module(jl_symbol("Core"));
jl_core_module->parent = jl_main_module;
jl_set_const(jl_main_module, jl_symbol("Core"),
(jl_value_t*)jl_core_module);
jl_module_using(jl_main_module, jl_core_module);
jl_current_module = jl_core_module;
jl_init_intrinsic_functions();
jl_init_primitives();
jl_load("boot.jl");
jl_get_builtin_hooks();
jl_boot_file_loaded = 1;
jl_init_box_caches();
}
if (imageFile) {
JL_TRY {
jl_restore_system_image(imageFile);
}
JL_CATCH {
JL_PRINTF(JL_STDERR, "error during init:\n");
jl_show(jl_stderr_obj(), jl_exception_in_transit);
JL_PRINTF(JL_STDOUT, "\n");
jl_exit(1);
}
}
// set module field of primitive types
int i;
void **table = jl_core_module->bindings.table;
for(i=1; i < jl_core_module->bindings.size; i+=2) {
if (table[i] != HT_NOTFOUND) {
jl_binding_t *b = (jl_binding_t*)table[i];
if (b->value && jl_is_datatype(b->value)) {
jl_datatype_t *tt = (jl_datatype_t*)b->value;
tt->name->module = jl_core_module;
}
}
}
// the Main module is the one which is always open, and set as the
// current module for bare (non-module-wrapped) toplevel expressions.
// it does "using Base" if Base is available.
if (jl_base_module != NULL) {
jl_add_standard_imports(jl_main_module);
}
// eval() uses Main by default, so Main.eval === Core.eval
jl_module_import(jl_main_module, jl_core_module, jl_symbol("eval"));
jl_current_module = jl_main_module;
#ifndef __WIN32__
struct sigaction actf;
memset(&actf, 0, sizeof(struct sigaction));
sigemptyset(&actf.sa_mask);
actf.sa_handler = fpe_handler;
actf.sa_flags = 0;
if (sigaction(SIGFPE, &actf, NULL) < 0) {
JL_PRINTF(JL_STDERR, "sigaction: %s\n", strerror(errno));
jl_exit(1);
}
stack_t ss;
ss.ss_flags = 0;
ss.ss_size = SIGSTKSZ;
ss.ss_sp = malloc(ss.ss_size);
if (sigaltstack(&ss, NULL) < 0) {
JL_PRINTF(JL_STDERR, "sigaltstack: %s\n", strerror(errno));
jl_exit(1);
}
struct sigaction act;
memset(&act, 0, sizeof(struct sigaction));
sigemptyset(&act.sa_mask);
act.sa_sigaction = segv_handler;
act.sa_flags = SA_ONSTACK | SA_SIGINFO;
if (sigaction(SIGSEGV, &act, NULL) < 0) {
JL_PRINTF(JL_STDERR, "sigaction: %s\n", strerror(errno));
jl_exit(1);
}
#else
if (signal(SIGFPE, (void (__cdecl *)(int))fpe_handler) == SIG_ERR) {
JL_PRINTF(JL_STDERR, "Couldn't set SIGFPE\n");
jl_exit(1);
}
#endif
#ifdef JL_GC_MARKSWEEP
jl_gc_enable();
#endif
}
