JL_DLLEXPORT jl_value_t *jl_cglobal(jl_value_t *v, jl_value_t *ty)
{
JL_TYPECHK(cglobal, type, ty);
JL_GC_PUSH1(&v);
jl_value_t *rt =
ty == (jl_value_t*)jl_void_type ? (jl_value_t*)jl_voidpointer_type : // a common case
(jl_value_t*)jl_apply_type1((jl_value_t*)jl_pointer_type, ty);
JL_GC_PROMISE_ROOTED(rt); // (JL_ALWAYS_LEAFTYPE)
if (!jl_is_concrete_type(rt))
jl_error("cglobal: type argument not concrete");
if (jl_is_tuple(v) && jl_nfields(v) == 1)
v = jl_fieldref(v, 0);
if (jl_is_pointer(v)) {
v = jl_bitcast(rt, v);
JL_GC_POP();
return v;
}
char *f_lib = NULL;
if (jl_is_tuple(v) && jl_nfields(v) > 1) {
jl_value_t *t1 = jl_fieldref_noalloc(v, 1);
v = jl_fieldref(v, 0);
if (jl_is_symbol(t1))
f_lib = jl_symbol_name((jl_sym_t*)t1);
else if (jl_is_string(t1))
f_lib = jl_string_data(t1);
else
JL_TYPECHK(cglobal, symbol, t1)
}
// f{<:Union{...}}(...) is a common pattern
// and expanding the Union may give a leaf function
static void _compile_all_tvar_union(jl_value_t *methsig)
{
if (!jl_is_unionall(methsig) && jl_is_dispatch_tupletype(methsig)) {
// usually can create a specialized version of the function,
// if the signature is already a dispatch type
if (jl_compile_hint((jl_tupletype_t*)methsig))
return;
}
int tvarslen = jl_subtype_env_size(methsig);
jl_value_t *sigbody = methsig;
jl_value_t **env;
JL_GC_PUSHARGS(env, 2 * tvarslen);
int *idx = (int*)alloca(sizeof(int) * tvarslen);
int i;
for (i = 0; i < tvarslen; i++) {
assert(jl_is_unionall(sigbody));
idx[i] = 0;
env[2 * i] = (jl_value_t*)((jl_unionall_t*)sigbody)->var;
env[2 * i + 1] = jl_bottom_type; // initialize the list with Union{}, since T<:Union{} is always a valid option
sigbody = ((jl_unionall_t*)sigbody)->body;
}
for (i = 0; i < tvarslen; /* incremented by inner loop */) {
jl_value_t *sig;
JL_TRY {
// TODO: wrap in UnionAll for each tvar in env[2*i + 1] ?
// currently doesn't matter much, since jl_compile_hint doesn't work on abstract types
sig = (jl_value_t*)jl_instantiate_type_with(sigbody, env, tvarslen);
}
JL_CATCH {
goto getnext; // sigh, we found an invalid type signature. should we warn the user?
}
if (!jl_has_concrete_subtype(sig))
goto getnext; // signature wouldn't be callable / is invalid -- skip it
if (jl_is_concrete_type(sig)) {
JL_GC_PROMISE_ROOTED(sig); // `sig` is rooted because it's a leaftype (JL_ALWAYS_LEAFTYPE)
if (jl_compile_hint((jl_tupletype_t*)sig))
goto getnext; // success
}
getnext:
for (i = 0; i < tvarslen; i++) {
jl_tvar_t *tv = (jl_tvar_t*)env[2 * i];
if (jl_is_uniontype(tv->ub)) {
size_t l = jl_count_union_components(tv->ub);
size_t j = idx[i];
if (j == l) {
env[2 * i + 1] = jl_bottom_type;
idx[i] = 0;
}
else {
jl_value_t *ty = jl_nth_union_component(tv->ub, j);
if (!jl_is_concrete_type(ty))
ty = (jl_value_t*)jl_new_typevar(tv->name, tv->lb, ty);
env[2 * i + 1] = ty;
idx[i] = j + 1;
break;
}
}
else {
env[2 * i + 1] = (jl_value_t*)tv;
}
}
}
JL_GC_POP();
}
// TODO: add locks around global state mutation operations
jl_value_t *jl_eval_module_expr(jl_module_t *parent_module, jl_expr_t *ex)
{
jl_ptls_t ptls = jl_get_ptls_states();
assert(ex->head == module_sym);
if (jl_array_len(ex->args) != 3 || !jl_is_expr(jl_exprarg(ex, 2))) {
jl_error("syntax: malformed module expression");
}
int std_imports = (jl_exprarg(ex, 0) == jl_true);
jl_sym_t *name = (jl_sym_t*)jl_exprarg(ex, 1);
if (!jl_is_symbol(name)) {
jl_type_error("module", (jl_value_t*)jl_sym_type, (jl_value_t*)name);
}
jl_module_t *newm = jl_new_module(name);
jl_value_t *form = (jl_value_t*)newm;
JL_GC_PUSH1(&form);
ptrhash_put(&jl_current_modules, (void*)newm, (void*)((uintptr_t)HT_NOTFOUND + 1));
// copy parent environment info into submodule
newm->uuid = parent_module->uuid;
if (jl_base_module &&
(jl_value_t*)parent_module == jl_get_global(jl_base_module, jl_symbol("__toplevel__"))) {
newm->parent = newm;
jl_register_root_module(newm);
}
else {
jl_binding_t *b = jl_get_binding_wr(parent_module, name, 1);
jl_declare_constant(b);
if (b->value != NULL) {
if (!jl_is_module(b->value)) {
jl_errorf("invalid redefinition of constant %s", jl_symbol_name(name));
}
if (jl_generating_output()) {
jl_errorf("cannot replace module %s during compilation", jl_symbol_name(name));
}
jl_printf(JL_STDERR, "WARNING: replacing module %s.\n", jl_symbol_name(name));
// create a hidden gc root for the old module
uintptr_t *refcnt = (uintptr_t*)ptrhash_bp(&jl_current_modules, (void*)b->value);
*refcnt += 1;
}
newm->parent = parent_module;
b->value = (jl_value_t*)newm;
jl_gc_wb_binding(b, newm);
}
if (parent_module == jl_main_module && name == jl_symbol("Base")) {
// pick up Base module during bootstrap
jl_base_module = newm;
}
size_t last_age = ptls->world_age;
// add standard imports unless baremodule
if (std_imports) {
if (jl_base_module != NULL) {
jl_add_standard_imports(newm);
}
// add `eval` function
form = jl_call_scm_on_ast("module-default-defs", (jl_value_t*)ex, newm);
ptls->world_age = jl_world_counter;
jl_toplevel_eval_flex(newm, form, 0, 1);
form = NULL;
}
jl_array_t *exprs = ((jl_expr_t*)jl_exprarg(ex, 2))->args;
for (int i = 0; i < jl_array_len(exprs); i++) {
// process toplevel form
ptls->world_age = jl_world_counter;
form = jl_expand_stmt(jl_array_ptr_ref(exprs, i), newm);
ptls->world_age = jl_world_counter;
(void)jl_toplevel_eval_flex(newm, form, 1, 1);
}
ptls->world_age = last_age;
#if 0
// some optional post-processing steps
size_t i;
void **table = newm->bindings.table;
for(i=1; i < newm->bindings.size; i+=2) {
if (table[i] != HT_NOTFOUND) {
jl_binding_t *b = (jl_binding_t*)table[i];
// remove non-exported macros
if (jl_symbol_name(b->name)[0]=='@' &&
!b->exportp && b->owner == newm)
b->value = NULL;
// error for unassigned exports
/*
if (b->exportp && b->owner==newm && b->value==NULL)
jl_errorf("identifier %s exported from %s is not initialized",
jl_symbol_name(b->name), jl_symbol_name(newm->name));
*/
}
}
#endif
uintptr_t *refcnt = (uintptr_t*)ptrhash_bp(&jl_current_modules, (void*)newm);
assert(*refcnt > (uintptr_t)HT_NOTFOUND);
*refcnt -= 1;
// newm should be reachable from somewhere else by now
if (jl_module_init_order == NULL)
jl_module_init_order = jl_alloc_vec_any(0);
jl_array_ptr_1d_push(jl_module_init_order, (jl_value_t*)newm);
// defer init of children until parent is done being defined
// then initialize all in definition-finished order
// at build time, don't run them at all (defer for runtime)
if (!jl_generating_output()) {
if (!ptrhash_has(&jl_current_modules, (void*)newm->parent)) {
size_t i, l = jl_array_len(jl_module_init_order);
size_t ns = 0;
form = (jl_value_t*)jl_alloc_vec_any(0);
for (i = 0; i < l; i++) {
jl_module_t *m = (jl_module_t*)jl_array_ptr_ref(jl_module_init_order, i);
if (jl_is_submodule(m, newm)) {
jl_array_ptr_1d_push((jl_array_t*)form, (jl_value_t*)m);
}
else if (ns++ != i) {
jl_array_ptr_set(jl_module_init_order, ns - 1, (jl_value_t*)m);
}
}
if (ns < l)
jl_array_del_end(jl_module_init_order, l - ns);
l = jl_array_len(form);
for (i = 0; i < l; i++) {
jl_module_t *m = (jl_module_t*)jl_array_ptr_ref(form, i);
JL_GC_PROMISE_ROOTED(m);
jl_module_run_initializer(m);
}
}
}
JL_GC_POP();
return (jl_value_t*)newm;
}
