Beispiel #1
0
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)
    }
Beispiel #2
0
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)
    }
Beispiel #3
0
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);
}
Beispiel #4
0
			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());
			}
Beispiel #5
0
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;
}
Beispiel #6
0
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;
}
Beispiel #7
0
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);
}
Beispiel #8
0
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;
}
Beispiel #9
0
Datei: jl4R.c Projekt: rcqls/jl4R
//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;
}
Beispiel #10
0
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;
}
Beispiel #11
0
// --- 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;
}
Beispiel #12
0
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;
}
Beispiel #13
0
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;
}