/* alloc */
value bap_disasm_reg_table_stub(value d) {
CAMLparam1(d);
intnat dims[1];
dims[0] = bap_disasm_reg_table_size(Int_val(d));
CAMLreturn(caml_ba_alloc(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1,
(void *)bap_disasm_reg_table_ptr(Int_val(d)), dims));
}
CAMLprim value caml_ba_reshape(value vb, value vdim)
{
CAMLparam2 (vb, vdim);
CAMLlocal1 (res);
#define b ((struct caml_ba_array *) Caml_ba_array_val(vb))
intnat dim[CAML_BA_MAX_NUM_DIMS];
mlsize_t num_dims;
uintnat num_elts;
int i;
num_dims = Wosize_val(vdim);
if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
caml_invalid_argument("Bigarray.reshape: bad number of dimensions");
num_elts = 1;
for (i = 0; i < num_dims; i++) {
dim[i] = Long_val(Field(vdim, i));
if (dim[i] < 0)
caml_invalid_argument("Bigarray.reshape: negative dimension");
num_elts *= dim[i];
}
/* Check that sizes agree */
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);
/* Create or update proxy in case of managed bigarray */
caml_ba_update_proxy(b, Caml_ba_array_val(res));
/* Return result */
CAMLreturn (res);
#undef b
}
CAMLprim value
caml_SDL_Surface_ba_get_pixels(value surface)
{
SDL_Surface *surf = SDL_Surface_val(surface);
Uint8 bpp = surf->format->BitsPerPixel;
int b_flag = 0;
long dim = surf->h;
switch (bpp) {
case 8:
dim *= surf->pitch;
b_flag |= CAML_BA_UINT8; break;
case 16:
dim *= surf->pitch / 2;
b_flag |= CAML_BA_UINT16; break;
case 24:
dim *= surf->pitch;
b_flag |= CAML_BA_UINT8; break;
case 32:
dim *= surf->pitch / 4;
b_flag |= CAML_BA_INT32; break;
case 64:
dim *= surf->pitch / 8;
b_flag |= CAML_BA_INT64; break;
default:
caml_failwith("Sdlsurface_ba.get_pixels");
}
b_flag |= CAML_BA_C_LAYOUT | CAML_BA_EXTERNAL ;
return caml_ba_alloc(b_flag, 1, surf->pixels, &dim);
}
/* Adapted from sundials-2.5.0/src/nvec_par/nvector_parallel.c:
N_VCloneEmpty_Parallel */
static N_Vector clone_parallel(N_Vector w)
{
CAMLparam0();
CAMLlocal2(v_payload, w_payload);
N_Vector v;
N_VectorContent_Parallel content;
if (w == NULL) CAMLreturnT (N_Vector, NULL);
w_payload = NVEC_BACKLINK(w);
struct caml_ba_array *w_ba = Caml_ba_array_val(Field(w_payload, 0));
/* Create vector (we need not copy the data) */
v_payload = caml_alloc_tuple(3);
Store_field(v_payload, 0,
caml_ba_alloc(w_ba->flags, w_ba->num_dims, NULL, w_ba->dim));
Store_field(v_payload, 1, Field(w_payload, 1));
Store_field(v_payload, 2, Field(w_payload, 2));
v = sunml_alloc_cnvec(sizeof(struct _N_VectorContent_Parallel), v_payload);
if (v == NULL) CAMLreturnT (N_Vector, NULL);
content = (N_VectorContent_Parallel) v->content;
/* Create vector operation structure */
sunml_clone_cnvec_ops(v, w);
/* Attach lengths and communicator */
content->local_length = NV_LOCLENGTH_P(w);
content->global_length = NV_GLOBLENGTH_P(w);
content->comm = NV_COMM_P(w);
content->own_data = 0;
content->data = Caml_ba_data_val(Field(v_payload, 0));
CAMLreturnT(N_Vector, v);
}
CAMLprim value bigstring_marshal_stub(value v, value v_flags)
{
char *buf;
long len;
int alloc_flags = CAML_BA_UINT8 | CAML_BA_C_LAYOUT | CAML_BA_MANAGED;
caml_output_value_to_malloc(v, v_flags, &buf, &len);
return caml_ba_alloc(alloc_flags, 1, buf, &len);
}
CAMLprim value
caml_xenstore_start_page(value v_unit)
{
CAMLparam1(v_unit);
CAMLlocal1(v_ret);
intnat dims[] = { PAGE_SIZE };
unsigned char *page = mfn_to_virt(start_info.store_mfn);
v_ret = caml_ba_alloc(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1, page, dims);
CAMLreturn(v_ret);
}
/* _view : ('a, 'b) kind -> dims:int array -> ptr ->
('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t */
value ctypes_bigarray_view(value kind_, value dims_, value ptr_)
{
int kind = Int_val(kind_);
int ndims = Wosize_val(dims_);
intnat dims[CAML_BA_MAX_NUM_DIMS];
int i;
for (i = 0; i < ndims; i++) {
dims[i] = Int_val(Field(dims_, i));
}
int flags = kind | CAML_BA_C_LAYOUT | CAML_BA_EXTERNAL;
void *data = CTYPES_TO_PTR(ptr_);
return caml_ba_alloc(flags, ndims, data, dims);
}
CAMLexport value caml_ba_alloc_dims(int flags, int num_dims, void * data, ...)
{
va_list ap;
intnat dim[CAML_BA_MAX_NUM_DIMS];
int i;
value res;
va_start(ap, data);
for (i = 0; i < num_dims; i++) dim[i] = va_arg(ap, intnat);
va_end(ap);
res = caml_ba_alloc(flags, num_dims, data, dim);
return res;
}
CAMLprim value ocaml_gstreamer_appsink_pull_buffer(value _as, value string_mode)
{
CAMLparam1(_as);
CAMLlocal1(ans);
appsink *as = Appsink_val(_as);
GstSample *gstsample;
GstBuffer *gstbuf;
GstMapInfo map;
intnat len;
gboolean ret;
caml_release_runtime_system();
gstsample = gst_app_sink_pull_sample(as->appsink);
caml_acquire_runtime_system();
if (!gstsample)
{
if (gst_app_sink_is_eos(as->appsink))
caml_raise_constant(*caml_named_value("gstreamer_exn_eos"));
else
caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
}
caml_release_runtime_system();
gstbuf = gst_sample_get_buffer(gstsample);
caml_acquire_runtime_system();
if (!gstbuf) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
caml_release_runtime_system();
ret = gst_buffer_map(gstbuf, &map, GST_MAP_READ);
caml_acquire_runtime_system();
if (!ret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
len = map.size;
if (string_mode == Val_false) {
ans = caml_ba_alloc(CAML_BA_C_LAYOUT | CAML_BA_UINT8, 1, NULL, &len);
memcpy(Caml_ba_data_val(ans), map.data, len);
} else {
ans = caml_alloc_string(len);
memcpy(String_val(ans), map.data, len);
}
caml_release_runtime_system();
gst_buffer_unmap(gstbuf, &map);
gst_sample_unref(gstsample);
caml_acquire_runtime_system();
CAMLreturn(ans);
}
value caml_ba_change_flags(value vb, value vkind, value vlen)
{
CAMLparam3 (vb, vkind, vlen);
CAMLlocal1 (res);
#define b ((struct caml_ba_array *) Caml_ba_array_val(vb))
int flags = Int_val(vkind) | CAML_BA_C_LAYOUT | CAML_BA_MANAGED;
intnat len = Long_val(vlen);
res = caml_ba_alloc(flags, b->num_dims, b->data, b->dim);
Caml_ba_array_val(res)->dim[0] = len;
caml_ba_update_proxy(b, Caml_ba_array_val(res));
CAMLreturn (res);
#undef b
}
CAMLprim value caml_ba_create(value vkind, value vlayout, value vdim)
{
intnat dim[CAML_BA_MAX_NUM_DIMS];
mlsize_t num_dims;
int i, flags;
num_dims = Wosize_val(vdim);
if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
caml_invalid_argument("Bigarray.create: bad number of dimensions");
for (i = 0; i < num_dims; i++) {
dim[i] = Long_val(Field(vdim, i));
if (dim[i] < 0)
caml_invalid_argument("Bigarray.create: negative dimension");
}
flags = Int_val(vkind) | Int_val(vlayout);
return caml_ba_alloc(flags, num_dims, NULL, dim);
}
/* Bigarray from string */
CAMLprim value caml_ba_from_string(value vkind, value vlayout, value vstr)
{
intnat dim[CAML_BA_MAX_NUM_DIMS];
mlsize_t num_dims;
int i, flags;
num_dims = 1;
if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
caml_invalid_argument("Bigarray.create: bad number of dimensions");
for (i = 0; i < num_dims; i++) {
dim[i] = caml_string_length(vstr);
if (dim[i] < 0)
caml_invalid_argument("Bigarray.create: negative dimension");
}
flags = Int_val(vkind) | Int_val(vlayout) | CAML_BA_EXTERNAL;
return caml_ba_alloc(flags, num_dims, String_val(vstr), dim);
}
CAMLprim value caml_ba_slice(value vb, value vind)
{
CAMLparam2 (vb, vind);
#define b ((struct caml_ba_array *) Caml_ba_array_val(vb))
CAMLlocal1 (res);
intnat index[CAML_BA_MAX_NUM_DIMS];
int num_inds, i;
intnat offset;
intnat * sub_dims;
char * sub_data;
/* Check number of indices < number of dimensions of array */
num_inds = Wosize_val(vind);
if (num_inds >= b->num_dims)
caml_invalid_argument("Bigarray.slice: too many indices");
/* Compute offset and check bounds */
if ((b->flags & CAML_BA_LAYOUT_MASK) == CAML_BA_C_LAYOUT) {
/* We slice from the left */
for (i = 0; i < num_inds; i++) index[i] = Long_val(Field(vind, i));
for (/*nothing*/; i < b->num_dims; i++) index[i] = 0;
offset = caml_ba_offset(b, index);
sub_dims = b->dim + num_inds;
} else {
/* We slice from the right */
for (i = 0; i < num_inds; i++)
index[b->num_dims - num_inds + i] = Long_val(Field(vind, i));
for (i = 0; i < b->num_dims - num_inds; i++) index[i] = 1;
offset = caml_ba_offset(b, index);
sub_dims = b->dim;
}
sub_data =
(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);
/* Create or update proxy in case of managed bigarray */
caml_ba_update_proxy(b, Caml_ba_array_val(res));
/* Return result */
CAMLreturn (res);
#undef b
}
CAMLexport value
bigstring_alloc (value v_gc_max_unused, value v_size)
{
intnat size = Long_val (v_size);
void * data = NULL;
int flags = CORE_BIGSTRING_FLAGS | CAML_BA_MANAGED;
intnat gc_max_unused = Long_val(v_gc_max_unused);
intnat dims[1];
dims[0] = size;
if (gc_max_unused >= 0) {
data = (void *) malloc(sizeof(char) * size);
if (NULL == data) caml_raise_out_of_memory ();
/* caml_adjust_gc_speed is also called by caml_ba_alloc below, but it will have
* numerator 0 when data != NULL. Effectively, that call will have no effect if this
* call is made. */
caml_adjust_gc_speed(size, gc_max_unused);
}
return caml_ba_alloc (flags, 1, data, dims);
}
CAMLprim value caml_ba_sub(value vb, value vofs, value vlen)
{
CAMLparam3 (vb, vofs, vlen);
CAMLlocal1 (res);
#define b ((struct caml_ba_array *) Caml_ba_array_val(vb))
intnat ofs = Long_val(vofs);
intnat len = Long_val(vlen);
int i, changed_dim;
intnat mul;
char * sub_data;
/* Compute offset and check bounds */
if ((b->flags & CAML_BA_LAYOUT_MASK) == CAML_BA_C_LAYOUT) {
/* We reduce the first dimension */
mul = 1;
for (i = 1; i < b->num_dims; i++) mul *= b->dim[i];
changed_dim = 0;
} else {
/* We reduce the last dimension */
mul = 1;
for (i = 0; i < b->num_dims - 1; i++) mul *= b->dim[i];
changed_dim = b->num_dims - 1;
ofs--; /* Fortran arrays start at 1 */
}
if (ofs < 0 || len < 0 || ofs + len > b->dim[changed_dim])
caml_invalid_argument("Bigarray.sub: bad sub-array");
sub_data =
(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);
/* Doctor the changed dimension */
Caml_ba_array_val(res)->dim[changed_dim] = len;
/* Create or update proxy in case of managed bigarray */
caml_ba_update_proxy(b, Caml_ba_array_val(res));
/* Return result */
CAMLreturn (res);
#undef b
}
CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
value vshared, value vdim, value vstart)
{
int fd, flags, major_dim, shared;
intnat num_dims, i;
intnat dim[CAML_BA_MAX_NUM_DIMS];
file_offset startpos, file_size, data_size;
struct stat st;
uintnat array_size, page, delta;
void * addr;
fd = Int_val(vfd);
flags = Int_val(vkind) | Int_val(vlayout);
startpos = File_offset_val(vstart);
num_dims = Wosize_val(vdim);
major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
/* Extract dimensions from OCaml array */
num_dims = Wosize_val(vdim);
if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
caml_invalid_argument("Bigarray.mmap: bad number of dimensions");
for (i = 0; i < num_dims; i++) {
dim[i] = Long_val(Field(vdim, i));
if (dim[i] == -1 && i == major_dim) continue;
if (dim[i] < 0)
caml_invalid_argument("Bigarray.create: negative dimension");
}
/* Determine file size. We avoid lseek here because it is fragile,
and because some mappable file types do not support it
*/
caml_enter_blocking_section();
if (fstat(fd, &st) == -1) {
caml_leave_blocking_section();
caml_sys_error(NO_ARG);
}
file_size = st.st_size;
/* Determine array size in bytes (or size of array without the major
dimension if that dimension wasn't specified) */
array_size = caml_ba_element_size[flags & CAML_BA_KIND_MASK];
for (i = 0; i < num_dims; i++)
if (dim[i] != -1) array_size *= dim[i];
/* Check if the major dimension is unknown */
if (dim[major_dim] == -1) {
/* Determine major dimension from file size */
if (file_size < startpos) {
caml_leave_blocking_section();
caml_failwith("Bigarray.mmap: file position exceeds file size");
}
data_size = file_size - startpos;
dim[major_dim] = (uintnat) (data_size / array_size);
array_size = dim[major_dim] * array_size;
if (array_size != data_size) {
caml_leave_blocking_section();
caml_failwith("Bigarray.mmap: file size doesn't match array dimensions");
}
} else {
/* Check that file is large enough, and grow it otherwise */
if (file_size < startpos + array_size) {
if (caml_grow_file(fd, startpos + array_size) == -1) { /* PR#5543 */
caml_leave_blocking_section();
caml_sys_error(NO_ARG);
}
}
}
/* Determine offset so that the mapping starts at the given file pos */
page = getpagesize();
delta = (uintnat) startpos % page;
/* Do the mmap */
shared = Bool_val(vshared) ? MAP_SHARED : MAP_PRIVATE;
if (array_size > 0)
addr = mmap(NULL, array_size + delta, PROT_READ | PROT_WRITE,
shared, fd, startpos - delta);
else
addr = NULL; /* PR#5463 - mmap fails on empty region */
caml_leave_blocking_section();
if (addr == (void *) MAP_FAILED) caml_sys_error(NO_ARG);
addr = (void *) ((uintnat) addr + delta);
/* Build and return the OCaml bigarray */
return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim);
}
CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
value vshared, value vdim, value vstart)
{
HANDLE fd, fmap;
int flags, major_dim, mode, perm;
intnat num_dims, i;
intnat dim[CAML_BA_MAX_NUM_DIMS];
__int64 currpos, startpos, file_size, data_size;
uintnat array_size, page, delta;
char c;
void * addr;
LARGE_INTEGER li;
SYSTEM_INFO sysinfo;
fd = Handle_val(vfd);
flags = Int_val(vkind) | Int_val(vlayout);
startpos = Int64_val(vstart);
num_dims = Wosize_val(vdim);
major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
/* Extract dimensions from OCaml array */
num_dims = Wosize_val(vdim);
if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
caml_invalid_argument("Bigarray.mmap: bad number of dimensions");
for (i = 0; i < num_dims; i++) {
dim[i] = Long_val(Field(vdim, i));
if (dim[i] == -1 && i == major_dim) continue;
if (dim[i] < 0)
caml_invalid_argument("Bigarray.create: negative dimension");
}
/* Determine file size */
currpos = caml_ba_set_file_pointer(fd, 0, FILE_CURRENT);
if (currpos == -1) caml_ba_sys_error();
file_size = caml_ba_set_file_pointer(fd, 0, FILE_END);
if (file_size == -1) caml_ba_sys_error();
/* Determine array size in bytes (or size of array without the major
dimension if that dimension wasn't specified) */
array_size = caml_ba_element_size[flags & CAML_BA_KIND_MASK];
for (i = 0; i < num_dims; i++)
if (dim[i] != -1) array_size *= dim[i];
/* Check if the first/last dimension is unknown */
if (dim[major_dim] == -1) {
/* Determine first/last dimension from file size */
if (file_size < startpos)
caml_failwith("Bigarray.mmap: file position exceeds file size");
data_size = file_size - startpos;
dim[major_dim] = (uintnat) (data_size / array_size);
array_size = dim[major_dim] * array_size;
if (array_size != data_size)
caml_failwith("Bigarray.mmap: file size doesn't match array dimensions");
}
/* Restore original file position */
caml_ba_set_file_pointer(fd, currpos, FILE_BEGIN);
/* Create the file mapping */
if (Bool_val(vshared)) {
perm = PAGE_READWRITE;
mode = FILE_MAP_WRITE;
} else {
perm = PAGE_READONLY; /* doesn't work under Win98 */
mode = FILE_MAP_COPY;
}
li.QuadPart = startpos + array_size;
fmap = CreateFileMapping(fd, NULL, perm, li.HighPart, li.LowPart, NULL);
if (fmap == NULL) caml_ba_sys_error();
/* Determine offset so that the mapping starts at the given file pos */
GetSystemInfo(&sysinfo);
delta = (uintnat) (startpos % sysinfo.dwAllocationGranularity);
/* Map the mapping in memory */
li.QuadPart = startpos - delta;
addr =
MapViewOfFile(fmap, mode, li.HighPart, li.LowPart, array_size + delta);
if (addr == NULL) caml_ba_sys_error();
addr = (void *) ((uintnat) addr + delta);
/* Close the file mapping */
CloseHandle(fmap);
/* Build and return the OCaml bigarray */
return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim);
}
static value to_bigarray(char *data, mlsize_t size) {
intnat array[] = { size };
return caml_ba_alloc(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1, data, array);
}
/* Here and in the generated .c files, we must put CAML_BA_EXTERNAL instead of
CAML_BA_MANAGED because the C string cannot be freed. */
CAMLprim value ocaml_plugin_archive (value unit __attribute__ ((unused)))
{
intnat dim = 5;
int flags = CAML_BA_UINT8 | CAML_BA_C_LAYOUT | CAML_BA_EXTERNAL;
return caml_ba_alloc(flags, 1, s, &dim);
}
