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)
}
JL_DLLEXPORT jl_value_t *jl_cglobal(jl_value_t *v, jl_value_t *ty)
{
JL_TYPECHK(cglobal, type, ty);
jl_value_t *rt =
v == (jl_value_t*)jl_void_type ? (jl_value_t*)jl_voidpointer_type : // a common case
(jl_value_t*)jl_apply_type_((jl_value_t*)jl_pointer_type, &ty, 1);
if (!jl_is_leaf_type(rt))
jl_error("cglobal: type argument not a leaftype");
if (jl_is_tuple(v) && jl_nfields(v) == 1)
v = jl_fieldref(v, 0);
if (jl_is_pointer(v))
return jl_reinterpret(rt, v);
char *f_lib = NULL;
if (jl_is_tuple(v) && jl_nfields(v) > 1) {
jl_value_t *t1 = jl_fieldref(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)
}
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);
}
static type apply(jl_value_t* value)
{
constexpr auto numReturns = sizeof...(TReturns);
static_assert(numReturns > 1, "This function call is for tuples.");
JULIACPP_ASSERT(jl_is_tuple(value), "Returned value is not a tuple.");
JULIACPP_ASSERT(jl_nfields(value) == numReturns, "Julia did not return the expected number of values.")
return makeTuple<TReturns...>(value, typename IndicesBuilder<numReturns>::type());
}
JL_DLLEXPORT jl_array_t *jl_ptr_to_array(jl_value_t *atype, void *data,
jl_value_t *_dims, int own_buffer)
{
jl_ptls_t ptls = jl_get_ptls_states();
size_t elsz, nel = 1;
jl_array_t *a;
size_t ndims = jl_nfields(_dims);
wideint_t prod;
assert(is_ntuple_long(_dims));
size_t *dims = (size_t*)_dims;
for (size_t i = 0; i < ndims; i++) {
prod = (wideint_t)nel * (wideint_t)dims[i];
if (prod > (wideint_t) MAXINTVAL)
jl_error("invalid Array dimensions");
nel = prod;
}
if (__unlikely(ndims == 1))
return jl_ptr_to_array_1d(atype, data, nel, own_buffer);
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);
int tsz = JL_ARRAY_ALIGN(sizeof(jl_array_t) + ndimwords*sizeof(size_t), JL_CACHE_BYTE_ALIGNMENT);
a = (jl_array_t*)jl_gc_alloc(ptls, tsz, atype);
// No allocation or safepoint allowed after this
a->flags.pooled = tsz <= GC_MAX_SZCLASS;
a->data = data;
#ifdef STORE_ARRAY_LEN
a->length = nel;
#endif
a->elsize = elsz;
a->flags.ptrarray = !isunboxed;
a->flags.ndims = ndims;
a->offset = 0;
a->flags.isshared = 1;
a->flags.isaligned = 0;
if (own_buffer) {
a->flags.how = 2;
jl_gc_track_malloced_array(ptls, a);
jl_gc_count_allocd(nel*elsz + (elsz == 1 ? 1 : 0));
}
else {
a->flags.how = 0;
}
assert(ndims != 1); // handled above
memcpy(&a->nrows, dims, ndims * sizeof(size_t));
return a;
}
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;
}
JL_DLLEXPORT jl_array_t *jl_new_array(jl_value_t *atype, jl_value_t *_dims)
{
size_t ndims = jl_nfields(_dims);
assert(is_ntuple_long(_dims));
return _new_array(atype, ndims, (size_t*)_dims);
}
JL_DLLEXPORT jl_array_t *jl_reshape_array(jl_value_t *atype, jl_array_t *data,
jl_value_t *_dims)
{
jl_ptls_t ptls = jl_get_ptls_states();
jl_array_t *a;
size_t ndims = jl_nfields(_dims);
assert(is_ntuple_long(_dims));
size_t *dims = (size_t*)_dims;
int ndimwords = jl_array_ndimwords(ndims);
int tsz = JL_ARRAY_ALIGN(sizeof(jl_array_t) + ndimwords*sizeof(size_t) + sizeof(void*), JL_SMALL_BYTE_ALIGNMENT);
a = (jl_array_t*)jl_gc_alloc(ptls, tsz, atype);
// No allocation or safepoint allowed after this
a->flags.pooled = tsz <= GC_MAX_SZCLASS;
a->flags.ndims = ndims;
a->offset = 0;
a->data = NULL;
a->flags.isaligned = data->flags.isaligned;
jl_value_t *el_type = jl_tparam0(atype);
assert(store_unboxed(el_type) == !data->flags.ptrarray);
if (!data->flags.ptrarray) {
a->elsize = jl_datatype_size(el_type);
a->flags.ptrarray = 0;
}
else {
a->elsize = sizeof(void*);
a->flags.ptrarray = 1;
}
// if data is itself a shared wrapper,
// owner should point back to the original array
jl_array_data_owner(a) = jl_array_owner(data);
a->flags.how = 3;
a->data = data->data;
a->flags.isshared = 1;
data->flags.isshared = 1;
if (ndims == 1) {
size_t l = 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 (size_t i = 0; i < ndims; i++) {
adims[i] = 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
}
return a;
}
//Maybe try to use cpp stuff to get the output inside julia system (ccall,cgen and cgutils)
//-| TODO: after adding in the jlapi.c jl_is_<C_type> functions replace the strcmp!
SEXP jl_value_to_SEXP(jl_value_t *res) {
size_t i=0,nd,d;
SEXP resR;
SEXPTYPE aryTyR;
jl_value_t *tmp;
char *resTy, *aryTy, *aryTy2;
if(res!=NULL) { //=> get a result
resTy=(char*)jl_typeof_str(res);
//DANGEROUS?? printf("typeof=%s\n",jl_typeof_str(res));
if(strcmp(jl_typeof_str(res),"Int64")==0 || strcmp(jl_typeof_str(res),"Int32")==0)
//if(jl_is_long(res)) //does not work because of DLLEXPORT
{
//printf("elt=%d\n",jl_unbox_long(res));
PROTECT(resR=NEW_INTEGER(1));
INTEGER_POINTER(resR)[0]=jl_unbox_long(res);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Float64")==0)
//if(jl_is_float64(res))
{
PROTECT(resR=NEW_NUMERIC(1));
NUMERIC_POINTER(resR)[0]=jl_unbox_float64(res);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Float32")==0)
//if(jl_is_float64(res))
{
PROTECT(resR=NEW_NUMERIC(1));
NUMERIC_POINTER(resR)[0]=jl_unbox_float32(res);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Bool")==0)
//if(jl_is_bool(res))
{
PROTECT(resR=NEW_LOGICAL(1));
LOGICAL(resR)[0]=(jl_unbox_bool(res) ? TRUE : FALSE);
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"DataType")==0)
//if(jl_is_bool(res))
{
PROTECT(resR=NEW_CHARACTER(1));
CHARACTER_POINTER(resR)[0]=mkChar(jl_typename_str(res));
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Nothing")==0)
//if(jl_is_bool(res))
{
return R_NilValue;
}
else
if(strcmp(resTy,"Complex")==0)
//if(jl_is_bool(res))
{
tmp=(jl_value_t*)jl_get_field(res, "re");
PROTECT(resR=NEW_COMPLEX(1));
if(strcmp(jl_typeof_str(tmp),"Float64")==0) {
COMPLEX(resR)[0].r=jl_unbox_float64(tmp);
COMPLEX(resR)[0].i=jl_unbox_float64(jl_get_field(res, "im"));
} else if(strcmp(jl_typeof_str(tmp),"Int64")==0) {
COMPLEX(resR)[0].r=jl_unbox_long(tmp);
COMPLEX(resR)[0].i=jl_unbox_long(jl_get_field(res, "im"));
}
UNPROTECT(1);
return resR;
}
else
if(strcmp(resTy,"Regex")==0)
//if(jl_is_bool(res))
{
// call=(jl_function_t*)jl_get_global(jl_base_module, jl_symbol("show"));
// printf("ici\n");
// if (call) tmp=jl_call1(call,res);
// else printf("call failed!\n");
// printf("ici\n");
// resR = jl_value_to_VALUE(jl_get_field(res, "pattern"));
// return resR;
}
else
if(strcmp(resTy,"ASCIIString")==0 || strcmp(resTy,"UTF8String")==0)
{
PROTECT(resR=NEW_CHARACTER(1));
CHARACTER_POINTER(resR)[0]=mkChar(jl_bytestring_ptr(res));
UNPROTECT(1);
return resR;
}
else
if(strcmp(jl_typeof_str(res),"Tuple")==0 )
//if(jl_is_array(res))
{
d=jl_nfields(res); //BEFORE 0.3: d=jl_tuple_len(res);
PROTECT(resR=allocVector(VECSXP,d));
for(i=0;i<d;i++) {
//BEFORE 0.3: SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_tupleref(res,i)));
SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_fieldref(res,i)));
}
UNPROTECT(1);
return resR;
}
if(strcmp(resTy,"Array")==0)
//if(jl_is_array(res))
{
nd = jl_array_rank(res);
//Rprintf("array_ndims=%d\n",(int)nd);
aryTy=(char*)jl_typename_str(jl_array_eltype(res));
aryTy2=(char*)jl_typeof_str(jl_array_eltype(res));
//Rprintf("type elt=%s,%s\n",aryTy,(char*)jl_typeof_str(jl_array_eltype(res)));
if(strcmp(aryTy2,"DataType")!=0) return R_NilValue;
if(strcmp(aryTy,"ASCIIString")==0 || strcmp(aryTy,"UTF8String")==0) aryTyR=STRSXP;
else if(strcmp(aryTy,"Int64")==0 || strcmp(aryTy,"Int32")==0) aryTyR=INTSXP;
else if(strcmp(aryTy,"Bool")==0) aryTyR=LGLSXP;
else if(strcmp(aryTy,"Complex")==0) aryTyR=CPLXSXP;
else if(strcmp(aryTy,"Float64")==0 || strcmp(aryTy,"Float32")==0) aryTyR=REALSXP;
else aryTyR=VECSXP;
if(nd==1) {//Vector
d = jl_array_size(res, 0);
//Rprintf("array_dim[1]=%d\n",(int)d);
PROTECT(resR=allocVector(aryTyR,d));
for(i=0;i<d;i++) {
switch(aryTyR) {
case STRSXP:
SET_STRING_ELT(resR,i,mkChar(jl_bytestring_ptr(jl_arrayref((jl_array_t *)res,i))));
break;
case INTSXP:
INTEGER(resR)[i]=jl_unbox_long(jl_arrayref((jl_array_t *)res,i));
break;
case LGLSXP:
LOGICAL(resR)[i]=(jl_unbox_bool(jl_arrayref((jl_array_t *)res,i)) ? TRUE : FALSE);
break;
case REALSXP:
REAL(resR)[i]=jl_unbox_float64(jl_arrayref((jl_array_t *)res,i));
break;
case CPLXSXP:
tmp=(jl_value_t*)jl_get_field(jl_arrayref((jl_array_t *)res,i), "re");
if(strcmp(jl_typeof_str(tmp),"Float64")==0) {
COMPLEX(resR)[i].r=jl_unbox_float64(tmp);
COMPLEX(resR)[i].i=jl_unbox_float64(jl_get_field(jl_arrayref((jl_array_t *)res,i), "im"));
} else if(strcmp(jl_typeof_str(tmp),"Int64")==0) {
COMPLEX(resR)[i].r=jl_unbox_long(tmp);
COMPLEX(resR)[i].i=jl_unbox_long(jl_get_field(jl_arrayref((jl_array_t *)res,i), "im"));
}
break;
case VECSXP:
SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_arrayref((jl_array_t *)res,i)));
}
}
UNPROTECT(1);
return resR;
}
//TODO: multidim array ruby equivalent???? Is it necessary
}
return R_NilValue;
/*PROTECT(resR=NEW_CHARACTER(1));
CHARACTER_POINTER(resR)[0]=mkChar(jl_typeof_str(res));
// resR=rb_str_new2("__unconverted(");
// rb_str_cat2(resR, jl_typeof_str(res));
// rb_str_cat2(resR, ")__\n");
UNPROTECT(1);
//printf("%s\n",jl_bytestring_ptr(jl_eval_string("\"$(ans)\"")));
return resR;*/
}
//=> No result (command incomplete or syntax error)
// jlapi_print_stderr(); //If this happens but this is really not sure!
// resR=rb_str_new2("__incomplete");
// if(jl_exception_occurred()!=NULL) {
// rb_str_cat2(resR, "(");
// rb_str_cat2(resR,jl_typeof_str(jl_exception_occurred()));
// jl_value_t* err=jl_get_field(jl_exception_occurred(),"msg");
// if(err!=NULL) printf("%s: %s\n",jl_typeof_str(jl_exception_occurred()),jl_bytestring_ptr(err));
// jl_exception_clear();
// rb_str_cat2(resR, ")");
// }
// rb_str_cat2(resR, "__");
return R_NilValue;//resR;
}
JL_DLLEXPORT jl_array_t *jl_reshape_array(jl_value_t *atype, jl_array_t *data,
jl_value_t *_dims)
{
jl_ptls_t ptls = jl_get_ptls_states();
jl_array_t *a;
size_t ndims = jl_nfields(_dims);
assert(is_ntuple_long(_dims));
size_t *dims = (size_t*)_dims;
assert(jl_types_equal(jl_tparam0(jl_typeof(data)), jl_tparam0(atype)));
int ndimwords = jl_array_ndimwords(ndims);
int tsz = JL_ARRAY_ALIGN(sizeof(jl_array_t) + ndimwords * sizeof(size_t) + sizeof(void*), JL_SMALL_BYTE_ALIGNMENT);
a = (jl_array_t*)jl_gc_alloc(ptls, tsz, atype);
// No allocation or safepoint allowed after this
a->flags.pooled = tsz <= GC_MAX_SZCLASS;
a->flags.ndims = ndims;
a->offset = 0;
a->data = NULL;
a->flags.isaligned = data->flags.isaligned;
jl_array_t *owner = (jl_array_t*)jl_array_owner(data);
jl_value_t *eltype = jl_tparam0(atype);
size_t elsz = 0, align = 0;
int isboxed = !jl_islayout_inline(eltype, &elsz, &align);
assert(isboxed == data->flags.ptrarray);
if (!isboxed) {
a->elsize = elsz;
jl_value_t *ownerty = jl_typeof(owner);
size_t oldelsz = 0, oldalign = 0;
if (ownerty == (jl_value_t*)jl_string_type) {
oldalign = 1;
}
else {
jl_islayout_inline(jl_tparam0(ownerty), &oldelsz, &oldalign);
}
if (oldalign < align)
jl_exceptionf(jl_argumenterror_type,
"reinterpret from alignment %d bytes to alignment %d bytes not allowed",
(int) oldalign, (int) align);
a->flags.ptrarray = 0;
}
else {
a->elsize = sizeof(void*);
a->flags.ptrarray = 1;
}
// if data is itself a shared wrapper,
// owner should point back to the original array
jl_array_data_owner(a) = (jl_value_t*)owner;
a->flags.how = 3;
a->data = data->data;
a->flags.isshared = 1;
data->flags.isshared = 1;
if (ndims == 1) {
size_t l = 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 (size_t i = 0; i < ndims; i++) {
adims[i] = 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
}
return a;
}
// --- parse :sym or (:sym, :lib) argument into address info ---
static native_sym_arg_t interpret_symbol_arg(jl_value_t *arg, jl_codectx_t *ctx, const char *fname)
{
jl_value_t *ptr = NULL;
Value *jl_ptr=NULL;
ptr = static_eval(arg, ctx, true);
if (ptr == NULL) {
jl_value_t *ptr_ty = expr_type(arg, ctx);
Value *arg1 = emit_unboxed(arg, ctx);
if (!jl_is_cpointer_type(ptr_ty)) {
emit_cpointercheck(arg1,
!strcmp(fname,"ccall") ?
"ccall: first argument not a pointer or valid constant expression" :
"cglobal: first argument not a pointer or valid constant expression",
ctx);
}
jl_ptr = emit_unbox(T_size, arg1, (jl_value_t*)jl_voidpointer_type);
}
void *fptr=NULL;
char *f_name=NULL, *f_lib=NULL;
jl_value_t *t0 = NULL, *t1 = NULL;
JL_GC_PUSH3(&ptr, &t0, &t1);
if (ptr != NULL) {
if (jl_is_tuple(ptr) && jl_nfields(ptr)==1) {
ptr = jl_fieldref(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
// will look in process symbol table
#ifdef _OS_WINDOWS_
f_lib = jl_dlfind_win32(f_name);
#endif
}
else if (jl_is_cpointer_type(jl_typeof(ptr))) {
fptr = *(void**)jl_data_ptr(ptr);
}
else if (jl_is_tuple(ptr) && jl_nfields(ptr)>1) {
jl_value_t *t0 = jl_fieldref(ptr,0);
jl_value_t *t1 = jl_fieldref(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_TYPECHKS(fname, 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_TYPECHKS(fname, symbol, t1);
}
else {
JL_TYPECHKS(fname, pointer, ptr);
}
}
JL_GC_POP();
native_sym_arg_t r;
r.jl_ptr = jl_ptr;
r.fptr = fptr;
r.f_name = f_name;
r.f_lib = f_lib;
return r;
}
jl_array_t *jl_ptr_to_array(jl_value_t *atype, void *data, jl_value_t *dims,
int own_buffer)
{
size_t i, elsz, nel=1;
jl_array_t *a;
size_t ndims = jl_nfields(dims);
wideint_t prod;
for(i=0; i < ndims; i++) {
prod = (wideint_t)nel * (wideint_t)jl_unbox_long(jl_fieldref(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);
int tsz = JL_ARRAY_ALIGN(sizeof(jl_array_t) + ndimwords*sizeof(size_t), 16);
a = (jl_array_t*)jl_gc_allocobj(tsz);
jl_set_typeof(a, atype);
a->pooled = tsz <= GC_MAX_SZCLASS;
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);
jl_gc_count_allocd(nel*elsz + (elsz == 1 ? 1 : 0));
}
else {
a->how = 0;
}
if (ndims == 1) {
a->nrows = nel;
a->maxsize = nel;
}
else {
size_t *adims = &a->nrows;
// jl_fieldref can allocate
JL_GC_PUSH1(&a);
for(i=0; i < ndims; i++) {
adims[i] = jl_unbox_long(jl_fieldref(dims, i));
}
JL_GC_POP();
}
return a;
}
jl_array_t *jl_reshape_array(jl_value_t *atype, jl_array_t *data, jl_value_t *dims)
{
size_t i;
jl_array_t *a;
size_t ndims = jl_nfields(dims);
int ndimwords = jl_array_ndimwords(ndims);
int tsz = JL_ARRAY_ALIGN(sizeof(jl_array_t) + ndimwords*sizeof(size_t) + sizeof(void*), 16);
a = (jl_array_t*)jl_gc_allocobj(tsz);
jl_set_typeof(a, atype);
a->pooled = tsz <= GC_MAX_SZCLASS;
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_t *owner = data;
// if data is itself a shared wrapper,
// owner should point back to the original array
if (owner->how == 3) {
owner = (jl_array_t*)jl_array_data_owner(owner);
}
assert(owner->how != 3);
jl_array_data_owner(a) = (jl_value_t*)owner;
a->how = 3;
a->data = data->data;
a->isshared = 1;
data->isshared = 1;
if (ndims == 1) {
size_t l = ((size_t*)jl_data_ptr(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] = ((size_t*)jl_data_ptr(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;
}