diff --git a/runtime/bigarray.c b/runtime/bigarray.c index ffea5947febe..ffb906a04bb7 100644 --- a/runtime/bigarray.c +++ b/runtime/bigarray.c @@ -277,6 +277,34 @@ CAMLexport value caml_ba_alloc_dims(int flags, int num_dims, void * data, ...) return res; } +/* Same as caml_ba_alloc, but the data is shared with another bigarray, + so the size of the data must not be counted again, otherwise the + GC works too hard. */ + +static value +caml_ba_sub_alloc(int flags, int num_dims, void * data, intnat * dim) +{ + uintnat asize; + int i; + value res; + struct caml_ba_array * b; + intnat dimcopy[CAML_BA_MAX_NUM_DIMS]; + + CAMLassert(num_dims >= 0 && num_dims <= CAML_BA_MAX_NUM_DIMS); + CAMLassert((flags & CAML_BA_KIND_MASK) < CAML_BA_FIRST_UNIMPLEMENTED_KIND); + CAMLassert(data != NULL); + for (i = 0; i < num_dims; i++) dimcopy[i] = dim[i]; + asize = SIZEOF_BA_ARRAY + num_dims * sizeof(intnat); + res = caml_alloc_custom_mem(&caml_ba_ops, asize, 0); + b = Caml_ba_array_val(res); + b->data = data; + b->num_dims = num_dims; + b->flags = flags; + b->proxy = NULL; + for (i = 0; i < num_dims; i++) b->dim[i] = dimcopy[i]; + return res; +} + /* Finalization of a big array */ CAMLexport void caml_ba_finalize(value v) @@ -1133,7 +1161,7 @@ CAMLprim value caml_ba_slice(value vb, value vind) (char *) b->data + offset * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK]; /* Allocate an OCaml bigarray to hold the result */ - res = caml_ba_alloc(b->flags, b->num_dims - num_inds, sub_data, sub_dims); + res = caml_ba_sub_alloc(b->flags, b->num_dims - num_inds, sub_data, sub_dims); /* Copy the finalization function from the original array (PR#8568) */ Custom_ops_val(res) = Custom_ops_val(vb); /* Create or update proxy in case of managed bigarray */ @@ -1160,7 +1188,7 @@ CAMLprim value caml_ba_change_layout(value vb, value vlayout) intnat new_dim[CAML_BA_MAX_NUM_DIMS]; unsigned int i; for(i = 0; i < b->num_dims; i++) new_dim[i] = b->dim[b->num_dims - i - 1]; - res = caml_ba_alloc(flags, b->num_dims, b->data, new_dim); + res = caml_ba_sub_alloc(flags, b->num_dims, b->data, new_dim); /* Copy the finalization function from the original array (PR#8568) */ Custom_ops_val(res) = Custom_ops_val(vb); caml_ba_update_proxy(b, Caml_ba_array_val(res)); @@ -1205,7 +1233,7 @@ CAMLprim value caml_ba_sub(value vb, value vofs, value vlen) (char *) b->data + ofs * mul * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK]; /* Allocate an OCaml bigarray to hold the result */ - res = caml_ba_alloc(b->flags, b->num_dims, sub_data, b->dim); + res = caml_ba_sub_alloc(b->flags, b->num_dims, sub_data, b->dim); /* Copy the finalization function from the original array (PR#8568) */ Custom_ops_val(res) = Custom_ops_val(vb); /* Doctor the changed dimension */ @@ -1388,7 +1416,7 @@ CAMLprim value caml_ba_reshape(value vb, value vdim) if (num_elts != caml_ba_num_elts(b)) caml_invalid_argument("Bigarray.reshape: size mismatch"); /* Create bigarray with same data and new dimensions */ - res = caml_ba_alloc(b->flags, num_dims, b->data, dim); + res = caml_ba_sub_alloc(b->flags, num_dims, b->data, dim); /* Copy the finalization function from the original array (PR#8568) */ Custom_ops_val(res) = Custom_ops_val(vb); /* Create or update proxy in case of managed bigarray */