CAMLprim value brlapiml_leaveRawMode(value handle, value unit)
{
CAMLparam2(handle, unit);
brlapi(leaveRawMode);
CAMLreturn(Val_unit);
}
CAMLprim value math_nexttoward(value x, value y) {
CAMLparam2(x, y);
CAMLreturn(caml_copy_double(nexttoward(Double_val(x), Double_val(y))));
}
CAMLprim value math_remainder(value x, value y) {
CAMLparam2(x, y);
CAMLreturn(caml_copy_double(remainder(Double_val(x), Double_val(y))));
}
value hh_shared_init(
value global_size_val,
value heap_size_val
) {
CAMLparam2(global_size_val, heap_size_val);
global_size_b = Long_val(global_size_val);
heap_size = Long_val(heap_size_val);
char* shared_mem;
size_t page_size = getpagesize();
/* The total size of the shared memory. Most of it is going to remain
* virtual. */
size_t shared_mem_size =
global_size_b + 2 * DEP_SIZE_B + HASHTBL_SIZE_B +
heap_size + page_size;
#ifdef _WIN32
/*
We create an anonymous memory file, whose `handle` might be
inherited by slave processes.
This memory file is tagged "reserved" but not "committed". This
means that the memory space will be reserved in the virtual
memory table but the pages will not be bound to any physical
memory yet. Further calls to 'VirtualAlloc' will "commit" pages,
meaning they will be bound to physical memory.
This is behavior that should reflect the 'MAP_NORESERVE' flag of
'mmap' on Unix. But, on Unix, the "commit" is implicit.
Committing the whole shared heap at once would require the same
amount of free space in memory (or in swap file).
*/
HANDLE handle = CreateFileMapping(
INVALID_HANDLE_VALUE,
NULL,
PAGE_READWRITE | SEC_RESERVE,
shared_mem_size >> 32, shared_mem_size & ((1ll << 32) - 1),
NULL);
if (handle == NULL) {
win32_maperr(GetLastError());
uerror("CreateFileMapping", Nothing);
}
if (!SetHandleInformation(handle, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT)) {
win32_maperr(GetLastError());
uerror("SetHandleInformation", Nothing);
}
shared_mem = MapViewOfFileEx(
handle,
FILE_MAP_ALL_ACCESS,
0, 0,
0,
(char *)SHARED_MEM_INIT);
if (shared_mem != (char *)SHARED_MEM_INIT) {
shared_mem = NULL;
win32_maperr(GetLastError());
uerror("MapViewOfFileEx", Nothing);
}
#else /* _WIN32 */
/* MAP_NORESERVE is because we want a lot more virtual memory than what
* we are actually going to use.
*/
int flags = MAP_SHARED | MAP_ANON | MAP_NORESERVE | MAP_FIXED;
int prot = PROT_READ | PROT_WRITE;
shared_mem =
(char*)mmap((void*)SHARED_MEM_INIT, shared_mem_size, prot,
flags, 0, 0);
if(shared_mem == MAP_FAILED) {
printf("Error initializing: %s\n", strerror(errno));
exit(2);
}
#ifdef MADV_DONTDUMP
// We are unlikely to get much useful information out of the shared heap in
// a core file. Moreover, it can be HUGE, and the extensive work done dumping
// it once for each CPU can mean that the user will reboot their machine
// before the much more useful stack gets dumped!
madvise(shared_mem, shared_mem_size, MADV_DONTDUMP);
#endif
// Keeping the pids around to make asserts.
master_pid = getpid();
my_pid = master_pid;
#endif /* _WIN32 */
char* bottom = shared_mem;
init_shared_globals(shared_mem);
// Checking that we did the maths correctly.
assert(*heap + heap_size == bottom + shared_mem_size);
#ifndef _WIN32
// Uninstall ocaml's segfault handler. It's supposed to throw an exception on
// stack overflow, but we don't actually handle that exception, so what
// happens in practice is we terminate at toplevel with an unhandled exception
// and a useless ocaml backtrace. A core dump is actually more useful. Sigh.
struct sigaction sigact;
sigact.sa_handler = SIG_DFL;
sigemptyset(&sigact.sa_mask);
sigact.sa_flags = 0;
sigaction(SIGSEGV, &sigact, NULL);
#endif
set_priorities();
CAMLreturn(Val_unit);
}
void hh_shared_init(
value global_size_val,
value heap_size_val
) {
CAMLparam2(global_size_val, heap_size_val);
global_size_b = Long_val(global_size_val);
heap_size = Long_val(heap_size_val);
/* MAP_NORESERVE is because we want a lot more virtual memory than what
* we are actually going to use.
*/
int flags = MAP_SHARED | MAP_ANON | MAP_NORESERVE | MAP_FIXED;
int prot = PROT_READ | PROT_WRITE;
int page_size = getpagesize();
/* The total size of the shared memory. Most of it is going to remain
* virtual. */
size_t shared_mem_size = global_size_b + 2 * DEP_SIZE_B + HASHTBL_SIZE_B +
heap_size;
char* shared_mem =
(char*)mmap((void*)SHARED_MEM_INIT, page_size + shared_mem_size, prot,
flags, 0, 0);
if(shared_mem == MAP_FAILED) {
printf("Error initializing: %s\n", strerror(errno));
exit(2);
}
#ifdef MADV_DONTDUMP
// We are unlikely to get much useful information out of the shared heap in
// a core file. Moreover, it can be HUGE, and the extensive work done dumping
// it once for each CPU can mean that the user will reboot their machine
// before the much more useful stack gets dumped!
madvise(shared_mem, page_size + shared_mem_size, MADV_DONTDUMP);
#endif
// Keeping the pids around to make asserts.
master_pid = getpid();
my_pid = master_pid;
char* bottom = shared_mem;
init_shared_globals(shared_mem);
// Checking that we did the maths correctly.
assert(*heap + heap_size == bottom + shared_mem_size + page_size);
// Uninstall ocaml's segfault handler. It's supposed to throw an exception on
// stack overflow, but we don't actually handle that exception, so what
// happens in practice is we terminate at toplevel with an unhandled exception
// and a useless ocaml backtrace. A core dump is actually more useful. Sigh.
struct sigaction sigact;
sigact.sa_handler = SIG_DFL;
sigemptyset(&sigact.sa_mask);
sigact.sa_flags = 0;
sigaction(SIGSEGV, &sigact, NULL);
set_priorities();
CAMLreturn0;
}
CAMLprim value getsockopt_stub(value sock, value sockopt) {
CAMLparam2 (sock, sockopt);
CAMLlocal1 (result);
int error = -1;
int native_sockopt = Int_val(sockopt);
struct wrap *socket = Socket_val(sock);
switch (native_sockopt) {
case ZMQ_SNDHWM:
case ZMQ_RCVHWM:
case ZMQ_RATE:
case ZMQ_RECOVERY_IVL:
case ZMQ_SNDBUF:
case ZMQ_RCVBUF:
case ZMQ_LINGER:
case ZMQ_RECONNECT_IVL:
case ZMQ_RECONNECT_IVL_MAX:
case ZMQ_BACKLOG:
case ZMQ_MULTICAST_HOPS:
case ZMQ_RCVTIMEO:
case ZMQ_SNDTIMEO:
case ZMQ_RCVMORE:
case ZMQ_RCVLABEL:
case ZMQ_TYPE:
{
int res;
size_t size = sizeof(res);
error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size);
stub_raise_if (error == -1);
result = Val_int(res);
}
break;
case ZMQ_AFFINITY:
case ZMQ_MAXMSGSIZE:
{
int64 res;
size_t size = sizeof(res);
error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size);
stub_raise_if (error == -1);
result = caml_copy_int64(res);
}
break;
case ZMQ_EVENTS:
{
int res;
size_t size = sizeof(res);
error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size);
stub_raise_if (error == -1);
result = POOL_LIST_CACHE[res];
}
break;
case ZMQ_IDENTITY:
{
char buffer[256];
buffer[255] = '\0';
size_t size = sizeof(buffer);
error = zmq_getsockopt(socket->wrapped, native_sockopt, buffer, &size);
stub_raise_if (error == -1);
if (size == 0) {
result = EMPTY_STRING;
} else {
result = caml_copy_string(buffer);
}
}
break;
case ZMQ_FD:
{
#if defined(_WIN32) || defined(_WIN64)
SOCKET fd;
#else
int fd;
#endif
size_t size = sizeof (fd);
error = zmq_getsockopt (socket->wrapped, native_sockopt, (void *) (&fd), &size);
stub_raise_if (error == -1);
#if defined(_WIN32) || defined(_WIN64)
result = win_alloc_socket(fd);
#else
result = Val_int(fd);
#endif
}
break;
default:
caml_failwith("Bidings error");
}
CAMLreturn (result);
}
CAMLprim value caml_mdb_dbi_close(value env,value dbi){
CAMLparam2(env,dbi);
mdb_dbi_close((MDB_env*)env,(MDB_dbi) Int_val(dbi));
CAMLreturn0;
}
/*
* Linear Solvers
*/
CAMLprim value sundials_ml_ida_dense(value ida_solver, value N) {
CAMLparam2(ida_solver, N);
const int ret = IDADense(IDA_MEM(ida_solver), Int_val(N));
CAMLreturn(Val_int(ret));
}
CAMLprim value sundials_ml_ida_sptfqmr(value ida_solver, value maxl) {
CAMLparam2(ida_solver, maxl);
const int ret = IDASptfqmr(IDA_MEM(ida_solver), Int_val(maxl));
CAMLreturn(Val_int(ret));
}
value caml_history_truncate_file(value name, value len) {
CAMLparam2(name,len);
CAMLreturn(Val_unit);
}
CAMLprim value sundials_ml_fvector_get(value a, value i) {
CAMLparam2(a, i);
double* d = Caml_ba_array_val(a)->data;
CAMLreturn(caml_copy_double(d[Int_val(i)]));
}
static int compareHandle(value h1, value h2)
{
CAMLparam2(h1, h2);
CAMLreturn(memcmp(Data_custom_val(h1), Data_custom_val(h2), brlapi_getHandleSize()));
}
CAMLprim value brlapiml_resumeDriver(value handle, value unit)
{
CAMLparam2(handle, unit);
brlapi(resumeDriver);
CAMLreturn(Val_unit);
}
CAMLprim value brlapiml_suspendDriver(value handle, value driverName)
{
CAMLparam2(handle, driverName);
brlapiCheckError(suspendDriver, String_val(driverName));
CAMLreturn(Val_unit);
}
CAMLprim value sundials_ml_ida_set_constraints(value ida_solver, value constraints) {
CAMLparam2(ida_solver, constraints);
BA_STACK_NVECTOR(constraints, nv_constraints);
const int ret = IDASetConstraints(IDA_MEM(ida_solver), &nv_constraints);
CAMLreturn(Val_int(ret));
}
/*
* Main solver optional input functions
* TODO: complete
*/
CAMLprim value sundials_ml_ida_set_max_ord(value ida_solver, value maxord) {
CAMLparam2(ida_solver, maxord);
const int ret = IDASetMaxOrd(IDA_MEM(ida_solver), Int_val(maxord));
CAMLreturn(Val_int(ret));
}
CAMLprim value sundials_ml_ida_get_last_step(value ida_solver, value hlast) {
CAMLparam2(ida_solver, hlast);
double* _hlast = (double*)Field(hlast, 0);
const int ret = IDAGetLastStep(IDA_MEM(ida_solver), _hlast);
CAMLreturn(Val_int(ret));
}
CAMLprim value sundials_ml_ida_set_max_num_steps(value ida_solver, value maxsteps) {
CAMLparam2(ida_solver, maxsteps);
const int ret = IDASetMaxNumSteps(IDA_MEM(ida_solver), Int_val(maxsteps));
CAMLreturn(Val_int(ret));
}
CAMLprim value win_stat(value path, value wpath)
{
int res, mode;
HANDLE h;
BY_HANDLE_FILE_INFORMATION info;
CAMLparam2(path,wpath);
CAMLlocal1 (v);
h = CreateFileW ((LPCWSTR) String_val (wpath), 0, 0, NULL, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS | FILE_ATTRIBUTE_READONLY, NULL);
if (h == INVALID_HANDLE_VALUE) {
win32_maperr (GetLastError ());
uerror("stat", path);
}
res = GetFileInformationByHandle (h, &info);
if (res == 0) {
win32_maperr (GetLastError ());
(void) CloseHandle (h);
uerror("stat", path);
}
res = CloseHandle (h);
if (res == 0) {
win32_maperr (GetLastError ());
uerror("stat", path);
}
v = caml_alloc (12, 0);
Store_field (v, 0, Val_int (info.dwVolumeSerialNumber));
// Apparently, we cannot trust the inode number to be stable when
// nFileIndexHigh is 0.
if (info.nFileIndexHigh == 0) info.nFileIndexLow = 0;
/* The ocaml code truncates inode numbers to 31 bits. We hash the
low and high parts in order to lose as little information as
possible. */
Store_field
(v, 1, Val_int (MAKEDWORDLONG(info.nFileIndexLow,info.nFileIndexHigh)+155825701*((DWORDLONG)info.nFileIndexHigh)));
Store_field
(v, 2, Val_int (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY
? 1: 0));
mode = 0000444;
if (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
mode |= 0000111;
if (!(info.dwFileAttributes & FILE_ATTRIBUTE_READONLY))
mode |= 0000222;
Store_field (v, 3, Val_int(mode));
Store_field (v, 4, Val_int (info.nNumberOfLinks));
Store_field (v, 5, Val_int (0));
Store_field (v, 6, Val_int (0));
Store_field (v, 7, Val_int (0));
Store_field
(v, 8, copy_int64(MAKEDWORDLONG(info.nFileSizeLow,info.nFileSizeHigh)));
Store_field
(v, 9, copy_double((double) FILETIME_TO_TIME(info.ftLastAccessTime)));
Store_field
(v, 10, copy_double((double) FILETIME_TO_TIME(info.ftLastWriteTime)));
Store_field
(v, 11, copy_double((double) FILETIME_TO_TIME(info.ftCreationTime)));
CAMLreturn (v);
}
CAMLprim value sundials_ml_ida_set_init_step(value ida_solver, value hin) {
CAMLparam2(ida_solver, hin);
const int ret = IDASetInitStep(IDA_MEM(ida_solver), Double_val(hin));
CAMLreturn(Val_int(ret));
}
value xdiff_revpatch( value old_data, value patch)
{
CAMLparam2 (old_data, patch);
CAMLlocal1(res);
mmfile_t mf1, mf2, mf3, mf4;
xdemitcb_t ecb, rjecb;
long new_size, rej_size;
res = alloc_tuple(2);
if (xdlt_store_mmfile(String_val(old_data), string_length(old_data), &mf1) < 0) {
sprintf(ELINE, "%s:%d failed", __FILE__, __LINE__);
failwith(ELINE);
}
if (xdlt_store_mmfile(String_val(patch), string_length(patch), &mf2) < 0) {
xdl_free_mmfile(&mf1);
sprintf(ELINE, "%s:%d failed", __FILE__, __LINE__);
failwith(ELINE);
}
if (xdl_init_mmfile(&mf3, XDLT_STD_BLKSIZE, XDL_MMF_ATOMIC) < 0) {
xdl_free_mmfile(&mf1);
xdl_free_mmfile(&mf2);
sprintf(ELINE, "%s:%d failed", __FILE__, __LINE__);
failwith(ELINE);
}
if (xdl_init_mmfile(&mf4, XDLT_STD_BLKSIZE, XDL_MMF_ATOMIC) < 0) {
xdl_free_mmfile(&mf1);
xdl_free_mmfile(&mf2);
xdl_free_mmfile(&mf3);
sprintf(ELINE, "%s:%d failed", __FILE__, __LINE__);
failwith(ELINE);
}
ecb.priv = &mf3;
ecb.outf = xdlt_outf;
rjecb.priv = &mf4;
rjecb.outf = xdlt_outf;
if (xdl_patch(&mf1, &mf2, XDL_PATCH_REVERSE, &ecb, &rjecb) < 0) {
xdl_free_mmfile(&mf1);
xdl_free_mmfile(&mf2);
xdl_free_mmfile(&mf3);
xdl_free_mmfile(&mf4);
sprintf(ELINE, "%s:%d failed", __FILE__, __LINE__);
failwith(ELINE);
}
new_size = xdlt_mmfile_size(&mf3);
rej_size = xdlt_mmfile_size(&mf4);
Field(res, 0) = alloc_string(new_size);
Field(res, 1) = alloc_string(rej_size);
if (xdlt_read_mmfile(String_val(Field(res, 0)), &mf3) < 0) {
xdl_free_mmfile(&mf1);
xdl_free_mmfile(&mf2);
xdl_free_mmfile(&mf3);
xdl_free_mmfile(&mf4);
sprintf(ELINE, "%s:%d failed", __FILE__, __LINE__);
failwith(ELINE);
}
if (xdlt_read_mmfile(String_val(Field(res, 1)), &mf4) < 0) {
xdl_free_mmfile(&mf1);
xdl_free_mmfile(&mf2);
xdl_free_mmfile(&mf3);
xdl_free_mmfile(&mf4);
sprintf(ELINE, "%s:%d failed", __FILE__, __LINE__);
failwith(ELINE);
}
xdl_free_mmfile(&mf1);
xdl_free_mmfile(&mf2);
xdl_free_mmfile(&mf3);
xdl_free_mmfile(&mf4);
CAMLreturn(res);
}
CAMLprim value sundials_ml_ida_set_max_step(value ida_solver, value hmax) {
CAMLparam2(ida_solver, hmax);
const int ret = IDASetMaxStep(IDA_MEM(ida_solver), Double_val(hmax));
CAMLreturn(Val_int(ret));
}
extern "C" value C_important_lit (value solver_In, value lit_in)
{
CAMLparam2 (solver_In, lit_in);
CAMLreturn(Val_unit);
}
CAMLprim value sundials_ml_ida_set_stop_time(value ida_solver, value tstop) {
CAMLparam2(ida_solver, tstop);
const int ret = IDASetStopTime(IDA_MEM(ida_solver), Double_val(tstop));
CAMLreturn(Val_int(ret));
}
CAMLprim value caml_bjack_set_volume_effect_type(value d, value type)
{
CAMLparam2(d,type);
CAMLreturn(Val_int(JACK_SetVolumeEffectType(Bjack_drv_val(d),Int_val(type))));
}
CAMLprim value sundials_ml_ida_set_max_err_test_fails(value ida_solver, value maxnef) {
CAMLparam2(ida_solver, maxnef);
const int ret = IDASetMaxErrTestFails(IDA_MEM(ida_solver), Int_val(maxnef));
CAMLreturn(Val_int(ret));
}
CAMLprim value math_pow(value x, value y) {
CAMLparam2(x, y);
CAMLreturn(caml_copy_double(pow(Double_val(x), Double_val(y))));
}
CAMLprim value sundials_ml_ida_set_id(value ida_solver, value id) {
CAMLparam2(ida_solver, id);
BA_STACK_NVECTOR(id, nv_id);
const int ret = IDASetId(IDA_MEM(ida_solver), &nv_id);
CAMLreturn(Val_int(ret));
}
CAMLprim value math_scalbln(value x, value y) {
CAMLparam2(x, y);
CAMLreturn(caml_copy_double(scalbln(Double_val(x), Int64_val(y))));
}
CAMLprim value brlapiml_enterRawMode(value handle, value driverName)
{
CAMLparam2(handle, driverName);
brlapiCheckError(enterRawMode, String_val(driverName));
CAMLreturn(Val_unit);
}
