value
mlptrace_peekregisters (value pid_v)
{
pid_t pid;
struct user usreg;
long l = 0;
int savederrno = errno;
CAMLparam1 (pid_v);
CAMLlocal5 (res_v, eip_v, eax_v, ebx_v, ecx_v);
CAMLlocal5 (edx_v, esi_v, edi_v, ebp_v, esp_v);
CAMLlocal2 (eflags_v, origeax_v);
pid = Long_val (pid_v);
memset (&usreg, 0, sizeof (usreg));
#ifndef NO_BLOCKING_SECTION
caml_enter_blocking_section ();
#endif
l = ptrace (PTRACE_GETREGS, pid, (void *) 0, &usreg);
#ifndef NO_BLOCKING_SECTION
caml_leave_blocking_section ();
#endif
if (l == -1 && errno)
uerror ("Ptrace.peekregisters", Nothing);
if (savederrno)
errno = savederrno;
eip_v = caml_copy_nativeint (usreg.regs.eip);
eax_v = caml_copy_nativeint (usreg.regs.eax);
ebx_v = caml_copy_nativeint (usreg.regs.ebx);
ecx_v = caml_copy_nativeint (usreg.regs.ecx);
edx_v = caml_copy_nativeint (usreg.regs.edx);
esi_v = caml_copy_nativeint (usreg.regs.esi);
edi_v = caml_copy_nativeint (usreg.regs.edi);
ebp_v = caml_copy_nativeint (usreg.regs.ebp);
esp_v = caml_copy_nativeint (usreg.regs.esp);
eflags_v = caml_copy_nativeint (usreg.regs.eflags);
origeax_v = caml_copy_nativeint (usreg.regs.orig_eax);
res_v = alloc_small (0, 11);
Field (res_v, 0) = eip_v;
Field (res_v, 1) = eax_v;
Field (res_v, 2) = ebx_v;
Field (res_v, 3) = ecx_v;
Field (res_v, 4) = edx_v;
Field (res_v, 5) = esi_v;
Field (res_v, 6) = edi_v;
Field (res_v, 7) = ebp_v;
Field (res_v, 8) = esp_v;
Field (res_v, 9) = eflags_v;
Field (res_v, 10) = origeax_v;
CAMLreturn (res_v);
}
herr_t hdf5_h5l_operator(hid_t group, const char *name, const H5L_info_t *info,
void *op_data)
{
CAMLparam0();
CAMLlocal5(ret, info_v, address_v, args0, args1);
CAMLlocal2(args2, args3);
value args[4];
struct operator_data *operator_data = op_data;
args0 = alloc_h5l(group);
args1 = caml_copy_string(name);
args2 = Val_h5l_info(info);
args3 = *operator_data->operator_data;
args[0] = args0;
args[1] = args1;
args[2] = args2;
args[3] = args3;
ret = caml_callbackN_exn(*operator_data->callback, 4, args);
if (Is_exception_result(ret))
{
*(operator_data->exception) = Extract_exception(ret);
return -1;
}
CAMLreturnT(herr_t, H5_iter_val(ret));
}
static value stat_aux(int use_64, struct stat *buf)
{
CAMLparam0();
CAMLlocal5(atime, mtime, ctime, offset, v);
#include "nanosecond_stat.h"
atime = caml_copy_double((double) buf->st_atime + (NSEC(buf, a) / 1000000000.0));
mtime = caml_copy_double((double) buf->st_mtime + (NSEC(buf, m) / 1000000000.0));
ctime = caml_copy_double((double) buf->st_ctime + (NSEC(buf, c) / 1000000000.0));
#undef NSEC
offset = use_64 ? Val_file_offset(buf->st_size) : Val_int (buf->st_size);
v = alloc_small(12, 0);
Init_field(v, 0, Val_int (buf->st_dev));
Init_field(v, 1, Val_int (buf->st_ino));
Init_field(v, 2, cst_to_constr(buf->st_mode & S_IFMT, file_kind_table,
sizeof(file_kind_table) / sizeof(int), 0));
Init_field(v, 3, Val_int (buf->st_mode & 07777));
Init_field(v, 4, Val_int (buf->st_nlink));
Init_field(v, 5, Val_int (buf->st_uid));
Init_field(v, 6, Val_int (buf->st_gid));
Init_field(v, 7, Val_int (buf->st_rdev));
Init_field(v, 8, offset);
Init_field(v, 9, atime);
Init_field(v, 10, mtime);
Init_field(v, 11, ctime);
CAMLreturn(v);
}
CAMLprim value caml_get_exception_backtrace(value unit)
{
CAMLparam0();
CAMLlocal5(events, res, arr, p, fname);
int i;
struct loc_info li;
events = read_debug_info();
if (events == Val_false) {
res = Val_int(0); /* None */
} else {
arr = caml_alloc(caml_backtrace_pos, 0);
for (i = 0; i < caml_backtrace_pos; i++) {
extract_location_info(events, caml_backtrace_buffer[i], &li);
if (li.loc_valid) {
fname = caml_copy_string(li.loc_filename);
p = caml_alloc_small(5, 0);
Field(p, 0) = Val_bool(li.loc_is_raise);
Field(p, 1) = fname;
Field(p, 2) = Val_int(li.loc_lnum);
Field(p, 3) = Val_int(li.loc_startchr);
Field(p, 4) = Val_int(li.loc_endchr);
} else {
p = caml_alloc_small(1, 1);
Field(p, 0) = Val_bool(li.loc_is_raise);
}
caml_modify(&Field(arr, i), p);
}
res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
}
CAMLreturn(res);
}
static value stat_aux(/*int use_64,*/ struct stat *buf)
{
CAMLparam0();
CAMLlocal5(atime, mtime, ctime, offset, v);
atime = caml_copy_double((double) buf->st_atime);
mtime = caml_copy_double((double) buf->st_mtime);
ctime = caml_copy_double((double) buf->st_ctime);
offset = /*use_64 ? Val_file_offset(buf->st_size) :*/ Val_int (buf->st_size);
v = caml_alloc_small(12, 0);
Field (v, 0) = Val_int (buf->st_dev);
Field (v, 1) = Val_int (buf->st_ino);
Field (v, 2) = cst_to_constr(buf->st_mode & S_IFMT, file_kind_table,
sizeof(file_kind_table) / sizeof(int), 0);
Field (v, 3) = Val_int (buf->st_mode & 07777);
Field (v, 4) = Val_int (buf->st_nlink);
Field (v, 5) = Val_int (buf->st_uid);
Field (v, 6) = Val_int (buf->st_gid);
Field (v, 7) = Val_int (buf->st_rdev);
Field (v, 8) = offset;
Field (v, 9) = atime;
Field (v, 10) = mtime;
Field (v, 11) = ctime;
CAMLreturn(v);
}
CAMLprim value ml_skin_init (value use_vbo_v, value geom_v)
{
CAMLparam2 (use_vbo_v, geom_v);
CAMLlocal5 (vertexa_v, normala_v, uva_v, skin_v, colors_v);
State *s = &glob_state;
use_vbo = Bool_val (use_vbo_v);
#ifdef _WIN32
if (use_vbo) {
GETPA (BindBuffer);
GETPA (GenBuffers);
GETPA (BufferData);
GETPA (BufferSubData);
GETPA (MapBuffer);
GETPA (UnmapBuffer);
}
#endif
vertexa_v = Field (geom_v, 0);
normala_v = Field (geom_v, 1);
uva_v = Field (geom_v, 2);
skin_v = Field (geom_v, 3);
colors_v = Field (geom_v, 4);
skin_init (s, vertexa_v, normala_v, uva_v, skin_v, colors_v);
CAMLreturn (Val_unit);
}
static value
convert_json_t (json_t *val, int level)
{
CAMLparam0 ();
CAMLlocal5 (rv, v, tv, sv, consv);
if (level > 20)
caml_invalid_argument ("too many levels of object/array nesting");
if (json_is_object (val)) {
const char *key;
json_t *jvalue;
rv = caml_alloc (1, JSON_DICT_TAG);
v = Val_int (0);
/* This will create the OCaml list backwards, but JSON
* dictionaries are supposed to be unordered so that shouldn't
* matter, right? Well except that for some consumers this does
* matter (eg. simplestreams which incorrectly uses a dict when it
* really should use an array).
*/
json_object_foreach (val, key, jvalue) {
tv = caml_alloc_tuple (2);
sv = caml_copy_string (key);
Store_field (tv, 0, sv);
sv = convert_json_t (jvalue, level + 1);
Store_field (tv, 1, sv);
consv = caml_alloc (2, 0);
Store_field (consv, 1, v);
Store_field (consv, 0, tv);
v = consv;
}
Store_field (rv, 0, v);
}
static void
event_callback_wrapper_locked (guestfs_h *g,
void *data,
uint64_t event,
int event_handle,
int flags,
const char *buf, size_t buf_len,
const uint64_t *array, size_t array_len)
{
CAMLparam0 ();
CAMLlocal5 (gv, evv, ehv, bufv, arrayv);
CAMLlocal2 (rv, v);
value *root;
size_t i;
root = guestfs_get_private (g, "_ocaml_g");
gv = *root;
/* Only one bit should be set in 'event'. Which one? */
evv = Val_int (event_bitmask_to_event (event));
ehv = Val_int (event_handle);
bufv = caml_alloc_string (buf_len);
memcpy (String_val (bufv), buf, buf_len);
arrayv = caml_alloc (array_len, 0);
for (i = 0; i < array_len; ++i) {
v = caml_copy_int64 (array[i]);
Store_field (arrayv, i, v);
}
value args[5] = { gv, evv, ehv, bufv, arrayv };
rv = caml_callbackN_exn (*(value*)data, 5, args);
/* Callbacks shouldn't throw exceptions. There's not much we can do
* except to print it.
*/
if (Is_exception_result (rv))
fprintf (stderr,
"libguestfs: uncaught OCaml exception in event callback: %s",
caml_format_exception (Extract_exception (rv)));
CAMLreturn0;
}
value stub_if_getaddr(value unit)
{
CAMLparam0();
CAMLlocal5(result, temp, name, addrstr, netmaskstr);
CAMLlocal1(tuple);
int ret;
struct ifaddrs *ifaddrs, *tmp;
struct sockaddr *sock, *netmask;
result = temp = Val_emptylist;
name = addrstr = Val_int(0);
ret = getifaddrs(&ifaddrs);
if (ret < 0)
caml_failwith("cannot get interface address");
for (tmp = ifaddrs; tmp; tmp = tmp->ifa_next) {
sock = tmp->ifa_addr;
netmask = tmp->ifa_netmask;
if (sock->sa_family == AF_INET || sock->sa_family == AF_INET6) {
name = caml_copy_string(tmp->ifa_name);
addrstr = alloc_addr(sock);
netmaskstr = alloc_addr(netmask);
tuple = caml_alloc_tuple(4);
Store_field(tuple, 0, name);
Store_field(tuple, 1, addrstr);
Store_field(tuple, 2, netmaskstr);
Store_field(tuple, 3, Val_bool(sock->sa_family == AF_INET6));
result = caml_alloc_small(2, Tag_cons);
Field(result, 0) = tuple;
Field(result, 1) = temp;
temp = result;
}
}
freeifaddrs(ifaddrs);
CAMLreturn(result);
}
static int
visitor_function_wrapper (const char *dir,
const char *filename,
const struct guestfs_statns *stat,
const struct guestfs_xattr_list *xattrs,
void *opaque)
{
CAMLparam0 ();
CAMLlocal5 (dirv, filenamev, statv, xattrsv, v);
struct visitor_function_wrapper_args *args = opaque;
assert (dir != NULL);
assert (stat != NULL);
assert (xattrs != NULL);
assert (args != NULL);
dirv = caml_copy_string (dir);
if (filename == NULL)
filenamev = Val_int (0); /* None */
else {
filenamev = caml_alloc (1, 0);
v = caml_copy_string (filename);
Store_field (filenamev, 0, v);
}
statv = copy_statns (stat);
xattrsv = copy_xattr_list (xattrs);
/* Call the visitor_function. */
value argsv[4] = { dirv, filenamev, statv, xattrsv };
v = caml_callbackN_exn (*args->fvp, 4, argsv);
if (Is_exception_result (v)) {
/* The visitor_function raised an exception. Store the exception
* in the 'exn' field on the stack of guestfs_int_mllib_visit, and
* return an error.
*/
*args->exnp = Extract_exception (v);
return -1;
}
/* No error, return normally. */
CAMLreturnT (int, 0);
}
CAMLprim value lightsource_process(value record_lightsource,
value list_polygon_objects,
value polygon_view) {
CAMLparam3(record_lightsource, list_polygon_objects, polygon_view);
CAMLlocal5(polygon_prev_head, list_polygon_head, vector_prev_head,
list_vector_head, tmp_polygon);
CAMLlocal1(tmp_vector);
LightSource l = LightSource(Vector_val(Field(record_lightsource, 0)),
Double_val(Field(record_lightsource, 1)),
Double_val(Field(record_lightsource, 2)));
std::vector<Polygon> tmp_polygon_list = std::vector<Polygon>();
polygon_list_to_std_vector(list_polygon_objects, &tmp_polygon_list);
std::vector<Vector> tmp_vector_list = std::vector<Vector>();
vector_list_to_std_vector(Field(polygon_view, 0), &tmp_vector_list);
Polygon polygon = Polygon(tmp_vector_list);
// auto start = std::chrono::steady_clock::now();
std::vector<Polygon> list_polygon = l.process(tmp_polygon_list);
// auto duration = std::chrono::duration_cast<std::chrono::milliseconds>(
// std::chrono::steady_clock::now() - start);
// printf("--> %lld\n", duration.count());
polygon_prev_head = Val_unit;
for (Polygon p : list_polygon) {
vector_prev_head = Val_unit;
for (Vector v : p.get_vertices()) {
tmp_vector = caml_alloc_small(2, Double_array_tag);
Double_field(tmp_vector, 0) = v.x;
Double_field(tmp_vector, 1) = v.y;
list_vector_head = caml_alloc_small(2, 0);
Field(list_vector_head, 0) = tmp_vector;
Field(list_vector_head, 1) = vector_prev_head;
vector_prev_head = list_vector_head;
}
tmp_polygon = caml_alloc_small(1, 0);
Field(tmp_polygon, 0) = list_vector_head;
list_polygon_head = caml_alloc_small(2, 0);
Field(list_polygon_head, 0) = tmp_polygon;
Field(list_polygon_head, 1) = polygon_prev_head;
polygon_prev_head = list_polygon_head;
}
CAMLreturn(list_polygon_head);
}
SRes ml_sevenzip_read(void *object, void **buffer, size_t *size)
{
CFileInStream *archive_in = (CFileInStream *) object;
CAMLparam0 ();
CAMLlocal5 (readable, read, tuple, ml_string, ml_size);
readable = archive_in->readable;
read = Field(readable, 0);
tuple = caml_callback(read, Val_int(*size));
ml_string = Field(tuple, 0);
ml_size = Field(tuple, 1);
*buffer = String_val(ml_string);
*size = Int_val(ml_size);
/* The GC might have moved the readable pointer */
archive_in->readable = readable;
CAMLreturnT(SRes, SZ_OK);
}
static value alloc_sevenzip_entry(CSzArEx db, int i)
{
CSzFileItem *f = db.db.Files + i;
CAMLparam0 ();
CAMLlocal5 (entry, index, name, size, is_directory);
entry = caml_alloc (4, 0);
index = Val_int(i);
name = caml_copy_string(f->Name);
size = Val_int(f->Size);
is_directory = Val_bool(f->IsDir);
Store_field (entry, 0, index);
Store_field (entry, 1, name);
Store_field (entry, 2, size);
Store_field (entry, 3, is_directory);
CAMLreturn (entry);
}
CAMLprim value caml_context_split_r(CAML_R, value thread_no_as_value, value function)
{
#if defined(HAS_MULTICONTEXT) //&& defined(NATIVE_CODE)
//DUMPROOTS("splitting: before GC-protecting locals");
CAMLparam1(function);
//CAMLlocal2(result, open_channels);
CAMLlocal5(result, open_channels, res, tail, chan);
//DUMPROOTS("splitting: after GC-protecting locals");
int can_split = caml_can_split_r(ctx);
if (! can_split)
caml_raise_cannot_split_r(ctx);
int thread_no = Int_val(thread_no_as_value);
caml_global_context **new_contexts = caml_stat_alloc(sizeof(caml_global_context*) * thread_no);
char *blob;
sem_t semaphore;
int i;
caml_initialize_semaphore(&semaphore, 0);
/* CAMLparam0(); CAMLlocal1(open_channels); */
/* Make sure that the currently-existing channels stay alive until
after deserialization; we can't keep reference counts within the
blob, so we pin all alive channels by keeping this list alive: */
/* //if(0){//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
/* struct channel *channel; */
/* struct channel **channels; */
/* int channel_no = 0; */
/* caml_acquire_global_lock(); */
/* for (channel = caml_all_opened_channels; */
/* channel != NULL; */
/* channel = channel->next) */
/* channel_no ++; */
/* channels = caml_stat_alloc(sizeof(struct channel*) * channel_no); */
/* for (i = 0, channel = caml_all_opened_channels; */
/* channel != NULL; */
/* i ++, channel = channel->next){ */
/* channels[i] = channel; */
/* DUMP("split-pinning channel %p, with fd %i, refcount %i->%i", channel, (int)channel->fd, channel->refcount, channel->refcount + 1); */
/* channel->refcount ++; */
/* } */
/* caml_release_global_lock(); */
//open_channels = caml_ml_all_channels_list_r(ctx); // !!!!!!!!!!!!!!!!!!!! This can occasionally cause crashes related to channel picounts. I certainly messed up something in io.c. //!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//}//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/* //EXPERIMENTAL: BEGIN */
/* { */
/* struct channel * channel; */
/* res = Val_emptylist; */
/* caml_acquire_global_lock(); */
/* int ii, channel_index; */
/* for(ii = 0; ii < 100; ii ++){ // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
/* for (channel_index = 0, channel = caml_all_opened_channels; */
/* channel != NULL; */
/* channel = channel->next, channel_index ++) */
/* /\* Testing channel->fd >= 0 looks unnecessary, as */
/* caml_ml_close_channel changes max when setting fd to -1. *\/ */
/* { */
/* DUMP("round %i, channel_index %i", ii, channel_index); */
/* // !!!!!!!!!!!!! BEGIN */
/* /\* chan = *\/ caml_alloc_channel_r (ctx, channel); */
/* // !!!!!!!!!!!!! END */
/* chan = Val_unit;//caml_alloc_channel_r (ctx, channel); // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
/* tail = res; */
/* res = caml_alloc_small_r (ctx, 2, 0); */
/* Field (res, 0) = chan; */
/* Field (res, 1) = tail; */
/* } */
/* DUMP("End of round %i: there are %i channels alive", ii, channel_index); */
/* DUMP("Before GC'ing"); */
/* caml_gc_compaction_r(ctx, Val_unit); //!!!!!@@@@@@@@@@@@@ */
/* DUMP("After GC'ing"); */
/* } */
/* caml_release_global_lock(); */
/* //open_channels = Val_unit/\* res *\/; */
/* open_channels = res; */
/* } */
/* //EXPERIMENTAL: END */
/* Serialize the context in the main thread, then create threads,
and in each one of them deserialize it back in parallel: */
blob = caml_serialize_context(ctx, function);
//if(0){//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
caml_split_and_wait_r(ctx, blob, new_contexts, thread_no, &semaphore);
//}//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/* Now we're done with the blob: */
DUMP("destroying the blob");
caml_stat_free(blob); // !!!!!!!!!!!!!!!!!!!!!!!!!!! This is needed !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
DUMP("GC'ing after destroying the blob");
caml_gc_compaction_r(ctx, Val_unit); //!!!!!@@@@@@@@@@@@@
DUMP("finalizing the semaphore");
caml_finalize_semaphore(&semaphore);
/* Copy the contexts we got, and we're done with new_contexts as well: */
DUMP("copying the new context (descriptors) into the Caml data structure result");
result = caml_alloc_r(ctx, thread_no, 0);
caml_gc_compaction_r(ctx, Val_unit); //!!!!!@@@@@@@@@@@@
for(i = 0; i < thread_no; i ++)
caml_initialize_r(ctx, &Field(result, i), caml_value_of_context_descriptor(new_contexts[i]->descriptor));
caml_stat_free(new_contexts);
DUMP("destroyed the malloced buffer of pointers new_contexts");
//DUMPROOTS("from parent, after splitting");
/* caml_acquire_global_lock(); */
/* for (i = 0; i < channel_no; i ++){ */
/* DUMP("split-unpinning channels[i] %p, with fd %i, refcount %i->%i", channels[i], (int)channels[i]->fd, channels[i]->refcount, channels[i]->refcount - 1); */
/* channels[i]->refcount --; */
/* } */
/* caml_release_global_lock(); */
CAMLreturn(result);
//CAMLreturn(Val_unit);
#else
caml_raise_unimplemented_r(ctx);
return Val_unit; // unreachable
#endif // #if defined(HAS_MULTICONTEXT) //&& defined(NATIVE_CODE)
}
CAMLprim value netcgi2_apache_request_finfo (value rv)
{
CAMLparam1 (rv);
request_rec *r = Request_rec_val (rv);
CAMLlocal5 (v, sb, atime, mtime, ctime);
#if APACHE2
if (r->finfo.filetype != APR_NOFILE) /* Some statbuf */
{
atime = (r->finfo.valid & APR_FINFO_ATIME) ?
copy_double ((double) apr_time_sec (r->finfo.atime)) :
copy_double (0.);
mtime = (r->finfo.valid & APR_FINFO_MTIME) ?
copy_double ((double) apr_time_sec (r->finfo.mtime)) :
copy_double (0.);
ctime = (r->finfo.valid & APR_FINFO_CTIME) ?
copy_double ((double) apr_time_sec (r->finfo.ctime)) :
copy_double (0.);
sb = alloc_small (12, 0);
Field (sb, 0) = Val_int (r->finfo.device);
Field (sb, 1) = Val_int (r->finfo.inode);
Field (sb, 2) =
cst_to_constr (r->finfo.filetype, file_kind_table,
sizeof (file_kind_table) / sizeof (int), 0);
Field (sb, 3) = Val_int (r->finfo.protection);
Field (sb, 4) = Val_int (r->finfo.nlink);
Field (sb, 5) = Val_int (r->finfo.user);
Field (sb, 6) = Val_int (r->finfo.group);
Field (sb, 7) = Val_int (0); /* FIXME rdev? */
Field (sb, 8) = Val_int (r->finfo.size); /* FIXME 64 bit file offsets */
Field (sb, 9) = atime;
Field (sb, 10) = mtime;
Field (sb, 11) = ctime;
v = alloc (1, 0); /* The "Some" block. */
Field (v, 0) = sb;
}
else
v = Val_int (0); /* None. */
#else /* not APACHE2 */
if (r->finfo.st_mode) /* Some statbuf */
{
/* This code copied and modified from otherlibs/unix/stat.c. */
atime = copy_double ((double) r->finfo.st_atime);
mtime = copy_double ((double) r->finfo.st_mtime);
ctime = copy_double ((double) r->finfo.st_ctime);
sb = alloc_small (12, 0);
Field (sb, 0) = Val_int (r->finfo.st_dev);
Field (sb, 1) = Val_int (r->finfo.st_ino);
Field (sb, 2) =
cst_to_constr (r->finfo.st_mode & S_IFMT, file_kind_table,
sizeof (file_kind_table) / sizeof (int), 0);
Field (sb, 3) = Val_int (r->finfo.st_mode & 07777);
Field (sb, 4) = Val_int (r->finfo.st_nlink);
Field (sb, 5) = Val_int (r->finfo.st_uid);
Field (sb, 6) = Val_int (r->finfo.st_gid);
Field (sb, 7) = Val_int (r->finfo.st_rdev);
Field (sb, 8) = Val_int (r->finfo.st_size); /* FIXME: 64 bit file offsets */
Field (sb, 9) = atime;
Field (sb, 10) = mtime;
Field (sb, 11) = ctime;
v = alloc (1, 0); /* The "Some" block. */
Field (v, 0) = sb;
}
else
v = Val_int (0); /* None. */
#endif /* not APACHE2 */
CAMLreturn (v);
}
CAMLprim value caml_extunix_recvmsg2(value vfd, value vbuf, value ofs, value vlen,
value vflags)
{
CAMLparam4(vfd, vbuf, ofs, vlen);
CAMLlocal5(vres, vlist, v, vx, vsaddr);
union {
struct cmsghdr hdr;
char buf[CMSG_SPACE(sizeof(int)) /* File descriptor passing */
#ifdef EXTUNIX_HAVE_IP_RECVIF
+ CMSG_SPACE(sizeof(struct sockaddr_dl)) /* IP_RECVIF */
#endif
#ifdef EXTUNIX_HAVE_IP_RECVDSTADDR
+ CMSG_SPACE(sizeof(struct in_addr)) /* IP_RECVDSTADDR */
#endif
];
} cmsgbuf;
struct iovec iov;
struct msghdr msg;
struct cmsghdr *cmsg;
ssize_t n;
size_t len;
char iobuf[UNIX_BUFFER_SIZE];
struct sockaddr_storage ss;
int sendflags;
#ifdef EXTUNIX_HAVE_IP_RECVIF
struct sockaddr_dl *dst = NULL;
#endif
len = Long_val(vlen);
memset(&iov, 0, sizeof(iov));
memset(&msg, 0, sizeof(msg));
if (len > UNIX_BUFFER_SIZE)
len = UNIX_BUFFER_SIZE;
iov.iov_base = iobuf;
iov.iov_len = len;
msg.msg_name = &ss;
msg.msg_namelen = sizeof(ss);
msg.msg_iov = &iov;
msg.msg_iovlen = 1;
msg.msg_control = &cmsgbuf.buf;
msg.msg_controllen = sizeof(cmsgbuf.buf);
sendflags = caml_convert_flag_list(vflags, msg_flag_table);
caml_enter_blocking_section();
n = recvmsg(Int_val(vfd), &msg, sendflags);
caml_leave_blocking_section();
vres = caml_alloc_small(4, 0);
if (n == -1) {
uerror("recvmsg", Nothing);
CAMLreturn (vres);
}
vsaddr = my_alloc_sockaddr(&ss);
memmove(&Byte(vbuf, Long_val(ofs)), iobuf, n);
vlist = Val_int(0);
/* Build the variant list vlist */
for (cmsg = CMSG_FIRSTHDR(&msg); cmsg != NULL;
cmsg = CMSG_NXTHDR(&msg, cmsg)) {
if (cmsg->cmsg_level == SOL_SOCKET &&
cmsg->cmsg_type == SCM_RIGHTS) {
/* CMSG_DATA is aligned, so the following is cool */
v = caml_alloc_small(2, TAG_FILEDESCRIPTOR);
Field(v, 0) = Val_int(*(int *)CMSG_DATA(cmsg));
Field(v, 1) = vlist;
vlist = v;
continue;
}
#ifdef EXTUNIX_HAVE_IP_RECVIF
if (cmsg->cmsg_level == IPPROTO_IP &&
cmsg->cmsg_type == IP_RECVIF) {
dst = (struct sockaddr_dl *)CMSG_DATA(cmsg);
v = caml_alloc_small(2, 0);
vx = caml_alloc_small(1, TAG_IP_RECVIF);
Field(vx, 0) = Val_int(dst->sdl_index);
Field(v, 0) = vx;
Field(v, 1) = vlist;
vlist = v;
continue;
}
#endif
#ifdef EXTUNIX_HAVE_IP_RECVDSTADDR
if (cmsg->cmsg_level == IPPROTO_IP &&
cmsg->cmsg_type == IP_RECVDSTADDR) {
struct in_addr ipdst;
ipdst = *(struct in_addr *)CMSG_DATA(cmsg);
v = caml_alloc_small(2, 0);
vx = caml_alloc_small(1, TAG_IP_RECVDSTADDR);
Field(vx, 0) = caml_alloc_string(4);
memcpy(String_val(Field(vx, 0)), &ipdst, 4);
Field(v, 0) = vx;
Field(v, 1) = vlist;
vlist = v;
continue;
}
#endif
}
/* Now build the result */
Field(vres, 0) = Val_long(n);
Field(vres, 1) = vsaddr;
Field(vres, 2) = vlist;
Field(vres, 3) = int_to_recvflags(msg.msg_flags);
CAMLreturn(vres);
}
/* given a return value in OCaml land, translate it to
the return_val_t C structure
*/
return_val_t translate_return_value(value ocaml_result) {
CAMLparam1(ocaml_result);
CAMLlocal5(ocaml_shape, ocaml_strides, ocaml_data, ocaml_cur, ocaml_type);
CAMLlocal1(v);
return_val_t ret;
if (Is_long(ocaml_result)) {
// In this case, we know that the return code must have been Pass,
// since the other two return codes have data.
ret.return_code = RET_PASS;
ret.results_len = 0;
} else if (Tag_val(ocaml_result) == RET_FAIL) {
ret.return_code = RET_FAIL;
ret.results_len = caml_string_length(Field(ocaml_result, 0));
ret.error_msg = malloc(ret.results_len + 1);
strcpy(ret.error_msg, String_val(Field(ocaml_result, 0)));
} else if (Tag_val(ocaml_result) == RET_SUCCESS) {
ocaml_cur = Field(ocaml_result, 0);
ret.return_code = RET_SUCCESS;
ret.results_len = ocaml_list_length(ocaml_cur);
ret.results = (ret_t*)malloc(sizeof(ret_t) * ret.results_len);
int i, j;
host_val h;
for (i = 0; i < ret.results_len; ++i) {
v = Field(ocaml_cur, 0);
h = create_host_val(v);
ocaml_cur = Field(ocaml_cur, 1);
// returning a scalar
if (value_is_scalar(h)) {
ret.results[i].is_scalar = 1;
ocaml_type = (scalar_type)value_type_of(h);
ret.results[i].data.scalar.ret_type =
get_scalar_element_type(ocaml_type);
// WARNING:
// Tiny Memory Leak Ahead
// -----------------------
// When scalar data is returned to the host language
// on the heap, it should be manually deleted by the
// host frontend
if (type_is_bool(ocaml_type)) {
ret.results[i].data.scalar.ret_scalar_value.boolean = get_bool(h);
} else if (type_is_int32(ocaml_type)) {
ret.results[i].data.scalar.ret_scalar_value.int32 = get_int32(h);
} else if (type_is_int64(ocaml_type)) {
ret.results[i].data.scalar.ret_scalar_value.int64 = get_int64(h);
} else if (type_is_float32(ocaml_type)) {
ret.results[i].data.scalar.ret_scalar_value.float32 = get_float64(h);
} else if (type_is_float64(ocaml_type)) {
ret.results[i].data.scalar.ret_scalar_value.float64 = get_float64(h);
} else {
caml_failwith("Unable to return scalar of this type\n");
}
} else {
// Pass the type
ret.results[i].is_scalar = 0;
ret.results[i].data.array.ret_type = array_type_of(h);
// Pass the data
ret.results[i].data.array.data = get_array_data(h);
// Build the shape array
ocaml_shape = value_get_shape(h);
int shape_len = Wosize_val(ocaml_shape);
ret.results[i].data.array.shape =
(int*)malloc(shape_len * sizeof(int));
ret.results[i].data.array.shape_len = shape_len;
for (j = 0; j < shape_len; ++j) {
ret.results[i].data.array.shape[j] = Int_val(Field(ocaml_shape, j));
}
// Build the strides array
ocaml_strides = value_get_strides(h);
int strides_len = Wosize_val(ocaml_strides);
ret.results[i].data.array.strides_len = strides_len;
ret.results[i].data.array.strides =
(int*)malloc(strides_len * sizeof(int));
for (j = 0; j < strides_len; ++j) {
ret.results[i].data.array.strides[j] =
Int_val(Field(ocaml_strides, j));
}
}
}
}
CAMLreturnT(return_val_t, ret);
}
value read_dump_file(value filename) {
CAMLparam1(filename);
CAMLlocal5(ocaml_var, ocaml_list_el1, ocaml_list_el2,
ocaml_dyn_type, ocaml_dyn_aux);
CAMLlocal2(ocaml_name, ocaml_hostval);
printf("opening %s\n", String_val(filename));
FILE *ifile = fopen(String_val(filename), "r");
if (ifile == NULL) {
ocaml_var = Val_int(0);
CAMLreturn(ocaml_var);
}
int num_vars = 0;
fread(&num_vars, sizeof(int), 1, ifile);
if (num_vars == 0) {
ocaml_var = Val_int(0);
CAMLreturn(ocaml_var);
}
printf("parsing vars\n");
ocaml_list_el2 = caml_alloc_tuple(2);
int i, j;
int name_len, shape_len, type, num_bytes;
int *shape;
char *name, *data;
for (i = 0; i < num_vars; ++i) {
// Allocate the variable tuple of (name, hostval)
ocaml_var = caml_alloc_tuple(2);
// Build the name
fread(&name_len, sizeof(int), 1, ifile);
ocaml_name = caml_alloc_string(name_len);
fread(String_val(ocaml_name), sizeof(char), name_len, ifile);
Store_field(ocaml_var, 0, ocaml_name);
printf("got var name: %s\n", String_val(ocaml_name));
// Build the shape
fread(&shape_len, sizeof(int), 1, ifile);
shape = (int*)malloc(shape_len * sizeof(int));
fread(shape, sizeof(int), shape_len, ifile);
printf("got shape of len %d\n", shape_len);
// Build the DynType
fread(&ocaml_dyn_type, sizeof(value), 1, ifile);
for (j = 0; j < shape_len; ++j) {
ocaml_dyn_aux = ocaml_dyn_type;
ocaml_dyn_type = caml_alloc(1, VecT);
Store_field(ocaml_dyn_type, 0, ocaml_dyn_aux);
}
printf("built dyn_type\n");
// Get the num_bytes
fread(&num_bytes, sizeof(int), 1, ifile);
// Get the payload
data = (char*)malloc(num_bytes);
fread(data, 1, num_bytes, ifile);
printf("got payload of %d bytes\n", num_bytes);
// Build the HostVal
ocaml_hostval = build_ocaml_hostval(num_bytes, ocaml_dyn_type,
shape, shape_len, data);
printf("built hostval from inputs\n");
Store_field(ocaml_var, 1, ocaml_hostval);
// Insert the var into the list
if (i == 0) {
Store_field(ocaml_list_el2, 1, Val_int(0));
} else {
Store_field(ocaml_list_el2, 1, ocaml_list_el1);
}
Store_field(ocaml_list_el2, 0, ocaml_var);
if (i < num_vars - 1) {
ocaml_list_el1 = ocaml_list_el2;
ocaml_list_el2 = caml_alloc_tuple(2);
}
}
fclose(ifile);
CAMLreturn(ocaml_list_el2);
}
CAMLprim value lwt_glib_poll(value val_fds, value val_count, value val_timeout)
{
gint timeout, lwt_timeout;
long count;
int i;
GPollFD *gpollfd;
gint events, revents;
CAMLparam3(val_fds, val_count, val_timeout);
CAMLlocal5(node, src, node_result, src_result, tmp);
count = Long_val(val_count);
g_main_context_dispatch(gc);
g_main_context_prepare(gc, &max_priority);
while (fds_count < count + (n_fds = g_main_context_query(gc, max_priority, &timeout, gpollfds, fds_count))) {
free(gpollfds);
fds_count = n_fds + count;
gpollfds = lwt_unix_malloc(fds_count * sizeof (GPollFD));
}
/* Clear all revents fields. */
for (i = 0; i < n_fds + count; i++) gpollfds[i].revents = 0;
/* Add all Lwt fds. */
for (i = n_fds, node = val_fds; i < n_fds + count; i++, node = Field(node, 1)) {
src = Field(node, 0);
gpollfd = gpollfds + i;
#if defined(LWT_ON_WINDOWS)
gpollfd->fd = Handle_val(Field(src, 0));
#else
gpollfd->fd = Int_val(Field(src, 0));
#endif
events = 0;
if (Bool_val(Field(src, 1))) events |= G_IO_IN;
if (Bool_val(Field(src, 2))) events |= G_IO_OUT;
gpollfd->events = events;
}
lwt_timeout = Int_val(val_timeout);
if (timeout < 0 || (lwt_timeout >= 0 && lwt_timeout < timeout))
timeout = lwt_timeout;
/* Do the blocking call. */
caml_enter_blocking_section();
g_main_context_get_poll_func(gc)(gpollfds, n_fds + count, timeout);
caml_leave_blocking_section();
g_main_context_check(gc, max_priority, gpollfds, n_fds);
/* Build the result. */
node_result = Val_int(0);
for (i = n_fds, node = val_fds; i < n_fds + count; i++, node = Field(node, 1)) {
gpollfd = gpollfds + i;
src_result = caml_alloc_tuple(3);
src = Field(node, 0);
Field(src_result, 0) = Field(src, 0);
revents = gpollfd->revents;
if (revents & G_IO_HUP) {
/* Treat HUP as ready. There's no point continuing to wait on this FD. */
if (gpollfd->events & G_IO_IN)
revents |= G_IO_IN;
if (gpollfd->events & G_IO_OUT)
revents |= G_IO_OUT;
}
Field(src_result, 1) = Val_bool(revents & G_IO_IN);
Field(src_result, 2) = Val_bool(revents & G_IO_OUT);
tmp = caml_alloc_tuple(2);
Field(tmp, 0) = src_result;
Field(tmp, 1) = node_result;
node_result = tmp;
}
CAMLreturn(node_result);
}
CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout)
{
/* Event associated to handle */
DWORD nEventsCount;
DWORD nEventsMax;
HANDLE *lpEventsDone;
/* Data for all handles */
LPSELECTDATA lpSelectData;
LPSELECTDATA iterSelectData;
/* Iterator for results */
LPSELECTRESULT iterResult;
/* Iterator */
DWORD i;
/* Error status */
DWORD err;
/* Time to wait */
DWORD milliseconds;
/* Is there static select data */
BOOL hasStaticData = FALSE;
/* Wait return */
DWORD waitRet;
/* Set of handle */
SELECTHANDLESET hds;
DWORD hdsMax;
LPHANDLE hdsData;
/* Length of each list */
DWORD readfds_len;
DWORD writefds_len;
DWORD exceptfds_len;
CAMLparam4 (readfds, writefds, exceptfds, timeout);
CAMLlocal5 (read_list, write_list, except_list, res, l);
CAMLlocal1 (fd);
fd_set read, write, except;
double tm;
struct timeval tv;
struct timeval * tvp;
DEBUG_PRINT("in select");
err = 0;
tm = Double_val(timeout);
if (readfds == Val_int(0) && writefds == Val_int(0) && exceptfds == Val_int(0)) {
DEBUG_PRINT("nothing to do");
if ( tm > 0.0 ) {
enter_blocking_section();
Sleep( (int)(tm * 1000));
leave_blocking_section();
}
read_list = write_list = except_list = Val_int(0);
} else {
if (fdlist_to_fdset(readfds, &read) && fdlist_to_fdset(writefds, &write) && fdlist_to_fdset(exceptfds, &except)) {
DEBUG_PRINT("only sockets to select on, using classic select");
if (tm < 0.0) {
tvp = (struct timeval *) NULL;
} else {
tv.tv_sec = (int) tm;
tv.tv_usec = (int) (1e6 * (tm - (int) tm));
tvp = &tv;
}
enter_blocking_section();
if (select(FD_SETSIZE, &read, &write, &except, tvp) == -1) {
err = WSAGetLastError();
DEBUG_PRINT("Error %ld occurred", err);
}
leave_blocking_section();
if (err) {
DEBUG_PRINT("Error %ld occurred", err);
win32_maperr(err);
uerror("select", Nothing);
}
read_list = fdset_to_fdlist(readfds, &read);
write_list = fdset_to_fdlist(writefds, &write);
except_list = fdset_to_fdlist(exceptfds, &except);
} else {
nEventsCount = 0;
nEventsMax = 0;
lpEventsDone = NULL;
lpSelectData = NULL;
iterSelectData = NULL;
iterResult = NULL;
hasStaticData = 0;
waitRet = 0;
readfds_len = caml_list_length(readfds);
writefds_len = caml_list_length(writefds);
exceptfds_len = caml_list_length(exceptfds);
hdsMax = MAX(readfds_len, MAX(writefds_len, exceptfds_len));
hdsData = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * hdsMax);
if (tm >= 0.0)
{
milliseconds = 1000 * tm;
DEBUG_PRINT("Will wait %d ms", milliseconds);
}
else
{
milliseconds = INFINITE;
}
/* Create list of select data, based on the different list of fd to watch */
DEBUG_PRINT("Dispatch read fd");
handle_set_init(&hds, hdsData, hdsMax);
i=0;
for (l = readfds; l != Val_int(0); l = Field(l, 1))
{
fd = Field(l, 0);
if (!handle_set_mem(&hds, Handle_val(fd)))
{
handle_set_add(&hds, Handle_val(fd));
lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_READ, fd, i++);
}
else
{
DEBUG_PRINT("Discarding handle %x which is already monitor for read", Handle_val(fd));
}
}
handle_set_reset(&hds);
DEBUG_PRINT("Dispatch write fd");
handle_set_init(&hds, hdsData, hdsMax);
i=0;
for (l = writefds; l != Val_int(0); l = Field(l, 1))
{
fd = Field(l, 0);
if (!handle_set_mem(&hds, Handle_val(fd)))
{
handle_set_add(&hds, Handle_val(fd));
lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_WRITE, fd, i++);
}
else
{
DEBUG_PRINT("Discarding handle %x which is already monitor for write", Handle_val(fd));
}
}
handle_set_reset(&hds);
DEBUG_PRINT("Dispatch exceptional fd");
handle_set_init(&hds, hdsData, hdsMax);
i=0;
for (l = exceptfds; l != Val_int(0); l = Field(l, 1))
{
fd = Field(l, 0);
if (!handle_set_mem(&hds, Handle_val(fd)))
{
handle_set_add(&hds, Handle_val(fd));
lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_EXCEPT, fd, i++);
}
else
{
DEBUG_PRINT("Discarding handle %x which is already monitor for exceptional", Handle_val(fd));
}
}
handle_set_reset(&hds);
/* Building the list of handle to wait for */
DEBUG_PRINT("Building events done array");
nEventsMax = list_length((LPLIST)lpSelectData);
nEventsCount = 0;
lpEventsDone = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * nEventsMax);
iterSelectData = lpSelectData;
while (iterSelectData != NULL)
{
/* Check if it is static data. If this is the case, launch everything
* but don't wait for events. It helps to test if there are events on
* any other fd (which are not static), knowing that there is at least
* one result (the static data).
*/
if (iterSelectData->EType == SELECT_TYPE_STATIC)
{
hasStaticData = TRUE;
};
/* Execute APC */
if (iterSelectData->funcWorker != NULL)
{
iterSelectData->lpWorker =
worker_job_submit(
iterSelectData->funcWorker,
(void *)iterSelectData);
DEBUG_PRINT("Job submitted to worker %x", iterSelectData->lpWorker);
lpEventsDone[nEventsCount] = worker_job_event_done(iterSelectData->lpWorker);
nEventsCount++;
};
iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
};
DEBUG_PRINT("Need to watch %d workers", nEventsCount);
/* Processing select itself */
enter_blocking_section();
/* There are worker started, waiting to be monitored */
if (nEventsCount > 0)
{
/* Waiting for event */
if (err == 0 && !hasStaticData)
{
DEBUG_PRINT("Waiting for one select worker to be done");
switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds))
{
case WAIT_FAILED:
err = GetLastError();
break;
case WAIT_TIMEOUT:
DEBUG_PRINT("Select timeout");
break;
default:
DEBUG_PRINT("One worker is done");
break;
};
}
/* Ordering stop to every worker */
DEBUG_PRINT("Sending stop signal to every select workers");
iterSelectData = lpSelectData;
while (iterSelectData != NULL)
{
if (iterSelectData->lpWorker != NULL)
{
worker_job_stop(iterSelectData->lpWorker);
};
iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
};
DEBUG_PRINT("Waiting for every select worker to be done");
switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE))
{
case WAIT_FAILED:
err = GetLastError();
break;
default:
DEBUG_PRINT("Every worker is done");
break;
}
}
/* Nothing to monitor but some time to wait. */
else if (!hasStaticData)
{
Sleep(milliseconds);
}
leave_blocking_section();
DEBUG_PRINT("Error status: %d (0 is ok)", err);
/* Build results */
if (err == 0)
{
DEBUG_PRINT("Building result");
read_list = Val_unit;
write_list = Val_unit;
except_list = Val_unit;
iterSelectData = lpSelectData;
while (iterSelectData != NULL)
{
for (i = 0; i < iterSelectData->nResultsCount; i++)
{
iterResult = &(iterSelectData->aResults[i]);
l = alloc_small(2, 0);
Store_field(l, 0, find_handle(iterResult, readfds, writefds, exceptfds));
switch (iterResult->EMode)
{
case SELECT_MODE_READ:
Store_field(l, 1, read_list);
read_list = l;
break;
case SELECT_MODE_WRITE:
Store_field(l, 1, write_list);
write_list = l;
break;
case SELECT_MODE_EXCEPT:
Store_field(l, 1, except_list);
except_list = l;
break;
}
}
/* We try to only process the first error, bypass other errors */
if (err == 0 && iterSelectData->EState == SELECT_STATE_ERROR)
{
err = iterSelectData->nError;
}
iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
}
}
/* Free resources */
DEBUG_PRINT("Free selectdata resources");
iterSelectData = lpSelectData;
while (iterSelectData != NULL)
{
lpSelectData = iterSelectData;
iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
select_data_free(lpSelectData);
}
lpSelectData = NULL;
/* Free allocated events/handle set array */
DEBUG_PRINT("Free local allocated resources");
caml_stat_free(lpEventsDone);
caml_stat_free(hdsData);
DEBUG_PRINT("Raise error if required");
if (err != 0)
{
win32_maperr(err);
uerror("select", Nothing);
}
}
}
DEBUG_PRINT("Build final result");
res = alloc_small(3, 0);
Store_field(res, 0, read_list);
Store_field(res, 1, write_list);
Store_field(res, 2, except_list);
DEBUG_PRINT("out select");
CAMLreturn(res);
}
CAMLprim value bigstring_recvmmsg_assume_fd_is_nonblocking_stub(
value v_fd, value v_iovecs, value v_count, value v_srcs, value v_lens)
{
CAMLparam5(v_fd, v_iovecs, v_count, v_srcs, v_lens);
CAMLlocal5(v_iovec, v_buf, v_pos, v_len, v_sockaddrs);
size_t total_len = 0;
struct mmsghdr hdrs[Long_val(v_count)];
union sock_addr_union addrs[Long_val(v_count)];
struct iovec iovecs[Long_val(v_count)];
unsigned i;
ssize_t n_read;
int save_source_addresses;
int fd;
unsigned int count;
save_source_addresses = Is_block(v_srcs);
fd = Int_val(v_fd);
count = (unsigned int) Long_val(v_count);
if (count != Long_val(v_count)) {
caml_invalid_argument("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
"v_count exceeds unsigned int");
}
if (!Is_block(v_lens)) {
caml_invalid_argument("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
"v_lens is not an array");
}
if (Wosize_val(v_lens) < count) {
caml_invalid_argument("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
"length v_lens < count");
}
for (i = 0; i < count; i++) {
hdrs[i].msg_hdr.msg_name = (save_source_addresses ? &addrs[i].s_gen : 0);
hdrs[i].msg_hdr.msg_namelen = sizeof(addrs[i]);
v_iovec = Field(v_iovecs, i);
v_buf = Field(v_iovec, 0);
v_pos = Field(v_iovec, 1);
v_len = Field(v_iovec, 2);
iovecs[i].iov_base = get_bstr(v_buf, v_pos);
iovecs[i].iov_len = Long_val(v_len);
total_len += iovecs[i].iov_len;
hdrs[i].msg_hdr.msg_iov = &iovecs[i];
hdrs[i].msg_hdr.msg_iovlen = 1;
hdrs[i].msg_hdr.msg_control = 0;
hdrs[i].msg_hdr.msg_flags = 0;
}
if (total_len > THREAD_IO_CUTOFF) {
caml_enter_blocking_section();
n_read = recvmmsg(fd, hdrs, count, 0, 0);
caml_leave_blocking_section();
}
else {
n_read = recvmmsg(fd, hdrs, count, 0, 0);
}
if (n_read > count) {
caml_failwith("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
"recvmmsg unexpectedly returned n_read > count");
}
if (n_read == -1) {
uerror("recvmmsg_assume_fd_is_nonblocking", Nothing);
}
else {
if (save_source_addresses) {
v_sockaddrs = Field(v_srcs, 0);
if (!Is_block(v_sockaddrs)) {
caml_invalid_argument("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
"v_sockaddrs is not an array");
}
if (Wosize_val(v_sockaddrs) < count) {
caml_invalid_argument("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
"length v_sockaddrs < count");
}
for (i = 0; i < n_read; i++) {
value addr = alloc_sockaddr(&addrs[i], hdrs[i].msg_hdr.msg_namelen, -1);
Store_field(v_sockaddrs, i, addr);
}
}
for (i = 0; i < n_read; i++) {
Field(v_lens, i) = Val_long(hdrs[i].msg_len);
}
}
CAMLreturn(Val_long(n_read));
}
