static SEXP Julia_R_MD_NA_DataFrame(jl_value_t *Var) { SEXP ans, names, rownames; char evalcmd[evalsize]; int i; const char *dfname = "DataFrameName0tmp"; jl_set_global(jl_main_module, jl_symbol(dfname), (jl_value_t *)Var); //Get Frame cols snprintf(evalcmd, evalsize, "size(%s,2)", dfname); jl_value_t *cols = jl_eval_string(evalcmd); int collen = jl_unbox_long(cols); jl_value_t *eachcolvector; jl_value_t *coltype; //Create VECSXP //Create SEXP for Each Column and assign PROTECT(ans = allocVector(VECSXP, collen)); for (i = 0; i < collen; i++) { snprintf(evalcmd, evalsize, "%s[%d]", dfname, i + 1); eachcolvector = jl_eval_string(evalcmd); snprintf(evalcmd, evalsize, "isa(%s[%d],PooledDataArray)", dfname, i + 1); coltype = jl_eval_string(evalcmd); if (jl_unbox_bool(coltype)) SET_VECTOR_ELT(ans, i, Julia_R_MD_NA_Factor(eachcolvector)); else SET_VECTOR_ELT(ans, i, Julia_R_MD_NA(eachcolvector)); } //set names attribute snprintf(evalcmd, evalsize, "names(%s)", dfname); jl_value_t *ret = jl_eval_string(evalcmd); jl_value_t *onesymbol; if (jl_is_array(ret)) { PROTECT(names = allocVector(STRSXP, collen)); for (i = 0; i < jl_array_len(ret); i++) { onesymbol = jl_arrayref((jl_array_t *)ret, i); if (jl_is_symbol(onesymbol)) SET_STRING_ELT(names, i, mkChar(((jl_sym_t *)onesymbol)->name)); } setAttrib(ans, R_NamesSymbol, names); UNPROTECT(1); } //set row names snprintf(evalcmd, evalsize, "size(%s,1)", dfname); jl_value_t *rows = jl_eval_string(evalcmd); int rowlen = jl_unbox_long(rows); PROTECT(rownames = allocVector(INTSXP, rowlen)); for (i = 0; i < rowlen; i++) INTEGER(rownames)[i] = i + 1; setAttrib(ans, R_RowNamesSymbol, rownames); UNPROTECT(1); //set class as data frame setAttrib(ans, R_ClassSymbol, mkString("data.frame")); //SET_OBJECT(ans, 1) ; UNPROTECT(1); return ans; }
jl_array_t *jl_reshape_array(jl_value_t *atype, jl_array_t *data, jl_tuple_t *dims) { size_t i; jl_array_t *a; size_t ndims = jl_tuple_len(dims); int ndimwords = jl_array_ndimwords(ndims); a = allocobj((sizeof(jl_array_t) + sizeof(void*) + ndimwords*sizeof(size_t) + 15)&-16); a->type = atype; a->ndims = ndims; a->offset = 0; a->data = NULL; a->isaligned = data->isaligned; jl_value_t *el_type = jl_tparam0(atype); if (store_unboxed(el_type)) { a->elsize = jl_datatype_size(el_type); a->ptrarray = 0; } else { a->elsize = sizeof(void*); a->ptrarray = 1; } JL_GC_PUSH1(&a); jl_array_data_owner(a) = (jl_value_t*)data; a->how = 3; a->data = data->data; a->isshared = 1; data->isshared = 1; if (ndims == 1) { size_t l = jl_unbox_long(jl_tupleref(dims,0)); #ifdef STORE_ARRAY_LEN a->length = l; #endif a->nrows = l; a->maxsize = l; } else { size_t *adims = &a->nrows; size_t l=1; wideint_t prod; for(i=0; i < ndims; i++) { adims[i] = jl_unbox_long(jl_tupleref(dims, i)); prod = (wideint_t)l * (wideint_t)adims[i]; if (prod > (wideint_t) MAXINTVAL) jl_error("invalid Array dimensions"); l = prod; } #ifdef STORE_ARRAY_LEN a->length = l; #endif } JL_GC_POP(); return a; }
jl_array_t *jl_ptr_to_array(jl_type_t *atype, void *data, jl_tuple_t *dims, int julia_mallocated) { size_t i, elsz, nel=1; jl_array_t *a; size_t ndims = jl_tuple_len(dims); for(i=0; i < ndims; i++) { nel *= jl_unbox_long(jl_tupleref(dims, i)); } jl_type_t *el_type = (jl_type_t*)jl_tparam0(atype); int isunboxed = jl_is_bits_type(el_type); if (isunboxed) elsz = jl_bitstype_nbits(el_type)/8; else elsz = sizeof(void*); int ndimwords = (ndims > 2 ? (ndims-2) : 0); #ifndef __LP64__ // on 32-bit, ndimwords must be odd to preserve 8-byte alignment ndimwords += (~ndimwords)&1; #endif a = allocobj(sizeof(jl_array_t) + ndimwords*sizeof(size_t)); a->type = atype; a->data = data; a->length = nel; a->elsize = elsz; a->ptrarray = !isunboxed; a->ndims = ndims; if (julia_mallocated) { a->reshaped = 0; jl_gc_acquire_buffer(data); } else { // this marks the array as not owning its buffer a->reshaped = 1; *((jl_array_t**)(&a->_space[0] + ndimwords*sizeof(size_t))) = a; } if (ndims == 1) { a->nrows = a->length; a->maxsize = a->length; a->offset = 0; } else { size_t *adims = &a->nrows; for(i=0; i < ndims; i++) { adims[i] = jl_unbox_long(jl_tupleref(dims, i)); } } return a; }
jl_array_t *jl_ptr_to_array(jl_value_t *atype, void *data, jl_tuple_t *dims, int own_buffer) { size_t i, elsz, nel=1; jl_array_t *a; size_t ndims = jl_tuple_len(dims); wideint_t prod; for(i=0; i < ndims; i++) { prod = (wideint_t)nel * (wideint_t)jl_unbox_long(jl_tupleref(dims, i)); if (prod > (wideint_t) MAXINTVAL) jl_error("invalid Array dimensions"); nel = prod; } jl_value_t *el_type = jl_tparam0(atype); int isunboxed = store_unboxed(el_type); if (isunboxed) elsz = jl_datatype_size(el_type); else elsz = sizeof(void*); int ndimwords = jl_array_ndimwords(ndims); a = allocobj((sizeof(jl_array_t) + ndimwords*sizeof(size_t)+15)&-16); a->type = atype; a->data = data; #ifdef STORE_ARRAY_LEN a->length = nel; #endif a->elsize = elsz; a->ptrarray = !isunboxed; a->ndims = ndims; a->offset = 0; a->isshared = 1; a->isaligned = 0; if (own_buffer) { a->how = 2; jl_gc_track_malloced_array(a); } else { a->how = 0; } if (ndims == 1) { a->nrows = nel; a->maxsize = nel; } else { size_t *adims = &a->nrows; for(i=0; i < ndims; i++) { adims[i] = jl_unbox_long(jl_tupleref(dims, i)); } } return a; }
static value_t julia_to_scm(jl_value_t *v) { if (jl_is_symbol(v)) { return symbol(((jl_sym_t*)v)->name); } if (v == jl_true) { return FL_T; } if (v == jl_false) { return FL_F; } if (jl_is_expr(v)) { jl_expr_t *ex = (jl_expr_t*)v; value_t args = array_to_list(ex->args); fl_gc_handle(&args); value_t hd = julia_to_scm((jl_value_t*)ex->head); value_t scmv = fl_cons(hd, args); fl_free_gc_handles(1); return scmv; } if (jl_typeis(v, jl_linenumbernode_type)) { return fl_cons(julia_to_scm((jl_value_t*)line_sym), fl_cons(julia_to_scm(jl_fieldref(v,0)), FL_NIL)); } if (jl_typeis(v, jl_labelnode_type)) { return fl_cons(julia_to_scm((jl_value_t*)label_sym), fl_cons(julia_to_scm(jl_fieldref(v,0)), FL_NIL)); } if (jl_typeis(v, jl_gotonode_type)) { return fl_cons(julia_to_scm((jl_value_t*)goto_sym), fl_cons(julia_to_scm(jl_fieldref(v,0)), FL_NIL)); } if (jl_typeis(v, jl_quotenode_type)) { return fl_cons(julia_to_scm((jl_value_t*)quote_sym), fl_cons(julia_to_scm(jl_fieldref(v,0)), FL_NIL)); } if (jl_typeis(v, jl_topnode_type)) { return fl_cons(julia_to_scm((jl_value_t*)top_sym), fl_cons(julia_to_scm(jl_fieldref(v,0)), FL_NIL)); } if (jl_is_long(v) && fits_fixnum(jl_unbox_long(v))) { return fixnum(jl_unbox_long(v)); } if (jl_typeis(v,jl_array_any_type)) { return array_to_list((jl_array_t*)v); } value_t opaque = cvalue(jvtype, sizeof(void*)); *(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = v; return opaque; }
// run time version of pointerref intrinsic DLLEXPORT jl_value_t *jl_pointerref(jl_value_t *p, jl_value_t *i) { JL_TYPECHK(pointerref, pointer, p); JL_TYPECHK(pointerref, long, i); jl_value_t *ety = jl_tparam0(jl_typeof(p)); if (!jl_is_datatype(ety)) jl_error("pointerref: invalid pointer"); size_t nb = jl_datatype_size(ety); char *pp = (char*)jl_unbox_long(p) + (jl_unbox_long(i)-1)*nb; return jl_new_bits(ety, pp); }
// copy a :lambda Expr into its LambdaInfo representation static void jl_lambda_info_set_ast(jl_lambda_info_t *li, jl_expr_t *ast) { assert(jl_is_expr(ast)); jl_expr_t *bodyex = (jl_expr_t*)jl_exprarg(ast, 2); assert(jl_is_expr(bodyex)); jl_array_t *body = bodyex->args; li->code = (jl_value_t*)body; jl_gc_wb(li, li->code); if (has_meta(body, pure_sym)) li->pure = 1; jl_array_t *vinfo = (jl_array_t*)jl_exprarg(ast, 1); jl_array_t *vis = (jl_array_t*)jl_array_ptr_ref(vinfo, 0); size_t nslots = jl_array_len(vis); jl_value_t *ssavalue_types = jl_array_ptr_ref(vinfo, 2); assert(jl_is_long(ssavalue_types)); size_t nssavalue = jl_unbox_long(ssavalue_types); li->slotnames = jl_alloc_vec_any(nslots); jl_gc_wb(li, li->slotnames); li->slottypes = jl_nothing; li->slotflags = jl_alloc_array_1d(jl_array_uint8_type, nslots); jl_gc_wb(li, li->slotflags); li->ssavaluetypes = jl_box_long(nssavalue); jl_gc_wb(li, li->ssavaluetypes); int i; for(i=0; i < nslots; i++) { jl_value_t *vi = jl_array_ptr_ref(vis, i); jl_sym_t *name = (jl_sym_t*)jl_array_ptr_ref(vi, 0); assert(jl_is_symbol(name)); char *str = jl_symbol_name(name); if (i > 0 && name != unused_sym) { if (str[0] == '#') { // convention for renamed variables: #...#original_name char *nxt = strchr(str + 1, '#'); if (nxt) name = jl_symbol(nxt+1); else if (str[1] == 's') // compiler-generated temporaries, #sXXX name = compiler_temp_sym; } } jl_array_ptr_set(li->slotnames, i, name); jl_array_uint8_set(li->slotflags, i, jl_unbox_long(jl_array_ptr_ref(vi, 2))); } jl_array_t *sparams = (jl_array_t*)jl_array_ptr_ref(vinfo, 3); assert(jl_is_array(sparams)); li->sparam_syms = jl_alloc_svec_uninit(jl_array_len(sparams)); jl_gc_wb(li, li->sparam_syms); for(i=0; i < jl_array_len(sparams); i++) { jl_svecset(li->sparam_syms, i, jl_array_ptr_ref(sparams, i)); } jl_array_t *args = (jl_array_t*)jl_exprarg(ast, 0); size_t narg = jl_array_len(args); li->nargs = narg; li->isva = narg > 0 && jl_is_rest_arg(jl_array_ptr_ref(args, narg - 1)); }
// run time version of pointerset intrinsic DLLEXPORT void jl_pointerset(jl_value_t *p, jl_value_t *x, jl_value_t *i) { JL_TYPECHK(pointerset, pointer, p); JL_TYPECHK(pointerset, long, i); jl_value_t *ety = jl_tparam0(jl_typeof(p)); if (!jl_is_datatype(ety)) jl_error("pointerset: invalid pointer"); size_t nb = jl_datatype_size(ety); char *pp = (char*)jl_unbox_long(p) + (jl_unbox_long(i)-1)*nb; if (jl_typeof(x) != ety) jl_error("pointerset: type mismatch in assign"); jl_assign_bits(pp, x); }
jl_array_t *jl_ptr_to_array(jl_type_t *atype, void *data, jl_tuple_t *dims, int own_buffer) { size_t i, elsz, nel=1; jl_array_t *a; size_t ndims = jl_tuple_len(dims); for(i=0; i < ndims; i++) { nel *= jl_unbox_long(jl_tupleref(dims, i)); } jl_type_t *el_type = (jl_type_t*)jl_tparam0(atype); int isunboxed = jl_is_bits_type(el_type); if (isunboxed) elsz = jl_bitstype_nbits(el_type)/8; else elsz = sizeof(void*); int ndimwords = jl_array_ndimwords(ndims); a = allocobj((sizeof(jl_array_t) + ndimwords*sizeof(size_t)+15)&-16); a->type = atype; a->data = data; a->length = nel; a->elsize = elsz; a->ptrarray = !isunboxed; a->ndims = ndims; if (own_buffer) { a->ismalloc = 1; jl_array_data_owner(a) = (jl_value_t*)jl_gc_acquire_buffer(data,nel*elsz); } else { a->ismalloc = 0; jl_array_data_owner(a) = (jl_value_t*)a; } if (ndims == 1) { a->nrows = a->length; a->maxsize = a->length; a->offset = 0; } else { size_t *adims = &a->nrows; for(i=0; i < ndims; i++) { adims[i] = jl_unbox_long(jl_tupleref(dims, i)); } } return a; }
static value_t julia_to_scm_(fl_context_t *fl_ctx, jl_value_t *v) { if (jl_is_symbol(v)) return symbol(fl_ctx, jl_symbol_name((jl_sym_t*)v)); if (v == jl_true) return jl_ast_ctx(fl_ctx)->true_sym; if (v == jl_false) return jl_ast_ctx(fl_ctx)->false_sym; if (v == jl_nothing) return fl_cons(fl_ctx, jl_ast_ctx(fl_ctx)->null_sym, fl_ctx->NIL); if (jl_is_expr(v)) { jl_expr_t *ex = (jl_expr_t*)v; value_t args = fl_ctx->NIL; fl_gc_handle(fl_ctx, &args); array_to_list(fl_ctx, ex->args, &args); value_t hd = julia_to_scm_(fl_ctx, (jl_value_t*)ex->head); if (ex->head == lambda_sym && jl_expr_nargs(ex)>0 && jl_is_array(jl_exprarg(ex,0))) { value_t llist = fl_ctx->NIL; fl_gc_handle(fl_ctx, &llist); array_to_list(fl_ctx, (jl_array_t*)jl_exprarg(ex,0), &llist); car_(args) = llist; fl_free_gc_handles(fl_ctx, 1); } value_t scmv = fl_cons(fl_ctx, hd, args); fl_free_gc_handles(fl_ctx, 1); return scmv; } // GC Note: jl_fieldref(v, 0) allocate for LabelNode, GotoNode // but we don't need a GC root here because julia_to_list2 // shouldn't allocate in this case. if (jl_typeis(v, jl_labelnode_type)) return julia_to_list2(fl_ctx, (jl_value_t*)label_sym, jl_fieldref(v,0)); if (jl_typeis(v, jl_linenumbernode_type)) return julia_to_list2(fl_ctx, (jl_value_t*)line_sym, jl_fieldref(v,0)); if (jl_typeis(v, jl_gotonode_type)) return julia_to_list2(fl_ctx, (jl_value_t*)goto_sym, jl_fieldref(v,0)); if (jl_typeis(v, jl_quotenode_type)) return julia_to_list2(fl_ctx, (jl_value_t*)inert_sym, jl_fieldref(v,0)); if (jl_typeis(v, jl_newvarnode_type)) return julia_to_list2(fl_ctx, (jl_value_t*)newvar_sym, jl_fieldref(v,0)); if (jl_is_long(v) && fits_fixnum(jl_unbox_long(v))) return fixnum(jl_unbox_long(v)); if (jl_is_ssavalue(v)) jl_error("SSAValue objects should not occur in an AST"); if (jl_is_slot(v)) jl_error("Slot objects should not occur in an AST"); value_t opaque = cvalue(fl_ctx, jl_ast_ctx(fl_ctx)->jvtype, sizeof(void*)); *(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = v; return opaque; }
jl_array_t *jl_reshape_array(jl_type_t *atype, jl_array_t *data, jl_tuple_t *dims) { size_t i; jl_array_t *a; size_t ndims = dims->length; int ndimwords = (ndims > 2 ? (ndims-2) : 0); #ifndef __LP64__ // on 32-bit, ndimwords must be odd to preserve 8-byte alignment ndimwords += (~ndimwords)&1; #endif a = allocobj(sizeof(jl_array_t) + ndimwords*sizeof(size_t)); a->type = atype; *((jl_array_t**)(&a->_space[0] + ndimwords*sizeof(size_t))) = data; a->data = data->data; a->length = data->length; a->elsize = data->elsize; a->ndims = ndims; a->reshaped = 1; if (ndims == 1) { a->nrows = a->length; a->maxsize = a->length; a->offset = 0; } else { size_t *adims = &a->nrows; for(i=0; i < ndims; i++) { adims[i] = jl_unbox_long(jl_tupleref(dims, i)); } } return a; }
int jl_array_isdefined(jl_value_t **args0, int nargs) { assert(jl_is_array(args0[0])); 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->ptrarray) return ((jl_value_t**)jl_array_data(a))[i] != NULL; return 1; }
static inline int sig_match_simple(jl_value_t **args, size_t n, jl_value_t **sig, int va, size_t lensig) { // NOTE: This function is a performance hot spot!! size_t i; if (va) lensig -= 1; for (i = 0; i < lensig; i++) { jl_value_t *decl = sig[i]; jl_value_t *a = args[i]; if (decl == (jl_value_t*)jl_any_type || ((jl_value_t*)jl_typeof(a) == decl)) { /* we are only matching concrete types here, and those types are hash-consed, so pointer comparison should work. */ continue; } jl_value_t *unw = jl_is_unionall(decl) ? ((jl_unionall_t*)decl)->body : decl; if (jl_is_type_type(unw) && jl_is_type(a)) { jl_value_t *tp0 = jl_tparam0(unw); if (jl_is_typevar(tp0)) { // in the case of Type{_}, the types don't have to match exactly. // this is cached as `Type{T} where T`. if (((jl_tvar_t*)tp0)->ub != (jl_value_t*)jl_any_type && !jl_subtype(a, ((jl_tvar_t*)tp0)->ub)) return 0; } else { if (a != tp0) { if (jl_typeof(a) != jl_typeof(tp0)) return 0; jl_datatype_t *da = (jl_datatype_t*)a; jl_datatype_t *dt = (jl_datatype_t*)tp0; while (jl_is_unionall(da)) da = (jl_datatype_t*)((jl_unionall_t*)da)->body; while (jl_is_unionall(dt)) dt = (jl_datatype_t*)((jl_unionall_t*)dt)->body; if (jl_is_datatype(da) && jl_is_datatype(dt) && da->name != dt->name) return 0; if (!jl_types_equal(a, tp0)) return 0; } } } else { return 0; } } if (va) { jl_value_t *decl = sig[i]; if (jl_vararg_kind(decl) == JL_VARARG_INT) { if (n-i != jl_unbox_long(jl_tparam1(decl))) return 0; } jl_value_t *t = jl_unwrap_vararg(decl); for(; i < n; i++) { if (!jl_isa(args[i], t)) return 0; } return 1; } return 1; }
DLLEXPORT jl_lambda_info_t *jl_new_lambda_info(jl_value_t *ast, jl_tuple_t *sparams) { jl_lambda_info_t *li = (jl_lambda_info_t*)newobj((jl_value_t*)jl_lambda_info_type, LAMBDA_INFO_NW); li->ast = ast; li->file = null_sym; li->line = 0; if (ast != NULL && jl_is_expr(ast)) { jl_expr_t *body1 = (jl_expr_t*)jl_exprarg(jl_lam_body((jl_expr_t*)ast),0); if (jl_is_expr(body1) && ((jl_expr_t*)body1)->head == line_sym) { li->file = (jl_sym_t*)jl_exprarg(body1, 1); li->line = jl_unbox_long(jl_exprarg(body1, 0)); } } li->module = jl_current_module; li->sparams = sparams; li->tfunc = (jl_value_t*)jl_null; li->fptr = &jl_trampoline; li->roots = NULL; li->functionObject = NULL; li->cFunctionObject = NULL; li->specTypes = NULL; li->inferred = 0; li->inInference = 0; li->inCompile = 0; li->unspecialized = NULL; li->specializations = NULL; li->name = anonymous_sym; li->def = li; li->capt = NULL; return li; }
static Value *emit_arraylen_prim(Value *t, jl_value_t *ty) { #ifdef STORE_ARRAY_LEN (void)ty; Value *lenbits = emit_nthptr(t, 2); return builder.CreatePtrToInt(lenbits, T_size); #else jl_value_t *p1 = jl_tparam1(ty); if (jl_is_long(p1)) { size_t nd = jl_unbox_long(p1); Value *l = ConstantInt::get(T_size, 1); for(size_t i=0; i < nd; i++) { l = builder.CreateMul(l, emit_arraysize(t, (int)(i+1))); } return l; } else { std::vector<Type *> fargt(0); fargt.push_back(jl_pvalue_llvmt); FunctionType *ft = FunctionType::get(T_size, fargt, false); Value *alen = jl_Module->getOrInsertFunction("jl_array_len_", ft); return builder.CreateCall(alen, t); } #endif }
// run time version of pointerref intrinsic (warning: i is not rooted) JL_DLLEXPORT jl_value_t *jl_pointerref(jl_value_t *p, jl_value_t *i) { JL_TYPECHK(pointerref, pointer, p); JL_TYPECHK(pointerref, long, i); jl_value_t *ety = jl_tparam0(jl_typeof(p)); if (ety == (jl_value_t*)jl_any_type) { jl_value_t **pp = (jl_value_t**)(jl_unbox_long(p) + (jl_unbox_long(i)-1)*sizeof(void*)); return *pp; } else { if (!jl_is_datatype(ety)) jl_error("pointerref: invalid pointer"); size_t nb = LLT_ALIGN(jl_datatype_size(ety), ((jl_datatype_t*)ety)->layout->alignment); char *pp = (char*)jl_unbox_long(p) + (jl_unbox_long(i)-1)*nb; return jl_new_bits(ety, pp); } }
jl_array_t *jl_new_array(jl_value_t *atype, jl_value_t *dims) { size_t ndims = jl_nfields(dims); size_t *adims = (size_t*)alloca(ndims*sizeof(size_t)); size_t i; for(i=0; i < ndims; i++) adims[i] = jl_unbox_long(jl_fieldref(dims,i)); return _new_array(atype, ndims, adims); }
jl_array_t *jl_new_array(jl_type_t *atype, jl_tuple_t *dims) { size_t ndims = jl_tuple_len(dims); size_t *adims = alloca(ndims*sizeof(size_t)); size_t i; for(i=0; i < ndims; i++) adims[i] = jl_unbox_long(jl_tupleref(dims,i)); return _new_array(atype, ndims, adims); }
// run time version of pointerset intrinsic DLLEXPORT void jl_pointerset(jl_value_t *p, jl_value_t *x, jl_value_t *i) { JL_TYPECHK(pointerset, pointer, p); JL_TYPECHK(pointerset, long, i); jl_value_t *ety = jl_tparam0(jl_typeof(p)); if (ety == (jl_value_t*)jl_any_type) { jl_value_t **pp = (jl_value_t**)(jl_unbox_long(p) + (jl_unbox_long(i)-1)*sizeof(void*)); *pp = x; } else { if (!jl_is_datatype(ety)) jl_error("pointerset: invalid pointer"); size_t nb = LLT_ALIGN(jl_datatype_size(ety), ((jl_datatype_t*)ety)->alignment); char *pp = (char*)jl_unbox_long(p) + (jl_unbox_long(i)-1)*nb; if (jl_typeof(x) != ety) jl_error("pointerset: type mismatch in assign"); jl_assign_bits(pp, x); } }
static int sig_match_by_type_simple(jl_value_t **types, size_t n, jl_tupletype_t *sig, size_t lensig, int va) { size_t i; if (va) lensig -= 1; for (i = 0; i < lensig; i++) { jl_value_t *decl = jl_field_type(sig, i); jl_value_t *a = types[i]; if (jl_is_type_type(decl)) { jl_value_t *tp0 = jl_tparam0(decl); if (jl_is_type_type(a)) { if (tp0 == (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_is_typevar(tp0)) { if (!jl_subtype(jl_tparam0(a), ((jl_tvar_t*)tp0)->ub, 0)) return 0; } else { if (!jl_types_equal(jl_tparam0(a), tp0)) return 0; } } else if (!is_kind(a) || !jl_is_typevar(tp0) || ((jl_tvar_t*)tp0)->ub != (jl_value_t*)jl_any_type) { // manually unroll jl_subtype(a, decl) // where `a` can be a subtype like TypeConstructor // and decl is Type{T} return 0; } } else if (decl == (jl_value_t*)jl_any_type) { } else { if (jl_is_type_type(a)) // decl is not Type, because it would be caught above a = jl_typeof(jl_tparam0(a)); if (!jl_types_equal(a, decl)) return 0; } } if (va) { jl_value_t *decl = jl_field_type(sig, i); if (jl_vararg_kind(decl) == JL_VARARG_INT) { if (n-i != jl_unbox_long(jl_tparam1(decl))) return 0; } jl_value_t *t = jl_tparam0(decl); for(; i < n; i++) { if (!jl_subtype(types[i], t, 0)) return 0; } return 1; } return 1; }
static int sig_match_by_type_simple(jl_value_t **types, size_t n, jl_tupletype_t *sig, size_t lensig, int va) { size_t i; if (va) lensig -= 1; for (i = 0; i < lensig; i++) { jl_value_t *decl = jl_field_type(sig, i); jl_value_t *a = types[i]; jl_value_t *unw = jl_is_unionall(decl) ? ((jl_unionall_t*)decl)->body : decl; if (jl_is_type_type(unw)) { jl_value_t *tp0 = jl_tparam0(unw); if (jl_is_type_type(a)) { if (jl_is_typevar(tp0)) { // in the case of Type{_}, the types don't have to match exactly. // this is cached as `Type{T} where T`. if (((jl_tvar_t*)tp0)->ub != (jl_value_t*)jl_any_type && !jl_subtype(jl_tparam0(a), ((jl_tvar_t*)tp0)->ub)) return 0; } else { if (!(jl_typeof(jl_tparam0(a)) == jl_typeof(tp0) && jl_types_equal(jl_tparam0(a), tp0))) return 0; } } else if (!jl_is_kind(a) || !jl_is_typevar(tp0) || ((jl_tvar_t*)tp0)->ub != (jl_value_t*)jl_any_type) { // manually unroll jl_subtype(a, decl) // where `a` can be a subtype and decl is Type{T} return 0; } } else if (decl == (jl_value_t*)jl_any_type) { } else { if (jl_is_type_type(a)) // decl is not Type, because it would be caught above a = jl_typeof(jl_tparam0(a)); if (!jl_types_equal(a, decl)) return 0; } } if (va) { jl_value_t *decl = jl_unwrap_unionall(jl_field_type(sig, i)); if (jl_vararg_kind(decl) == JL_VARARG_INT) { if (n-i != jl_unbox_long(jl_tparam1(decl))) return 0; } jl_value_t *t = jl_tparam0(decl); if (jl_is_typevar(t)) t = ((jl_tvar_t*)t)->ub; for(; i < n; i++) { if (!jl_subtype(types[i], t)) return 0; } return 1; } return 1; }
static jl_value_t *eval_body(jl_array_t *stmts, jl_value_t **locals, size_t nl, int start) { jl_savestate_t __ss; jl_jmp_buf __handlr; size_t i=start; while (1) { jl_value_t *stmt = jl_cellref(stmts,i); if (jl_is_gotonode(stmt)) { i = label_idx(jl_fieldref(stmt,0), stmts); continue; } if (jl_is_expr(stmt)) { jl_sym_t *head = ((jl_expr_t*)stmt)->head; if (head == goto_ifnot_sym) { jl_value_t *cond = eval(jl_exprarg(stmt,0), locals, nl); if (cond == jl_false) { i = label_idx(jl_exprarg(stmt,1), stmts); continue; } else if (cond != jl_true) { jl_type_error_rt("toplevel", "if", (jl_value_t*)jl_bool_type, cond); } } else if (head == return_sym) { return eval(jl_exprarg(stmt,0), locals, nl); } else if (head == enter_sym) { jl_enter_handler(&__ss, &__handlr); if (!jl_setjmp(__handlr,1)) { return eval_body(stmts, locals, nl, i+1); } else { i = label_idx(jl_exprarg(stmt,0), stmts); continue; } } else if (head == leave_sym) { int hand_n_leave = jl_unbox_long(jl_exprarg(stmt,0)); jl_pop_handler(hand_n_leave); } else { eval(stmt, locals, nl); } } else { eval(stmt, locals, nl); } i++; } assert(0); return NULL; }
// this is a run-time function // warning: cannot allocate memory except using alloc_temp_arg_space extern "C" void *jl_value_to_pointer(jl_value_t *jt, jl_value_t *v, int argn, int addressof) { jl_value_t *jvt = (jl_value_t*)jl_typeof(v); if (addressof) { if (jvt == jt) { assert(jl_is_bits_type(jt)); size_t osz = jl_bitstype_nbits(jt)/8; return alloc_temp_arg_copy(jl_bits_data(v), osz); } goto value_to_pointer_error; } else { if (jl_is_cpointer_type(jvt) && jl_tparam0(jvt) == jt) { return (void*)jl_unbox_long(v); } } if (((jl_value_t*)jl_uint8_type == jt || (jl_value_t*)jl_int8_type == jt) && jl_is_byte_string(v)) { return jl_string_data(v); } if (jl_is_array(v)) { if (jl_tparam0(jl_typeof(v)) == jt || jt==(jl_value_t*)jl_bottom_type) return ((jl_array_t*)v)->data; if (jl_is_cpointer_type(jt)) { jl_array_t *ar = (jl_array_t*)v; void **temp=(void**)alloc_temp_arg_space(jl_array_len(ar)*sizeof(void*)); size_t i; for(i=0; i < jl_array_len(ar); i++) { temp[i] = jl_value_to_pointer(jl_tparam0(jt), jl_arrayref(ar, i), argn, 0); } return temp; } } value_to_pointer_error: std::map<int, std::string>::iterator it = argNumberStrings.find(argn); if (it == argNumberStrings.end()) { std::stringstream msg; msg << "argument "; msg << argn; argNumberStrings[argn] = msg.str(); it = argNumberStrings.find(argn); } jl_value_t *targ=NULL, *pty=NULL; JL_GC_PUSH(&targ, &pty); targ = (jl_value_t*)jl_tuple1(jt); pty = (jl_value_t*)jl_apply_type((jl_value_t*)jl_pointer_type, (jl_tuple_t*)targ); jl_type_error_rt("ccall", (*it).second.c_str(), pty, v); // doesn't return return (jl_value_t*)jl_null; }
jl_array_t *jl_new_arrayv(jl_type_t *atype, ...) { va_list args; size_t ndims = jl_unbox_long(jl_tparam1(atype)); size_t *adims = alloca(ndims*sizeof(size_t)); size_t i; va_start(args, atype); for(i=0; i < ndims; i++) adims[i] = va_arg(args, size_t); va_end(args); return _new_array(atype, ndims, adims); }
static int label_idx(jl_value_t *tgt, jl_array_t *stmts) { size_t j; long ltgt = jl_unbox_long(tgt); for(j=0; j < stmts->nrows; j++) { jl_value_t *l = jl_cellref(stmts,j); if (jl_is_labelnode(l) && jl_labelnode_label(l)==ltgt) break; } assert(j < stmts->nrows); return j; }
static inline int sig_match_simple(jl_value_t **args, size_t n, jl_value_t **sig, int va, size_t lensig) { // NOTE: This function is a performance hot spot!! size_t i; if (va) lensig -= 1; for (i = 0; i < lensig; i++) { jl_value_t *decl = sig[i]; jl_value_t *a = args[i]; if (decl == (jl_value_t*)jl_any_type) { } else if ((jl_value_t*)jl_typeof(a) == decl) { /* we are only matching concrete types here, and those types are hash-consed, so pointer comparison should work. */ } else if (jl_is_type_type(decl) && jl_is_type(a)) { jl_value_t *tp0 = jl_tparam0(decl); if (tp0 == (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_is_typevar(tp0)) { if (!jl_subtype(a, ((jl_tvar_t*)tp0)->ub, 0)) return 0; } else { if (a!=tp0 && !jl_types_equal(a,tp0)) return 0; } } else { return 0; } } if (va) { jl_value_t *decl = sig[i]; if (jl_vararg_kind(decl) == JL_VARARG_INT) { if (n-i != jl_unbox_long(jl_tparam1(decl))) return 0; } jl_value_t *t = jl_tparam0(decl); for(; i < n; i++) { if (!jl_subtype(args[i], t, 1)) return 0; } return 1; } return 1; }
// run time version of pointerset intrinsic (warning: x is not gc-rooted) JL_DLLEXPORT jl_value_t *jl_pointerset(jl_value_t *p, jl_value_t *x, jl_value_t *i, jl_value_t *align) { JL_TYPECHK(pointerset, pointer, p); JL_TYPECHK(pointerset, long, i); JL_TYPECHK(pointerref, long, align); jl_value_t *ety = jl_tparam0(jl_typeof(p)); if (ety == (jl_value_t*)jl_any_type) { jl_value_t **pp = (jl_value_t**)(jl_unbox_long(p) + (jl_unbox_long(i)-1)*sizeof(void*)); *pp = x; } else { if (!jl_is_datatype(ety)) jl_error("pointerset: invalid pointer"); size_t elsz = jl_datatype_size(ety); size_t nb = LLT_ALIGN(elsz, jl_datatype_align(ety)); char *pp = (char*)jl_unbox_long(p) + (jl_unbox_long(i)-1)*nb; if (jl_typeof(x) != ety) jl_error("pointerset: type mismatch in assign"); memcpy(pp, x, elsz); } return p; }
// heuristic for whether a top-level input should be evaluated with // the compiler or the interpreter. int jl_eval_with_compiler_p(jl_expr_t *expr, int compileloops) { assert(jl_is_expr(expr)); if (expr->head==body_sym && compileloops) { jl_array_t *body = expr->args; size_t i, maxlabl=0; // compile if there are backwards branches for(i=0; i < body->length; i++) { jl_value_t *stmt = jl_cellref(body,i); if (jl_is_labelnode(stmt)) { int l = jl_labelnode_label(stmt); if (l > maxlabl) maxlabl = l; } } size_t sz = (maxlabl+1+7)/8; char *labls = alloca(sz); memset(labls,0,sz); for(i=0; i < body->length; i++) { jl_value_t *stmt = jl_cellref(body,i); if (jl_is_labelnode(stmt)) { int l = jl_labelnode_label(stmt); labls[l/8] |= (1<<(l&7)); } else if (compileloops && jl_is_gotonode(stmt)) { int l = jl_gotonode_label(stmt); if (labls[l/8]&(1<<(l&7))) { return 1; } } else if (jl_is_expr(stmt)) { if (compileloops && ((jl_expr_t*)stmt)->head==goto_ifnot_sym) { int l = jl_unbox_long(jl_exprarg(stmt,1)); if (labls[l/8]&(1<<(l&7))) { return 1; } } // to compile code that uses exceptions /* if (((jl_expr_t*)stmt)->head == enter_sym) { return 1; } */ } } } if (has_intrinsics(expr)) return 1; return 0; }
// Note that this function updates len static jl_value_t *jl_new_bits_internal(jl_value_t *dt, void *data, size_t *len) { if (jl_is_ntuple_type(dt)) { jl_value_t *lenvar = jl_tparam0(dt); jl_value_t *elty = jl_tparam1(dt); assert(jl_is_datatype(elty)); size_t alignment = ((jl_datatype_t*)elty)->alignment; *len = LLT_ALIGN((*len), alignment); assert(jl_is_long(lenvar)); size_t l = jl_unbox_long(lenvar); size_t nb = l*LLT_ALIGN(jl_datatype_size(elty), alignment); jl_value_t *v = (jl_value_t*)newobj(dt, NWORDS(nb)); memcpy(jl_data_ptr(v), data, nb); return v; } assert(jl_is_datatype(dt)); 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*)newobj((jl_value_t*)bt, NWORDS(nb)); 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; }
static void body_attributes(jl_array_t *body, int *has_intrinsics, int *has_defs, int *has_loops) { size_t i; *has_loops = 0; for(i=0; i < jl_array_len(body); i++) { jl_value_t *stmt = jl_array_ptr_ref(body,i); if (!*has_loops) { if (jl_is_gotonode(stmt)) { if (jl_gotonode_label(stmt) <= i) *has_loops = 1; } else if (jl_is_expr(stmt)) { if (((jl_expr_t*)stmt)->head == goto_ifnot_sym) { if (jl_unbox_long(jl_exprarg(stmt,1)) <= i) *has_loops = 1; } } } expr_attributes(stmt, has_intrinsics, has_defs); } }