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);
}
}
}
// 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);
}
static void show_function(jl_value_t *v)
{
ios_t *s = jl_current_output_stream();
if (jl_is_gf(v)) {
ios_putc('(', s);
ios_puts(jl_gf_name(v)->name, s);
ios_putc(')', s);
}
else {
ios_puts("#<function>", s);
}
}
DLLEXPORT int jl_putc(char c, uv_stream_t *stream)
{
int err;
if (stream!=0) {
if (stream->type<UV_HANDLE_TYPE_MAX) { //is uv handle
if (stream->type == UV_FILE) {
JL_SIGATOMIC_BEGIN();
jl_uv_file_t *file = (jl_uv_file_t *)stream;
// Do a blocking write for now
uv_fs_t req;
uv_buf_t buf[1];
buf[0].base = &c;
buf[0].len = 1;
err = uv_fs_write(file->loop, &req, file->file, buf, 1, -1, NULL);
JL_SIGATOMIC_END();
return err ? 0 : 1;
}
else {
uv_write_t *uvw = (uv_write_t*)malloc(sizeof(uv_write_t)+1);
err = jl_write_copy(stream,(char*)&c,1,uvw, (void*)&jl_uv_writecb);
if (err < 0) {
free(uvw);
return 0;
}
return 1;
}
}
else {
ios_t *handle = (ios_t*)stream;
return ios_putc(c,handle);
}
}
return 0;
}
static void print_sig(jl_tuple_t *type)
{
size_t i;
for(i=0; i < type->length; i++) {
if (i > 0) ios_printf(ios_stderr, ", ");
jl_value_t *v = jl_tupleref(type,i);
if (jl_is_tuple(v)) {
ios_putc('(', ios_stderr);
print_sig((jl_tuple_t*)v);
ios_putc(')', ios_stderr);
}
else {
ios_printf(ios_stderr, "%s", type_summary(v));
}
}
}
static void outc(char c, ios_t *f)
{
ios_putc(c, f);
if (c == '\n')
HPOS = 0;
else
HPOS++;
}
static void outc(fl_context_t *fl_ctx, char c, ios_t *f)
{
ios_putc(c, f);
if (c == '\n')
fl_ctx->HPOS = 0;
else
fl_ctx->HPOS++;
}
static int outindent(int n, ios_t *f)
{
// move back to left margin if we get too indented
if (n > SCR_WIDTH-12)
n = 2;
int n0 = n;
ios_putc('\n', f);
VPOS++;
HPOS = n;
while (n >= 8) {
ios_putc('\t', f);
n -= 8;
}
while (n) {
ios_putc(' ', f);
n--;
}
return n0;
}
void jl_show_full_function(jl_value_t *v)
{
ios_t *s = jl_current_output_stream();
if (jl_is_gf(v)) {
ios_puts("Methods for generic function ", s);
ios_puts(jl_gf_name(v)->name, s);
ios_putc('\n', s);
jl_show_method_table((jl_function_t*)v);
}
else {
show_function(v);
}
}
static void symtab_search(jl_sym_t *tree, int *pcount, ios_t *result,
const char *prefix, int plen)
{
do {
if (common_prefix(prefix, tree->name) == plen &&
jl_boundp(jl_system_module, tree)) {
ios_puts(tree->name, result);
ios_putc('\n', result);
(*pcount)++;
}
if (tree->left)
symtab_search(tree->left, pcount, result, prefix, plen);
tree = tree->right;
} while (tree != NULL);
}
DLLEXPORT void jl_input_line_callback(char *input)
{
int end=0, doprint=1;
if (!input || ios_eof(ios_stdin)) {
end = 1;
rl_ast = NULL;
}
if (rl_ast != NULL) {
doprint = !ends_with_semicolon(input);
add_history_permanent(input);
ios_putc('\n', ios_stdout);
free(input);
}
handle_input(rl_ast, end, doprint);
}
static void symtab_search(jl_sym_t *tree, int *pcount, ios_t *result,
jl_module_t *module, const char *str,
const char *prefix, int plen)
{
do {
if (common_prefix(prefix, tree->name) == plen &&
(module ? jl_defines_or_exports_p(module, tree) : jl_boundp(jl_current_module, tree))) {
ios_puts(str, result);
ios_puts(tree->name + plen, result);
ios_putc('\n', result);
(*pcount)++;
}
if (tree->left)
symtab_search(tree->left, pcount, result, module, str, prefix, plen);
tree = tree->right;
} while (tree != NULL);
}
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);
}
}
}
DLLEXPORT
void jl_save_system_image(char *fname, char *startscriptname)
{
jl_gc_collect();
jl_gc_collect();
int en = jl_gc_is_enabled();
jl_gc_disable();
htable_reset(&backref_table, 50000);
ios_t f;
ios_file(&f, fname, 1, 1, 1, 1);
// orphan old Base module if present
jl_base_module = (jl_module_t*)jl_get_global(jl_main_module, jl_symbol("Base"));
// delete cached slow ASCIIString constructor if present
jl_methtable_t *mt = jl_gf_mtable((jl_function_t*)jl_ascii_string_type);
jl_array_t *spec = mt->defs->func->linfo->specializations;
if (spec->length > 0 &&
((jl_lambda_info_t*)jl_cellref(spec,0))->inferred == 0) {
mt->cache = JL_NULL;
mt->cache_arg1 = JL_NULL;
mt->defs->func->linfo->tfunc = (jl_value_t*)jl_null;
mt->defs->func->linfo->specializations = NULL;
}
jl_idtable_type = jl_get_global(jl_base_module, jl_symbol("ObjectIdDict"));
jl_serialize_value(&f, jl_array_type->env);
jl_serialize_value(&f, jl_main_module);
write_int32(&f, jl_get_t_uid_ctr());
write_int32(&f, jl_get_gs_ctr());
htable_reset(&backref_table, 0);
ios_t ss;
ios_file(&ss, startscriptname, 1, 0, 0, 0);
ios_copyall(&f, &ss);
ios_close(&ss);
ios_putc(0, &f);
ios_close(&f);
if (en) jl_gc_enable();
}
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;
}
int main(int argc, char *argv[])
{
char fname_buf[1024];
fl_context_t *fl_ctx = &fl_global_ctx;
fl_init(fl_ctx, 512*1024);
fname_buf[0] = '\0';
value_t str = symbol_value(symbol(fl_ctx, "*install-dir*"));
char *exedir = (char*)(str == UNBOUND ? NULL : cvalue_data(str));
if (exedir != NULL) {
strcat(fname_buf, exedir);
strcat(fname_buf, PATHSEPSTRING);
}
strcat(fname_buf, "flisp.boot");
value_t args[2];
fl_gc_handle(fl_ctx, &args[0]);
fl_gc_handle(fl_ctx, &args[1]);
FL_TRY_EXTERN(fl_ctx) {
args[0] = cvalue_static_cstring(fl_ctx, fname_buf);
args[1] = symbol(fl_ctx, ":read");
value_t f = fl_file(fl_ctx, &args[0], 2);
fl_free_gc_handles(fl_ctx, 2);
if (fl_load_system_image(fl_ctx, f))
return 1;
(void)fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "__start")),
argv_list(fl_ctx, argc, argv));
}
FL_CATCH_EXTERN(fl_ctx) {
ios_puts("fatal error:\n", ios_stderr);
fl_print(fl_ctx, ios_stderr, fl_ctx->lasterror);
ios_putc('\n', ios_stderr);
return 1;
}
return 0;
}
void jl_input_line_callback(char *input)
{
int end=0, doprint=1;
if (!input || ios_eof(ios_stdin)) {
end = 1;
rl_ast = NULL;
} else if (!rl_ast) {
// In vi mode, it's possible for this function to be called w/o a
// previous call to return_callback.
rl_ast = jl_parse_input_line(rl_line_buffer);
}
if (rl_ast != NULL) {
doprint = !ends_with_semicolon(input);
add_history_permanent(input);
ios_putc('\n', ios_stdout);
free(input);
}
callback_en = 0;
rl_callback_handler_remove();
handle_input(rl_ast, end, doprint);
rl_ast = NULL;
}
DLLEXPORT
void jl_save_system_image(char *fname, char *startscriptname)
{
jl_gc_collect();
jl_gc_collect();
int en = jl_gc_is_enabled();
jl_gc_disable();
htable_reset(&backref_table, 50000);
ios_t f;
ios_file(&f, fname, 1, 1, 1, 1);
if (jl_current_module != jl_system_module) {
// set up for stage 1 bootstrap, where the System module is already
// loaded and we are loading an updated copy in a separate module.
// step 1: set Base.System = current_module
jl_binding_t *b = jl_get_binding_wr(jl_base_module, jl_symbol("System"));
b->value = (jl_value_t*)jl_current_module;
assert(b->constp);
// step 2: set current_module.Base = Base
jl_set_const(jl_current_module, jl_symbol("Base"), (jl_value_t*)jl_base_module);
// step 3: current_module.System = current_module
b = jl_get_binding_wr(jl_current_module, jl_symbol("System"));
b->value = (jl_value_t*)jl_current_module;
assert(b->constp);
// step 4: remove current_module.current_module
b = jl_get_binding_wr(jl_current_module, jl_current_module->name);
b->value = NULL; b->constp = 0;
// step 5: rename current_module to System
jl_current_module->name = jl_symbol("System");
// step 6: orphan old system module
jl_system_module = jl_current_module;
}
else {
// delete cached slow ASCIIString constructor
jl_methtable_t *mt = jl_gf_mtable((jl_function_t*)jl_ascii_string_type);
mt->cache = NULL;
mt->cache_1arg = NULL;
mt->defs->func->linfo->tfunc = (jl_value_t*)jl_null;
mt->defs->func->linfo->specializations = NULL;
}
jl_idtable_type = jl_get_global(jl_system_module, jl_symbol("IdTable"));
idtable_list = jl_alloc_cell_1d(0);
jl_serialize_value(&f, jl_array_type->env);
jl_serialize_value(&f, jl_base_module);
jl_serialize_value(&f, jl_current_module);
jl_serialize_value(&f, idtable_list);
//jl_serialize_finalizers(&f);
write_int32(&f, jl_get_t_uid_ctr());
write_int32(&f, jl_get_gs_ctr());
htable_reset(&backref_table, 0);
ios_t ss;
ios_file(&ss, startscriptname, 1, 0, 0, 0);
ios_copyall(&f, &ss);
ios_close(&ss);
ios_putc(0, &f);
ios_close(&f);
if (en) jl_gc_enable();
}
