jl_value_t *jl_method_def(jl_sym_t *name, jl_value_t **bp, jl_binding_t *bnd,
jl_tuple_t *argtypes, jl_function_t *f, jl_tuple_t *t)
{
jl_value_t *gf;
if (bnd) {
jl_declare_constant(bnd);
}
if (*bp == NULL) {
gf = (jl_value_t*)jl_new_generic_function(name);
*bp = gf;
}
else {
gf = *bp;
if (!jl_is_gf(gf)) {
if (jl_is_struct_type(gf) &&
((jl_function_t*)gf)->fptr == jl_f_ctor_trampoline) {
jl_add_constructors((jl_struct_type_t*)gf);
}
if (!jl_is_gf(gf)) {
jl_error("invalid method definition: not a generic function");
}
}
}
JL_GC_PUSH(&gf);
assert(jl_is_function(f));
assert(jl_is_tuple(argtypes));
assert(jl_is_tuple(t));
jl_check_type_tuple(argtypes, name, "method definition");
for(size_t i=0; i < t->length; i++) {
if (!jl_is_typevar(jl_tupleref(t,i)))
jl_type_error_rt(name->name, "method definition",
(jl_value_t*)jl_tvar_type, jl_tupleref(t,i));
}
jl_add_method((jl_function_t*)gf, argtypes, f, t);
if (jl_boot_file_loaded &&
f->linfo && f->linfo->ast && jl_is_expr(f->linfo->ast)) {
jl_lambda_info_t *li = f->linfo;
li->ast = jl_compress_ast(li, li->ast);
}
JL_GC_POP();
return gf;
}
uv_buf_t jl_alloc_buf(uv_handle_t *handle, size_t suggested_size)
{
uv_buf_t buf;
JULIA_CB(alloc_buf,handle->data,1,CB_INT32,suggested_size);
if (!jl_is_tuple(ret) || !jl_is_pointer(jl_t0(ret)) || !jl_is_int32(jl_t1(ret))) {
jl_error("jl_alloc_buf: Julia function returned invalid value for buffer allocation callback");
}
buf.base = jl_unbox_voidpointer(jl_t0(ret));
buf.len = jl_unbox_int32(jl_t1(ret));
return buf;
}
static inline int is_ntuple_long(jl_value_t *v)
{
if (!jl_is_tuple(v))
return 0;
size_t nfields = jl_nfields(v);
for (size_t i = 0; i < nfields; i++) {
if (jl_field_type(jl_typeof(v), i) != (jl_value_t*)jl_long_type) {
return 0;
}
}
return 1;
}
DLLEXPORT void jl_uv_alloc_buf(uv_handle_t *handle, size_t suggested_size, uv_buf_t* buf)
{
if (handle->data) {
JULIA_CB(alloc_buf,handle->data,1,CB_INT32,suggested_size);
assert(jl_is_tuple(ret) && jl_is_pointer(jl_t0(ret)) && jl_is_int32(jl_t1(ret)));
buf->base = (char*)jl_unbox_voidpointer(jl_t0(ret));
buf->len = jl_unbox_int32(jl_t1(ret));
}
else {
buf->len = 0;
}
}
static inline int cache_match(jl_value_t **args, size_t n, jl_tuple_t *sig,
int va)
{
if (sig->length > n) {
if (n != sig->length-1)
return 0;
}
size_t i;
for(i=0; i < n; i++) {
jl_value_t *decl = jl_tupleref(sig, i);
if (i == sig->length-1) {
if (va) {
jl_value_t *t = jl_tparam0(decl);
for(; i < n; i++) {
if (!jl_subtype(args[i], t, 1))
return 0;
}
return 1;
}
}
jl_value_t *a = args[i];
if (jl_is_tuple(decl)) {
// tuples don't have to match exactly, to avoid caching
// signatures for tuples of every length
if (!jl_subtype(a, decl, 1))
return 0;
}
else if (jl_is_type_type(decl) &&
jl_is_nontuple_type(a)) { //***
if (jl_tparam0(decl) == (jl_value_t*)jl_typetype_tvar) {
// in the case of Type{T}, the types don't have
// to match exactly either. this is cached as Type{T}.
// analogous to the situation with tuples.
}
else {
if (a!=jl_tparam0(decl) && !jl_types_equal(a,jl_tparam0(decl)))
return 0;
}
}
else if (decl == (jl_value_t*)jl_any_type) {
}
else {
/*
we know there are only concrete types here, and types are
hash-consed, so pointer comparison should work.
*/
if ((jl_value_t*)jl_typeof(a) != decl)
return 0;
}
}
return 1;
}
static int cache_match_by_type(jl_value_t **types, size_t n, jl_tuple_t *sig,
int va)
{
if (!va && n > sig->length)
return 0;
if (sig->length > n) {
if (!(n == sig->length-1 && va))
return 0;
}
size_t i;
for(i=0; i < n; i++) {
jl_value_t *decl = jl_tupleref(sig, i);
if (i == sig->length-1) {
if (va) {
jl_value_t *t = jl_tparam0(decl);
for(; i < n; i++) {
if (!jl_subtype(types[i], t, 0))
return 0;
}
return 1;
}
}
jl_value_t *a = types[i];
if (jl_is_tuple(decl)) {
// tuples don't have to match exactly, to avoid caching
// signatures for tuples of every length
if (!jl_subtype(a, decl, 0))
return 0;
}
else if (jl_is_tag_type(a) && jl_is_tag_type(decl) &&
((jl_tag_type_t*)decl)->name == jl_type_type->name &&
((jl_tag_type_t*)a )->name == jl_type_type->name) {
if (jl_tparam0(decl) == (jl_value_t*)jl_typetype_tvar) {
// in the case of Type{T}, the types don't have
// to match exactly either. this is cached as Type{T}.
// analogous to the situation with tuples.
}
else {
if (!jl_types_equal(jl_tparam0(a), jl_tparam0(decl))) {
return 0;
}
}
}
else if (decl == (jl_value_t*)jl_any_type) {
}
else {
if (!jl_types_equal(a, decl))
return 0;
}
}
return 1;
}
jl_typemap_entry_t *jl_typemap_assoc_exact(union jl_typemap_t ml_or_cache, jl_value_t **args, size_t n, int8_t offs)
{
// NOTE: This function is a huge performance hot spot!!
if (jl_typeof(ml_or_cache.unknown) == (jl_value_t*)jl_typemap_level_type) {
jl_typemap_level_t *cache = ml_or_cache.node;
if (n > offs) {
jl_value_t *a1 = args[offs];
jl_value_t *ty = (jl_value_t*)jl_typeof(a1);
assert(jl_is_datatype(ty));
if (ty == (jl_value_t*)jl_datatype_type && cache->targ != (void*)jl_nothing) {
ml_or_cache = mtcache_hash_lookup(cache->targ, a1, 1, offs);
jl_typemap_entry_t *ml = jl_typemap_assoc_exact(ml_or_cache, args, n, offs+1);
if (ml) return ml;
}
if (cache->arg1 != (void*)jl_nothing) {
ml_or_cache = mtcache_hash_lookup(cache->arg1, ty, 0, offs);
if (jl_typeof(ml_or_cache.unknown) == (jl_value_t*)jl_typemap_entry_type &&
ml_or_cache.leaf->simplesig == (void*)jl_nothing && offs < 2 && n > 1) {
jl_value_t *a0 = args[1-offs];
jl_value_t *t0 = (jl_value_t*)jl_typeof(a0);
if (ml_or_cache.leaf->next==(void*)jl_nothing && n==2 && jl_datatype_nfields(ml_or_cache.leaf->sig)==2 &&
jl_tparam(ml_or_cache.leaf->sig, 1 - offs) == t0)
return ml_or_cache.leaf;
if (n==3) {
// some manually-unrolled common special cases
jl_value_t *a2 = args[2];
if (!jl_is_tuple(a2)) { // issue #6426
jl_typemap_entry_t *mn = ml_or_cache.leaf;
if (jl_datatype_nfields(mn->sig)==3 &&
jl_tparam(mn->sig,1-offs)==t0 &&
jl_tparam(mn->sig,2)==(jl_value_t*)jl_typeof(a2))
return mn;
mn = mn->next;
if (mn!=(void*)jl_nothing && jl_datatype_nfields(mn->sig)==3 &&
jl_tparam(mn->sig,1-offs)==t0 &&
jl_tparam(mn->sig,2)==(jl_value_t*)jl_typeof(a2))
return mn;
}
}
}
jl_typemap_entry_t *ml = jl_typemap_assoc_exact(ml_or_cache, args, n, offs+1);
if (ml) return ml;
}
}
jl_typemap_entry_t *ml = jl_typemap_node_assoc_exact(cache->linear, args, n);
if (ml) return ml;
return jl_typemap_assoc_exact(cache->any, args, n, offs+1);
}
else {
return jl_typemap_node_assoc_exact(ml_or_cache.leaf, args, n);
}
}
static size_t jl_new_bits_align(jl_value_t *dt)
{
if (jl_is_tuple(dt)) {
size_t i, l = jl_tuple_len(dt), align = 0;
for (i = 0; i < l; i++) {
size_t l = jl_new_bits_align(jl_tupleref(dt,i));
if (l > align)
align = l;
}
return align;
}
return ((jl_datatype_t*)dt)->alignment;
}
static void jl_serialize_methlist(ios_t *s, jl_methlist_t *ml)
{
while (ml != NULL) {
jl_serialize_value(s, ml->sig);
assert(jl_is_tuple(ml->sig));
write_int8(s, ml->va);
jl_serialize_value(s, ml->tvars);
jl_serialize_value(s, ml->func);
jl_serialize_value(s, ml->invokes);
ml = ml->next;
}
jl_serialize_value(s, NULL);
}
// get array of var info records for captured vars
jl_array_t *jl_lam_capt(jl_expr_t *l)
{
if (jl_is_tuple(l)) {
// in compressed form
return (jl_array_t*)jl_tupleref(l, 3);
}
assert(jl_is_expr(l));
jl_value_t *le = jl_exprarg(l, 1);
assert(jl_is_array(le));
jl_value_t *ll = jl_cellref(le, 2);
assert(jl_is_array(ll));
return (jl_array_t*)ll;
}
DLLEXPORT
jl_value_t *jl_new_closure_internal(jl_lambda_info_t *li, jl_value_t *env)
{
assert(jl_is_lambda_info(li));
assert(jl_is_tuple(env));
jl_function_t *f=NULL;
// note: env is pushed here to make codegen a little easier
JL_GC_PUSH(&f, &env);
f = jl_new_closure(li->fptr ? li->fptr : jl_trampoline, env);
f->linfo = li;
JL_GC_POP();
return (jl_value_t*)f;
}
int jl_egal(jl_value_t *a, jl_value_t *b)
{
if (a == b)
return 1;
jl_value_t *ta = (jl_value_t*)jl_typeof(a);
if (ta != (jl_value_t*)jl_typeof(b))
return 0;
if (jl_is_tuple(a)) {
size_t l = jl_tuple_len(a);
if (l != jl_tuple_len(b))
return 0;
for(size_t i=0; i < l; i++) {
if (!jl_egal(jl_tupleref(a,i),jl_tupleref(b,i)))
return 0;
}
return 1;
}
jl_datatype_t *dt = (jl_datatype_t*)ta;
if (dt == jl_datatype_type) {
jl_datatype_t *dta = (jl_datatype_t*)a;
jl_datatype_t *dtb = (jl_datatype_t*)b;
return dta->name == dtb->name &&
jl_egal((jl_value_t*)dta->parameters, (jl_value_t*)dtb->parameters);
}
if (dt->mutabl) return 0;
size_t sz = dt->size;
if (sz == 0) return 1;
size_t nf = jl_tuple_len(dt->names);
if (nf == 0) {
return bits_equal(jl_data_ptr(a), jl_data_ptr(b), sz);
}
for (size_t f=0; f < nf; f++) {
size_t offs = dt->fields[f].offset;
char *ao = (char*)jl_data_ptr(a) + offs;
char *bo = (char*)jl_data_ptr(b) + offs;
int eq;
if (dt->fields[f].isptr) {
jl_value_t *af = *(jl_value_t**)ao;
jl_value_t *bf = *(jl_value_t**)bo;
if (af == bf) eq = 1;
else if (af==NULL || bf==NULL) eq = 0;
else eq = jl_egal(af, bf);
}
else {
eq = bits_equal(ao, bo, dt->fields[f].size);
}
if (!eq) return 0;
}
return 1;
}
static void run_finalizer(jl_value_t *o, jl_value_t *ff)
{
jl_function_t *f;
while (1) {
if (jl_is_tuple(ff))
f = (jl_function_t*)jl_t0(ff);
else
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_static_show(JL_STDERR, jl_exception_in_transit);
JL_PUTC('\n',JL_STDERR);
}
if (jl_is_tuple(ff))
ff = jl_t1(ff);
else
break;
}
}
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);
}
}
static int is_ast_node(jl_value_t *v)
{
if (jl_is_lambda_info(v)) {
jl_lambda_info_t *li = (jl_lambda_info_t*)v;
if (jl_is_expr(li->ast))
li->ast = jl_compress_ast(li, li->ast);
return 0;
}
return jl_is_symbol(v) || jl_is_expr(v) ||
jl_typeis(v, jl_array_any_type) || jl_is_tuple(v) ||
jl_is_union_type(v) || jl_is_int32(v) || jl_is_int64(v) ||
jl_is_symbolnode(v) || jl_is_bool(v) || jl_is_typevar(v) ||
jl_is_topnode(v) || jl_is_quotenode(v) || jl_is_gotonode(v) ||
jl_is_labelnode(v) || jl_is_linenode(v) || jl_is_getfieldnode(v);
}
SEXP jr_cast(jl_value_t *tt){
SEXP ans = R_NilValue;
JL_GC_PUSH1(&tt);
if (jl_is_nothing(tt) || jl_is_null(tt))
return ans;
if (jl_is_array(tt))
{
ans = jr_array(tt);
}
else if(jl_isa(tt, "Range"))
{
ans = jr_range(tt);
}
else if(jl_isa(tt, "DataArray"))
{
ans = jr_data_array(tt);
}
else if(jl_isa(tt, "DataFrame"))
{
ans = jr_data_frame(tt);
}
else if (jl_is_tuple(tt))
{
PROTECT(ans = Rf_allocVector(VECSXP, jl_tuple_len(tt)));
for (int i = 0; i < jl_tuple_len(tt); i++)
SET_VECTOR_ELT(ans, i, jr_cast(jl_tupleref(tt, i)));
UNPROTECT(1);
}
else if(jl_isa(tt, "Dict"))
{
ans = jr_dict(tt);
}
else if(jl_is_function(tt))
{
ans = jr_func(tt);
}
else
{
ans = jr_scalar(tt);
}
JL_GC_POP();
if (ans == R_NilValue)
{
jl_error("invaild object");
}
return ans;
}
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));
}
}
}
void jl_show(jl_value_t *stream, jl_value_t *v)
{
if (jl_base_module) {
if (jl_show_gf == NULL) {
jl_show_gf = (jl_function_t*)jl_get_global(jl_base_module, jl_symbol("show"));
}
if (jl_show_gf==NULL || stream==NULL) {
JL_PRINTF(JL_STDERR, " could not show value of type %s",
jl_is_tuple(v) ? "Tuple" :
((jl_datatype_t*)jl_typeof(v))->name->name->name);
return;
}
jl_value_t *args[2] = {stream,v};
jl_apply(jl_show_gf, args, 2);
}
}
// given a new lambda_info with static parameter values, make a copy
// of the tree with declared types evaluated and static parameters passed
// on to all enclosed functions.
// this tree can then be further mutated by optimization passes.
DLLEXPORT
jl_value_t *jl_prepare_ast(jl_lambda_info_t *li, jl_tuple_t *sparams)
{
jl_tuple_t *spenv = NULL;
jl_value_t *l_ast = li->ast;
if (l_ast == NULL) return NULL;
jl_value_t *ast = l_ast;
JL_GC_PUSH(&spenv, &ast);
if (jl_is_tuple(ast))
ast = jl_uncompress_ast((jl_tuple_t*)ast);
spenv = jl_tuple_tvars_to_symbols(sparams);
ast = copy_ast(ast, sparams);
eval_decl_types(jl_lam_vinfo((jl_expr_t*)ast), spenv);
eval_decl_types(jl_lam_capt((jl_expr_t*)ast), spenv);
JL_GC_POP();
return ast;
}
static int type_contains(jl_value_t *ty, jl_value_t *x)
{
if (ty == x) return 1;
if (jl_is_tuple(ty)) {
size_t i, l=jl_tuple_len(ty);
for(i=0; i < l; i++) {
jl_value_t *e = jl_tupleref(ty,i);
if (e==x || type_contains(e, x))
return 1;
}
}
if (jl_is_uniontype(ty))
return type_contains(jl_fieldref(ty,0), x);
if (jl_is_datatype(ty))
return type_contains((jl_value_t*)((jl_datatype_t*)ty)->parameters, x);
return 0;
}
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);
}
}
DLLEXPORT void jl_uv_alloc_buf(uv_handle_t *handle, size_t suggested_size, uv_buf_t *buf)
{
if (handle->data) {
jl_value_t *ret = JULIA_CB(alloc_buf,handle->data,1,CB_UINT,suggested_size);
assert(jl_is_tuple(ret) && jl_is_pointer(jl_t0(ret)));
buf->base = (char*)jl_unbox_voidpointer(jl_t0(ret));
#ifdef _P64
assert(jl_is_uint64(jl_t1(ret)));
buf->len = jl_unbox_uint64(jl_t1(ret));
#else
assert(jl_is_uint32(jl_t1(ret)));
buf->len = jl_unbox_uint32(jl_t1(ret));
#endif
}
else {
buf->len = 0;
}
}
DLLEXPORT uptrint_t jl_object_id(jl_value_t *v)
{
if (jl_is_symbol(v))
return ((jl_sym_t*)v)->hash;
jl_value_t *tv = (jl_value_t*)jl_typeof(v);
if (jl_is_bits_type(tv)) {
size_t nb = jl_bitstype_nbits(tv)/8;
uptrint_t h = inthash((uptrint_t)tv);
switch (nb) {
case 1:
return int32hash(*(int8_t*)jl_bits_data(v) ^ h);
case 2:
return int32hash(*(int16_t*)jl_bits_data(v) ^ h);
case 4:
return int32hash(*(int32_t*)jl_bits_data(v) ^ h);
case 8:
return hash64(*(int64_t*)jl_bits_data(v) ^ h);
default:
#ifdef __LP64__
return h ^ memhash((char*)jl_bits_data(v), nb);
#else
return h ^ memhash32((char*)jl_bits_data(v), nb);
#endif
}
}
if (tv == (jl_value_t*)jl_union_kind) {
#ifdef __LP64__
return jl_object_id(jl_fieldref(v,0))^0xA5A5A5A5A5A5A5A5L;
#else
return jl_object_id(jl_fieldref(v,0))^0xA5A5A5A5;
#endif
}
if (jl_is_struct_type(tv))
return inthash((uptrint_t)v);
assert(jl_is_tuple(v));
uptrint_t h = 0;
size_t l = jl_tuple_len(v);
for(size_t i = 0; i < l; i++) {
uptrint_t u = jl_object_id(jl_tupleref(v,i));
h = bitmix(h, u);
}
return h;
}
static jl_value_t *jl_new_bits_internal(jl_value_t *dt, void *data, size_t *len)
{
if (jl_is_tuple(dt)) {
jl_tuple_t *tuple = (jl_tuple_t*)dt;
*len = LLT_ALIGN(*len, jl_new_bits_align(dt));
size_t i, l = jl_tuple_len(tuple);
jl_value_t *v = (jl_value_t*) jl_alloc_tuple(l);
JL_GC_PUSH1(v);
for (i = 0; i < l; i++) {
jl_tupleset(v,i,jl_new_bits_internal(jl_tupleref(tuple,i), (char*)data, len));
}
JL_GC_POP();
return v;
}
jl_datatype_t *bt = (jl_datatype_t*)dt;
size_t nb = jl_datatype_size(bt);
if (nb == 0)
return jl_new_struct_uninit(bt);
*len = LLT_ALIGN(*len, bt->alignment);
data = (char*)data + (*len);
*len += nb;
if (bt == jl_uint8_type) return jl_box_uint8(*(uint8_t*)data);
if (bt == jl_int64_type) return jl_box_int64(*(int64_t*)data);
if (bt == jl_bool_type) return (*(int8_t*)data) ? jl_true:jl_false;
if (bt == jl_int32_type) return jl_box_int32(*(int32_t*)data);
if (bt == jl_float64_type) return jl_box_float64(*(double*)data);
jl_value_t *v =
(jl_value_t*)allocobj((NWORDS(LLT_ALIGN(nb,sizeof(void*)))+1)*
sizeof(void*));
v->type = (jl_value_t*)bt;
switch (nb) {
case 1: *(int8_t*) jl_data_ptr(v) = *(int8_t*)data; break;
case 2: *(int16_t*) jl_data_ptr(v) = *(int16_t*)data; break;
case 4: *(int32_t*) jl_data_ptr(v) = *(int32_t*)data; break;
case 8: *(int64_t*) jl_data_ptr(v) = *(int64_t*)data; break;
case 16: *(bits128_t*)jl_data_ptr(v) = *(bits128_t*)data; break;
default: memcpy(jl_data_ptr(v), data, nb);
}
return v;
}
DLLEXPORT
jl_value_t *jl_new_closure_internal(jl_lambda_info_t *li, jl_value_t *env)
{
assert(jl_is_lambda_info(li));
assert(jl_is_tuple(env));
jl_function_t *f=NULL;
// note: env is pushed here to make codegen a little easier
JL_GC_PUSH(&f, &env);
if (li->fptr != NULL) {
// function has been compiled
f = jl_new_closure(li->fptr, env);
}
else {
f = jl_new_closure(jl_trampoline, NULL);
f->env = (jl_value_t*)jl_tuple2((jl_value_t*)f, env);
}
f->linfo = li;
JL_GC_POP();
return (jl_value_t*)f;
}
//Convert Julia Type To R,Real interface
SEXP Julia_R(jl_value_t *Var)
{
SEXP ans = R_NilValue;
if (jl_is_nothing(Var) || jl_is_null(Var))
return ans;
//Array To Vector
JL_GC_PUSH1(&Var);
if (jl_is_array(Var))
{
ans = Julia_R_MD(Var);
}
else if (jl_is_DataArrayFrame(Var))
{
//try to load DataArrays DataFrames package
if (!LoadDF())
{
JL_GC_POP();
return R_NilValue;
}
if (jl_is_NAtype(Var))
ans = Julia_R_Scalar_NA(Var);
else if (jl_is_DataFrame(Var))
ans = Julia_R_MD_NA_DataFrame(Var);
else if (jl_is_DataArray(Var))
ans = Julia_R_MD_NA(Var);
else if (jl_is_PooledDataArray(Var))
ans = Julia_R_MD_NA_Factor(Var);
}
else if (jl_is_tuple(Var))
{
PROTECT(ans = allocVector(VECSXP, jl_tuple_len(Var)));
for (int i = 0; i < jl_tuple_len(Var); i++)
SET_ELEMENT(ans, i, Julia_R(jl_tupleref(Var, i)));
UNPROTECT(1);
}
else
ans = Julia_R_Scalar(Var);
JL_GC_POP();
return ans;
}
static jl_methlist_t *jl_deserialize_methlist(ios_t *s)
{
jl_methlist_t *ml = NULL;
jl_methlist_t **pnext = &ml;
while (1) {
jl_value_t *sig = jl_deserialize_value(s);
if (sig == NULL)
break;
jl_methlist_t *node = (jl_methlist_t*)allocb(sizeof(jl_methlist_t));
node->sig = (jl_tuple_t*)sig;
assert(jl_is_tuple(sig));
node->va = read_int8(s);
node->tvars = (jl_tuple_t*)jl_deserialize_value(s);
node->func = (jl_function_t*)jl_deserialize_value(s);
node->invokes = (jl_methtable_t*)jl_deserialize_value(s);
node->next = NULL;
*pnext = node;
pnext = &node->next;
}
return ml;
}
jl_value_t *jl_method_def(jl_sym_t *name, jl_value_t **bp, jl_binding_t *bnd,
jl_tuple_t *argtypes, jl_function_t *f)
{
jl_value_t *gf;
if (bnd) {
jl_declare_constant(bnd);
}
if (*bp == NULL) {
gf = (jl_value_t*)jl_new_generic_function(name);
*bp = gf;
}
else {
gf = *bp;
if (!jl_is_gf(gf))
jl_error("in method definition: not a generic function");
}
JL_GC_PUSH(&gf);
assert(jl_is_function(f));
assert(jl_is_tuple(argtypes));
check_type_tuple(argtypes, name, "method definition");
jl_add_method((jl_function_t*)gf, argtypes, f);
JL_GC_POP();
return gf;
}
int jl_egal(jl_value_t *a, jl_value_t *b)
{
if (a == b)
return 1;
jl_value_t *ta = (jl_value_t*)jl_typeof(a);
if (ta != (jl_value_t*)jl_typeof(b))
return 0;
if (jl_is_bits_type(ta)) {
size_t nb = jl_bitstype_nbits(ta)/8;
switch (nb) {
case 1:
return *(int8_t*)jl_bits_data(a) == *(int8_t*)jl_bits_data(b);
case 2:
return *(int16_t*)jl_bits_data(a) == *(int16_t*)jl_bits_data(b);
case 4:
return *(int32_t*)jl_bits_data(a) == *(int32_t*)jl_bits_data(b);
case 8:
return *(int64_t*)jl_bits_data(a) == *(int64_t*)jl_bits_data(b);
default:
return memcmp(jl_bits_data(a), jl_bits_data(b), nb)==0;
}
}
if (jl_is_tuple(a)) {
size_t l = jl_tuple_len(a);
if (l != jl_tuple_len(b))
return 0;
for(size_t i=0; i < l; i++) {
if (!jl_egal(jl_tupleref(a,i),jl_tupleref(b,i)))
return 0;
}
return 1;
}
if (ta == (jl_value_t*)jl_union_kind)
return jl_egal(jl_fieldref(a,0), jl_fieldref(b,0));
return 0;
}
// ccall(pointer, rettype, (argtypes...), args...)
static Value *emit_ccall(jl_value_t **args, size_t nargs, jl_codectx_t *ctx)
{
JL_NARGSV(ccall, 3);
jl_value_t *ptr=NULL, *rt=NULL, *at=NULL;
Value *jl_ptr=NULL;
JL_GC_PUSH(&ptr, &rt, &at);
ptr = static_eval(args[1], ctx, true);
if (ptr == NULL) {
jl_value_t *ptr_ty = expr_type(args[1], ctx);
Value *arg1 = emit_unboxed(args[1], ctx);
if (!jl_is_cpointer_type(ptr_ty)) {
emit_typecheck(arg1, (jl_value_t*)jl_voidpointer_type,
"ccall: function argument not a pointer or valid constant", ctx);
}
jl_ptr = emit_unbox(T_size, T_psize, arg1);
}
rt = jl_interpret_toplevel_expr_in(ctx->module, args[2],
&jl_tupleref(ctx->sp,0),
jl_tuple_len(ctx->sp)/2);
if (jl_is_tuple(rt)) {
std::string msg = "in " + ctx->funcName +
": ccall: missing return type";
jl_error(msg.c_str());
}
at = jl_interpret_toplevel_expr_in(ctx->module, args[3],
&jl_tupleref(ctx->sp,0),
jl_tuple_len(ctx->sp)/2);
void *fptr=NULL;
char *f_name=NULL, *f_lib=NULL;
if (ptr != NULL) {
if (jl_is_tuple(ptr) && jl_tuple_len(ptr)==1) {
ptr = jl_tupleref(ptr,0);
}
if (jl_is_symbol(ptr))
f_name = ((jl_sym_t*)ptr)->name;
else if (jl_is_byte_string(ptr))
f_name = jl_string_data(ptr);
if (f_name != NULL) {
// just symbol, default to JuliaDLHandle
#ifdef __WIN32__
fptr = jl_dlsym_e(jl_dl_handle, f_name);
if (!fptr) {
//TODO: when one of these succeeds, store the f_lib name (and clear fptr)
fptr = jl_dlsym_e(jl_kernel32_handle, f_name);
if (!fptr) {
fptr = jl_dlsym_e(jl_ntdll_handle, f_name);
if (!fptr) {
fptr = jl_dlsym_e(jl_crtdll_handle, f_name);
if (!fptr) {
fptr = jl_dlsym(jl_winsock_handle, f_name);
}
}
}
}
else {
// available in process symbol table
fptr = NULL;
}
#else
// will look in process symbol table
#endif
}
else if (jl_is_cpointer_type(jl_typeof(ptr))) {
fptr = *(void**)jl_bits_data(ptr);
}
else if (jl_is_tuple(ptr) && jl_tuple_len(ptr)>1) {
jl_value_t *t0 = jl_tupleref(ptr,0);
jl_value_t *t1 = jl_tupleref(ptr,1);
if (jl_is_symbol(t0))
f_name = ((jl_sym_t*)t0)->name;
else if (jl_is_byte_string(t0))
f_name = jl_string_data(t0);
else
JL_TYPECHK(ccall, symbol, t0);
if (jl_is_symbol(t1))
f_lib = ((jl_sym_t*)t1)->name;
else if (jl_is_byte_string(t1))
f_lib = jl_string_data(t1);
else
JL_TYPECHK(ccall, symbol, t1);
}
else {
JL_TYPECHK(ccall, pointer, ptr);
}
}
if (f_name == NULL && fptr == NULL && jl_ptr == NULL) {
JL_GC_POP();
emit_error("ccall: null function pointer", ctx);
return literal_pointer_val(jl_nothing);
}
JL_TYPECHK(ccall, type, rt);
JL_TYPECHK(ccall, tuple, at);
JL_TYPECHK(ccall, type, at);
jl_tuple_t *tt = (jl_tuple_t*)at;
std::vector<Type *> fargt(0);
std::vector<Type *> fargt_sig(0);
Type *lrt = julia_type_to_llvm(rt);
if (lrt == NULL) {
JL_GC_POP();
return literal_pointer_val(jl_nothing);
}
size_t i;
bool haspointers = false;
bool isVa = false;
size_t nargt = jl_tuple_len(tt);
std::vector<AttributeWithIndex> attrs;
for(i=0; i < nargt; i++) {
jl_value_t *tti = jl_tupleref(tt,i);
if (jl_is_seq_type(tti)) {
isVa = true;
tti = jl_tparam0(tti);
}
if (jl_is_bits_type(tti)) {
// see pull req #978. need to annotate signext/zeroext for
// small integer arguments.
jl_bits_type_t *bt = (jl_bits_type_t*)tti;
if (bt->nbits < 32) {
if (jl_signed_type == NULL) {
jl_signed_type = jl_get_global(jl_core_module,jl_symbol("Signed"));
}
#ifdef LLVM32
Attributes::AttrVal av;
if (jl_signed_type && jl_subtype(tti, jl_signed_type, 0))
av = Attributes::SExt;
else
av = Attributes::ZExt;
attrs.push_back(AttributeWithIndex::get(getGlobalContext(), i+1,
ArrayRef<Attributes::AttrVal>(&av, 1)));
#else
Attribute::AttrConst av;
if (jl_signed_type && jl_subtype(tti, jl_signed_type, 0))
av = Attribute::SExt;
else
av = Attribute::ZExt;
attrs.push_back(AttributeWithIndex::get(i+1, av));
#endif
}
}
Type *t = julia_type_to_llvm(tti);
if (t == NULL) {
JL_GC_POP();
return literal_pointer_val(jl_nothing);
}
fargt.push_back(t);
if (!isVa)
fargt_sig.push_back(t);
}
// check for calling convention specifier
CallingConv::ID cc = CallingConv::C;
jl_value_t *last = args[nargs];
if (jl_is_expr(last)) {
jl_sym_t *lhd = ((jl_expr_t*)last)->head;
if (lhd == jl_symbol("stdcall")) {
cc = CallingConv::X86_StdCall;
nargs--;
}
else if (lhd == jl_symbol("cdecl")) {
cc = CallingConv::C;
nargs--;
}
else if (lhd == jl_symbol("fastcall")) {
cc = CallingConv::X86_FastCall;
nargs--;
}
else if (lhd == jl_symbol("thiscall")) {
cc = CallingConv::X86_ThisCall;
nargs--;
}
}
if ((!isVa && jl_tuple_len(tt) != (nargs-2)/2) ||
( isVa && jl_tuple_len(tt)-1 > (nargs-2)/2))
jl_error("ccall: wrong number of arguments to C function");
// some special functions
if (fptr == &jl_array_ptr) {
Value *ary = emit_expr(args[4], ctx);
JL_GC_POP();
return mark_julia_type(builder.CreateBitCast(emit_arrayptr(ary),lrt),
rt);
}
// see if there are & arguments
for(i=4; i < nargs+1; i+=2) {
jl_value_t *argi = args[i];
if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
haspointers = true;
break;
}
}
// make LLVM function object for the target
Value *llvmf;
FunctionType *functype = FunctionType::get(lrt, fargt_sig, isVa);
if (jl_ptr != NULL) {
null_pointer_check(jl_ptr,ctx);
Type *funcptype = PointerType::get(functype,0);
llvmf = builder.CreateIntToPtr(jl_ptr, funcptype);
} else if (fptr != NULL) {
Type *funcptype = PointerType::get(functype,0);
llvmf = literal_pointer_val(fptr, funcptype);
}
else {
void *symaddr;
if (f_lib != NULL)
symaddr = add_library_sym(f_name, f_lib);
else
symaddr = sys::DynamicLibrary::SearchForAddressOfSymbol(f_name);
if (symaddr == NULL) {
JL_GC_POP();
std::stringstream msg;
msg << "ccall: could not find function ";
msg << f_name;
if (f_lib != NULL) {
msg << " in library ";
msg << f_lib;
}
emit_error(msg.str(), ctx);
return literal_pointer_val(jl_nothing);
}
llvmf = jl_Module->getOrInsertFunction(f_name, functype);
}
// save temp argument area stack pointer
Value *saveloc=NULL;
Value *stacksave=NULL;
if (haspointers) {
// TODO: inline this
saveloc = builder.CreateCall(save_arg_area_loc_func);
stacksave =
builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
Intrinsic::stacksave));
}
// emit arguments
Value *argvals[(nargs-3)/2];
int last_depth = ctx->argDepth;
int nargty = jl_tuple_len(tt);
for(i=4; i < nargs+1; i+=2) {
int ai = (i-4)/2;
jl_value_t *argi = args[i];
bool addressOf = false;
if (jl_is_expr(argi) && ((jl_expr_t*)argi)->head == amp_sym) {
addressOf = true;
argi = jl_exprarg(argi,0);
}
Type *largty;
jl_value_t *jargty;
if (isVa && ai >= nargty-1) {
largty = fargt[nargty-1];
jargty = jl_tparam0(jl_tupleref(tt,nargty-1));
}
else {
largty = fargt[ai];
jargty = jl_tupleref(tt,ai);
}
Value *arg;
if (largty == jl_pvalue_llvmt) {
arg = emit_expr(argi, ctx, true);
}
else {
arg = emit_unboxed(argi, ctx);
if (jl_is_bits_type(expr_type(argi, ctx))) {
if (addressOf)
arg = emit_unbox(largty->getContainedType(0), largty, arg);
else
arg = emit_unbox(largty, PointerType::get(largty,0), arg);
}
}
/*
#ifdef JL_GC_MARKSWEEP
// make sure args are rooted
if (largty->isPointerTy() &&
(largty == jl_pvalue_llvmt ||
!jl_is_bits_type(expr_type(args[i], ctx)))) {
make_gcroot(boxed(arg), ctx);
}
#endif
*/
argvals[ai] = julia_to_native(largty, jargty, arg, argi, addressOf,
ai+1, ctx);
}
// the actual call
Value *result = builder.CreateCall(llvmf,
ArrayRef<Value*>(&argvals[0],(nargs-3)/2));
if (cc != CallingConv::C)
((CallInst*)result)->setCallingConv(cc);
#ifdef LLVM32
((CallInst*)result)->setAttributes(AttrListPtr::get(getGlobalContext(), ArrayRef<AttributeWithIndex>(attrs)));
#else
((CallInst*)result)->setAttributes(AttrListPtr::get(attrs.data(),attrs.size()));
#endif
// restore temp argument area stack pointer
if (haspointers) {
assert(saveloc != NULL);
builder.CreateCall(restore_arg_area_loc_func, saveloc);
assert(stacksave != NULL);
builder.CreateCall(Intrinsic::getDeclaration(jl_Module,
Intrinsic::stackrestore),
stacksave);
}
ctx->argDepth = last_depth;
if (0) { // Enable this to turn on SSPREQ (-fstack-protector) on the function containing this ccall
#ifdef LLVM32
ctx->f->addFnAttr(Attributes::StackProtectReq);
#else
ctx->f->addFnAttr(Attribute::StackProtectReq);
#endif
}
JL_GC_POP();
if (lrt == T_void)
return literal_pointer_val((jl_value_t*)jl_nothing);
return mark_julia_type(result, rt);
}
