Beispiel #1
0
// own_buffer != 0 iff GC should call free() on this pointer eventually
JL_DLLEXPORT jl_array_t *jl_ptr_to_array_1d(jl_value_t *atype, void *data,
                                            size_t nel, int own_buffer)
{
    jl_ptls_t ptls = jl_get_ptls_states();
    jl_array_t *a;
    jl_value_t *eltype = jl_tparam0(atype);

    int isunboxed = jl_array_store_unboxed(eltype);
    size_t elsz;
    unsigned align;
    if (isunboxed && jl_is_uniontype(eltype))
        jl_exceptionf(jl_argumenterror_type,
                      "unsafe_wrap: unspecified layout for union element type");
    if (isunboxed) {
        elsz = jl_datatype_size(eltype);
        align = jl_datatype_align(eltype);
    }
    else {
        align = elsz = sizeof(void*);
    }
    if (((uintptr_t)data) & (align - 1))
        jl_exceptionf(jl_argumenterror_type,
                      "unsafe_wrap: pointer %p is not properly aligned to %u bytes", data, align);

    int ndimwords = jl_array_ndimwords(1);
    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 = 1;
    a->flags.isshared = 1;
    a->flags.isaligned = 0;  // TODO: allow passing memalign'd buffers
    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;
    }

    a->nrows = nel;
    a->maxsize = nel;
    a->offset = 0;
    return a;
}
Beispiel #2
0
static jl_sym_t *mk_symbol(const char *str, size_t len)
{
    jl_sym_t *sym;
    size_t nb = symbol_nbytes(len);

    if (nb >= SYM_POOL_SIZE) {
        jl_exceptionf(jl_argumenterror_type, "Symbol length exceeds maximum length");
    }

    jl_taggedvalue_t *tag;
#ifdef MEMDEBUG
    tag = (jl_taggedvalue_t*)malloc(nb);
#else
    static char *sym_pool = NULL;
    static char *pool_ptr = NULL;
    if (sym_pool == NULL || pool_ptr+nb > sym_pool+SYM_POOL_SIZE) {
        sym_pool = (char*)malloc(SYM_POOL_SIZE);
        pool_ptr = sym_pool;
    }
    tag = (jl_taggedvalue_t*)pool_ptr;
    pool_ptr += nb;
#endif
    sym = (jl_sym_t*)jl_valueof(tag);
    // set to old marked since we don't need write barrier on it.
    tag->header = ((uintptr_t)jl_sym_type) | GC_OLD_MARKED;
    sym->left = sym->right = NULL;
    sym->hash = hash_symbol(str, len);
    memcpy(jl_symbol_name(sym), str, len);
    jl_symbol_name(sym)[len] = 0;
    return sym;
}
Beispiel #3
0
JL_DLLEXPORT void JL_NORETURN jl_eof_error(void)
{
    jl_datatype_t *eof_error =
        (jl_datatype_t*)jl_get_global(jl_base_module, jl_symbol("EOFError"));
    assert(eof_error != NULL);
    jl_exceptionf(eof_error, "");
}
Beispiel #4
0
static jl_sym_t *mk_symbol(const char *str, size_t len)
{
#ifndef MEMDEBUG
    static char *sym_pool = NULL;
    static char *pool_ptr = NULL;
#endif
    jl_sym_t *sym;
    size_t nb = symbol_nbytes(len);

    if (nb >= SYM_POOL_SIZE) {
        jl_exceptionf(jl_argumenterror_type, "Symbol length exceeds maximum length");
    }

#ifdef MEMDEBUG
    sym = (jl_sym_t*)jl_valueof(malloc(nb));
#else
    if (sym_pool == NULL || pool_ptr+nb > sym_pool+SYM_POOL_SIZE) {
        sym_pool = (char*)malloc(SYM_POOL_SIZE);
        pool_ptr = sym_pool;
    }
    sym = (jl_sym_t*)jl_valueof(pool_ptr);
    pool_ptr += nb;
#endif
    jl_set_typeof(sym, jl_sym_type);
    sym->left = sym->right = NULL;
    sym->hash = hash_symbol(str, len);
    memcpy(jl_symbol_name(sym), str, len);
    jl_symbol_name(sym)[len] = 0;
    return sym;
}
Beispiel #5
0
static jl_sym_t *mk_symbol(const char *str)
{
#ifndef MEMDEBUG
    static char *sym_pool = NULL;
    static char *pool_ptr = NULL;
#endif
    jl_sym_t *sym;
    size_t len = strlen(str);
    size_t nb = (sizeof(jl_taggedvalue_t)+sizeof(jl_sym_t)+len+1+7)&-8;

    if (nb >= SYM_POOL_SIZE) {
        jl_exceptionf(jl_argumenterror_type, "Symbol length exceeds maximum length");
    }

#ifdef MEMDEBUG
    sym = (jl_sym_t*)&((jl_taggedvalue_t*)malloc(nb))->value;
#else
    if (sym_pool == NULL || pool_ptr+nb > sym_pool+SYM_POOL_SIZE) {
        sym_pool = (char*)malloc(SYM_POOL_SIZE);
        pool_ptr = sym_pool;
    }
    sym = (jl_sym_t*)&((jl_taggedvalue_t*)pool_ptr)->value;
    pool_ptr += nb;
#endif
    jl_set_typeof(sym, jl_sym_type);
    sym->left = sym->right = NULL;
    sym->hash = hash_symbol(str, len);
    strcpy(&sym->name[0], str);
    return sym;
}
Beispiel #6
0
DLLEXPORT jl_sym_t *jl_symbol_n(const char *str, int32_t len)
{
    char *name = (char*)alloca(len+1);
    memcpy(name, str, len);
    name[len] = '\0';
    if (strlen(name) != len)
        jl_exceptionf(jl_argumenterror_type, "Symbol name may not contain \\0");
    return jl_symbol(name);
}
Beispiel #7
0
JL_DLLEXPORT jl_sym_t *jl_tagged_gensym(const char *str, int32_t len)
{
    char gs_name[14];
    if (symbol_nbytes(len) >= SYM_POOL_SIZE)
        jl_exceptionf(jl_argumenterror_type, "Symbol length exceeds maximum");
    if (memchr(str, 0, len))
        jl_exceptionf(jl_argumenterror_type, "Symbol name may not contain \\0");
    char *name = (char*) (len >= 256 ? malloc(sizeof(gs_name)+len+3) :
                          alloca(sizeof(gs_name)+len+3));
    char *n;
    name[0] = '#'; name[1] = '#'; name[2+len] = '#';
    memcpy(name+2, str, len);
    n = uint2str(gs_name, sizeof(gs_name), gs_ctr, 10);
    memcpy(name+3+len, n, sizeof(gs_name)-(n-gs_name));
    gs_ctr++;
    jl_sym_t *sym = _jl_symbol(name, len+3+sizeof(gs_name)-(n-gs_name)-1);
    if (len >= 256) free(name);
    return sym;
}
Beispiel #8
0
DLLEXPORT jl_sym_t *jl_tagged_gensym(const char *str, int32_t len)
{
    static char gs_name[14];
    char *name = (char*)alloca(sizeof(gs_name)+len+3);
    char *n;
    name[0] = '#'; name[1] = '#'; name[2+len] = '#';
    memcpy(name+2, str, len);
    n = uint2str(gs_name, sizeof(gs_name), gs_ctr, 10);
    memcpy(name+3+len, n, sizeof(gs_name)-(n-gs_name));
    if (strlen(name) != len+3+sizeof(gs_name)-(n-gs_name)-1)
        jl_exceptionf(jl_argumenterror_type, "Symbol name may not contain \\0");
    gs_ctr++;
    return jl_symbol(name);
}
Beispiel #9
0
JL_DLLEXPORT jl_sym_t *jl_symbol_n(const char *str, int32_t len)
{
    if (memchr(str, 0, len))
        jl_exceptionf(jl_argumenterror_type, "Symbol name may not contain \\0");
    return _jl_symbol(str, len);
}
Beispiel #10
0
JL_DLLEXPORT void JL_NORETURN jl_too_few_args(const char *fname, int min)
{
    jl_exceptionf(jl_argumenterror_type, "%s: too few arguments (expected %d)", fname, min);
}
Beispiel #11
0
JL_DLLEXPORT void JL_NORETURN jl_too_many_args(const char *fname, int max)
{
    jl_exceptionf(jl_argumenterror_type, "%s: too many arguments (expected %d)", fname, max);
}
Beispiel #12
0
DLLEXPORT jl_value_t *jl_method_def(jl_sym_t *name, jl_value_t **bp, jl_value_t *bp_owner,
                                    jl_binding_t *bnd,
                                    jl_svec_t *argdata, jl_function_t *f, jl_value_t *isstaged,
                                    jl_value_t *call_func, int iskw)
{
    jl_module_t *module = (bnd ? bnd->owner : NULL);
    // argdata is svec({types...}, svec(typevars...))
    jl_tupletype_t *argtypes = (jl_tupletype_t*)jl_svecref(argdata,0);
    jl_svec_t *tvars = (jl_svec_t*)jl_svecref(argdata,1);
    jl_value_t *gf = NULL;
    JL_GC_PUSH4(&gf, &tvars, &argtypes, &f);

    if (bnd && bnd->value != NULL && !bnd->constp) {
        jl_errorf("cannot define function %s; it already has a value", bnd->name->name);
    }

    if (*bp != NULL) {
        gf = *bp;
        if (!jl_is_gf(gf)) {
            if (jl_is_datatype(gf)) {
                // DataType: define `call`, for backwards compat with outer constructors
                if (call_func == NULL)
                    call_func = (jl_value_t*)jl_module_call_func(jl_current_module);
                size_t na = jl_nparams(argtypes);
                jl_svec_t *newargtypes = jl_alloc_svec(1 + na);
                jl_lambda_info_t *new_linfo = NULL;
                JL_GC_PUSH2(&newargtypes, &new_linfo);
                new_linfo = jl_copy_lambda_info(f->linfo);
                f = jl_new_closure(f->fptr, f->env, new_linfo);
                size_t i=0;
                if (iskw) {
                    assert(na > 0);
                    // for kw sorter, keep container argument first
                    jl_svecset(newargtypes, 0, jl_tparam(argtypes, 0));
                    i++;
                }
                jl_svecset(newargtypes, i, jl_wrap_Type(gf));
                i++;
                for(; i < na+1; i++) {
                    jl_svecset(newargtypes, i, jl_tparam(argtypes, i-1));
                }
                argtypes = jl_apply_tuple_type(newargtypes);
                JL_GC_POP();
                gf = call_func;
                name = call_sym;
                // edit args, insert type first
                if (!jl_is_expr(f->linfo->ast)) {
                    f->linfo->ast = jl_uncompress_ast(f->linfo, f->linfo->ast);
                    jl_gc_wb(f->linfo, f->linfo->ast);
                }
                else {
                    // Do not mutate the original ast since it might
                    // be reused somewhere else
                    f->linfo->ast = jl_copy_ast(f->linfo->ast);
                    jl_gc_wb(f->linfo, f->linfo->ast);
                }
                jl_array_t *al = jl_lam_args((jl_expr_t*)f->linfo->ast);
                if (jl_array_len(al) == 0) {
                    al = jl_alloc_cell_1d(1);
                    jl_exprargset(f->linfo->ast, 0, (jl_value_t*)al);
                }
                else {
                    jl_array_grow_beg(al, 1);
                }
                if (iskw) {
                    jl_cellset(al, 0, jl_cellref(al, 1));
                    jl_cellset(al, 1, (jl_value_t*)jl_gensym());
                }
                else {
                    jl_cellset(al, 0, (jl_value_t*)jl_gensym());
                }
            }
            if (!jl_is_gf(gf)) {
                jl_errorf("cannot define function %s; it already has a value", name->name);
            }
        }
        if (iskw) {
            jl_methtable_t *mt = jl_gf_mtable(gf);
            assert(!module);
            module = mt->module;
            bp = (jl_value_t**)&mt->kwsorter;
            bp_owner = (jl_value_t*)mt;
            gf = *bp;
        }
    }

    // TODO
    size_t na = jl_nparams(argtypes);
    for(size_t i=0; i < na; i++) {
        jl_value_t *elt = jl_tparam(argtypes,i);
        if (!jl_is_type(elt) && !jl_is_typevar(elt)) {
            jl_lambda_info_t *li = f->linfo;
            jl_exceptionf(jl_argumenterror_type, "invalid type for argument %s in method definition for %s at %s:%d",
                          jl_lam_argname(li,i)->name, name->name, li->file->name, li->line);
        }
    }

    int ishidden = !!strchr(name->name, '#');
    for(size_t i=0; i < jl_svec_len(tvars); i++) {
        jl_value_t *tv = jl_svecref(tvars,i);
        if (!jl_is_typevar(tv))
            jl_type_error_rt(name->name, "method definition", (jl_value_t*)jl_tvar_type, tv);
        if (!ishidden && !type_contains((jl_value_t*)argtypes, tv)) {
            jl_printf(JL_STDERR, "WARNING: static parameter %s does not occur in signature for %s",
                      ((jl_tvar_t*)tv)->name->name, name->name);
            print_func_loc(JL_STDERR, f->linfo);
            jl_printf(JL_STDERR, ".\nThe method will not be callable.\n");
        }
    }

    if (bnd) {
        bnd->constp = 1;
    }
    if (*bp == NULL) {
        gf = (jl_value_t*)jl_new_generic_function(name, module);
        *bp = gf;
        if (bp_owner) jl_gc_wb(bp_owner, gf);
    }
    assert(jl_is_function(f));
    assert(jl_is_tuple_type(argtypes));
    assert(jl_is_svec(tvars));

    jl_add_method((jl_function_t*)gf, argtypes, f, tvars, isstaged == jl_true);
    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_wb(li, li->ast);
    }
    JL_GC_POP();
    return gf;
}
Beispiel #13
0
DLLEXPORT jl_value_t *jl_method_def(jl_sym_t *name, jl_value_t **bp, jl_value_t *bp_owner,
                                    jl_binding_t *bnd,
                                    jl_tuple_t *argtypes, jl_function_t *f, jl_value_t *isstaged,
                                    jl_value_t *call_func, int iskw)
{
    // argtypes is a tuple ((types...), (typevars...))
    jl_tuple_t *t = (jl_tuple_t*)jl_t1(argtypes);
    argtypes = (jl_tuple_t*)jl_t0(argtypes);
    jl_value_t *gf=NULL;
    JL_GC_PUSH3(&gf, &argtypes, &t);

    if (bnd && bnd->value != NULL && !bnd->constp) {
        jl_errorf("cannot define function %s; it already has a value", bnd->name->name);
    }

    if (*bp != NULL) {
        gf = *bp;
        if (!jl_is_gf(gf)) {
            if (jl_is_datatype(gf)) {
                // DataType: define `call`, for backwards compat with outer constructors
                if (call_func == NULL)
                    call_func = (jl_value_t*)jl_module_call_func(jl_current_module);
                size_t na = jl_tuple_len(argtypes);
                jl_tuple_t *newargtypes = jl_alloc_tuple(1 + na);
                JL_GC_PUSH1(&newargtypes);
                size_t i=0;
                if (iskw) {
                    assert(na > 0);
                    // for kw sorter, keep container argument first
                    jl_tupleset(newargtypes, 0, jl_tupleref(argtypes, 0));
                    i++;
                }
                jl_tupleset(newargtypes, i, jl_wrap_Type(gf));
                i++;
                for(; i < na+1; i++) {
                    jl_tupleset(newargtypes, i, jl_tupleref(argtypes, i-1));
                }
                argtypes = newargtypes;
                JL_GC_POP();
                gf = call_func;
                name = call_sym;
                // edit args, insert type first
                if (!jl_is_expr(f->linfo->ast)) {
                    f->linfo->ast = jl_uncompress_ast(f->linfo, f->linfo->ast);
                    gc_wb(f->linfo, f->linfo->ast);
                }
                jl_array_t *al = jl_lam_args((jl_expr_t*)f->linfo->ast);
                if (jl_array_len(al) == 0) {
                    al = jl_alloc_cell_1d(1);
                    jl_exprargset(f->linfo->ast, 0, (jl_value_t*)al);
                }
                else {
                    jl_array_grow_beg(al, 1);
                }
                if (iskw) {
                    jl_cellset(al, 0, jl_cellref(al, 1));
                    jl_cellset(al, 1, (jl_value_t*)jl_gensym());
                }
                else {
                    jl_cellset(al, 0, (jl_value_t*)jl_gensym());
                }
            }
            if (!jl_is_gf(gf)) {
                jl_errorf("cannot define function %s; it already has a value", name->name);
            }
        }
        if (iskw) {
            bp = (jl_value_t**)&((jl_methtable_t*)((jl_function_t*)gf)->env)->kwsorter;
            bp_owner = (jl_value_t*)((jl_function_t*)gf)->env;
            gf = *bp;
        }
    }

    size_t na = jl_tuple_len(argtypes);
    for(size_t i=0; i < na; i++) {
        jl_value_t *elt = jl_tupleref(argtypes,i);
        if (!jl_is_type(elt) && !jl_is_typevar(elt)) {
            jl_lambda_info_t *li = f->linfo;
            jl_exceptionf(jl_argumenterror_type, "invalid type for argument %s in method definition for %s at %s:%d",
                          jl_lam_argname(li,i)->name, name->name, li->file->name, li->line);
        }
    }

    int ishidden = !!strchr(name->name, '#');
    for(size_t i=0; i < jl_tuple_len(t); i++) {
        jl_value_t *tv = jl_tupleref(t,i);
        if (!jl_is_typevar(tv))
            jl_type_error_rt(name->name, "method definition", (jl_value_t*)jl_tvar_type, tv);
        if (!ishidden && !type_contains((jl_value_t*)argtypes, tv)) {
            jl_printf(JL_STDERR, "Warning: static parameter %s does not occur in signature for %s",
                      ((jl_tvar_t*)tv)->name->name, name->name);
            print_func_loc(JL_STDERR, f->linfo);
            jl_printf(JL_STDERR, ".\nThe method will not be callable.\n");
        }
    }

    if (bnd) {
        bnd->constp = 1;
    }
    if (*bp == NULL) {
        gf = (jl_value_t*)jl_new_generic_function(name);
        *bp = gf;
        if (bp_owner) gc_wb(bp_owner, gf);
    }
    assert(jl_is_function(f));
    assert(jl_is_tuple(argtypes));
    assert(jl_is_tuple(t));

    jl_add_method((jl_function_t*)gf, argtypes, f, t, isstaged == jl_true);
    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);
        gc_wb(li, li->ast);
    }
    JL_GC_POP();
    return gf;
}
Beispiel #14
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 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 *eltype = jl_tparam0(atype);

    int isunboxed = jl_array_store_unboxed(eltype);
    size_t elsz;
    unsigned align;
    if (isunboxed && jl_is_uniontype(eltype))
        jl_exceptionf(jl_argumenterror_type,
                      "unsafe_wrap: unspecified layout for union element type");
    if (isunboxed) {
        elsz = jl_datatype_size(eltype);
        align = jl_datatype_align(eltype);
    }
    else {
        align = elsz = sizeof(void*);
    }
    if (((uintptr_t)data) & (align - 1))
        jl_exceptionf(jl_argumenterror_type,
                      "unsafe_wrap: pointer %p is not properly aligned to %u bytes", data, align);

    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 #15
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;
}