CAMLprim value caml_picosat_assume(value lit) {
CAMLparam1 (lit);
picosat_assume(Int_val(lit));
CAMLreturn(Val_unit);
}
CAMLprim value sdlimagestub_init(value flags)
{
CAMLparam1(flags);
IMG_Init(Initflags_val(flags));
CAMLreturn(Val_unit);
}
/*
* Nothing to initialize :)
*/
value caml_initialize_readline(value unit) {
CAMLparam1(unit);
CAMLreturn(Val_unit);
}
//bool isEmpty() const ;
value ml_QObjectCleanupHandler_isEmpty_0(value self) {
CAMLparam1 (self);
CAMLlocal1(calling_result);
calling_result = Val_bool (((QObjectCleanupHandler*)self) -> isEmpty());
CAMLreturn(calling_result);
}
/* exception occurs */
CAMLprim value brlapiml_setExceptionHandler(value unit)
{
CAMLparam1(unit);
brlapi_setExceptionHandler(raise_brlapi_exception);
CAMLreturn(Val_unit);
}
/* Llvm.lltype -> int32 -> t */
CAMLprim value llvm_genericvalue_of_int32(LLVMTypeRef Ty, value Int32) {
CAMLparam1(Int32);
CAMLreturn(alloc_generic_value(
LLVMCreateGenericValueOfInt(Ty, Int32_val(Int32), 1)));
}
CAMLprim value lwt_unix_invalidate_dir(value dir)
{
CAMLparam1(dir);
DIR_Val(dir) = NULL;
CAMLreturn(Val_unit);
}
value caml_bgzf_open_in(value fn) {
CAMLparam1(fn);
BGZF *bgzf = bgzf_open(String_val(fn),"r");
if(bgzf == NULL) caml_failwith("BGZF.open_in");
CAMLreturn(alloc_bgzf(bgzf));
}
value caml_bgzf_close_in(value bgzf) {
CAMLparam1(bgzf);
bgzf_close(BGZF_val(bgzf));
CAMLreturn(Val_unit);
}
CAMLprim value caml_ptrace_detach(value pid) {
CAMLparam1(pid);
int res = ptrace(PTRACE_DETACH, Int_val(pid), NULL, NULL);
CAMLreturn(Val_int(res));
}
/* alloc */
value bap_disasm_backend_name_stub(value n) {
CAMLparam1(n);
CAMLlocal1(s);
s = caml_copy_string(bap_disasm_backend_name(Int_val(n)));
CAMLreturn(s);
}
CAMLprim value caml_ptrace_seize(value pid) {
CAMLparam1(pid);
int res = ptrace(PTRACE_SEIZE, Int_val(pid), NULL, NULL);
CAMLreturn(Val_int(res));
}
value spoc_getCudaDevice(value i)
{
CAMLparam1(i);
CAMLlocal4(general_info, cuda_info, specific_info, gc_info);
CAMLlocal3(device, maxT, maxG);
int nb_devices;
CUdevprop dev_infos;
CUdevice dev;
CUcontext ctx;
CUstream queue[2];
spoc_cu_context *spoc_ctx;
//CUcontext gl_ctx;
char infoStr[1024];
int infoInt;
size_t infoUInt;
int major, minor;
enum cudaError_enum cuda_error;
cuDeviceGetCount (&nb_devices);
if ((Int_val(i)) > nb_devices)
raise_constant(*caml_named_value("no_cuda_device")) ;
CUDA_CHECK_CALL(cuDeviceGet(&dev, Int_val(i)));
CUDA_CHECK_CALL(cuDeviceGetProperties(&dev_infos, dev));
general_info = caml_alloc (9, 0);
CUDA_CHECK_CALL(cuDeviceGetName(infoStr, sizeof(infoStr), dev));
Store_field(general_info,0, copy_string(infoStr));//
CUDA_CHECK_CALL(cuDeviceTotalMem(&infoUInt, dev));
Store_field(general_info,1, Val_int(infoUInt));//
Store_field(general_info,2, Val_int(dev_infos.sharedMemPerBlock));//
Store_field(general_info,3, Val_int(dev_infos.clockRate));//
Store_field(general_info,4, Val_int(dev_infos.totalConstantMemory));//
CUDA_CHECK_CALL(cuDeviceGetAttribute(&infoInt, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT, dev));
Store_field(general_info,5, Val_int(infoInt));//
CUDA_CHECK_CALL(cuDeviceGetAttribute(&infoInt, CU_DEVICE_ATTRIBUTE_ECC_ENABLED, dev));
Store_field(general_info,6, Val_bool(infoInt));//
Store_field(general_info,7, i);
CUDA_CHECK_CALL(cuCtxCreate (&ctx,
CU_CTX_SCHED_BLOCKING_SYNC | CU_CTX_MAP_HOST,
dev));
spoc_ctx = malloc(sizeof(spoc_cl_context));
spoc_ctx->ctx = ctx;
CUDA_CHECK_CALL(cuStreamCreate(&queue[0], 0));
CUDA_CHECK_CALL(cuStreamCreate(&queue[1], 0));
spoc_ctx->queue[0] = queue[0];
spoc_ctx->queue[1] = queue[1];
Store_field(general_info,8, (value)spoc_ctx);
CUDA_CHECK_CALL(cuCtxSetCurrent(ctx));
cuda_info = caml_alloc(1, 0); //0 -> Cuda
specific_info = caml_alloc(18, 0);
cuDeviceComputeCapability(&major, &minor, dev);
Store_field(specific_info,0, Val_int(major));//
Store_field(specific_info,1, Val_int(minor));//
Store_field(specific_info,2, Val_int(dev_infos.regsPerBlock));//
Store_field(specific_info,3, Val_int(dev_infos.SIMDWidth));//
Store_field(specific_info,4, Val_int(dev_infos.memPitch));//
Store_field(specific_info,5, Val_int(dev_infos.maxThreadsPerBlock));//
maxT = caml_alloc(3, 0);
Store_field(maxT,0, Val_int(dev_infos.maxThreadsDim[0]));//
Store_field(maxT,1, Val_int(dev_infos.maxThreadsDim[1]));//
Store_field(maxT,2, Val_int(dev_infos.maxThreadsDim[2]));//
Store_field(specific_info,6, maxT);
maxG = caml_alloc(3, 0);
Store_field(maxG,0, Val_int(dev_infos.maxGridSize[0]));//
Store_field(maxG,1, Val_int(dev_infos.maxGridSize[1]));//
Store_field(maxG,2, Val_int(dev_infos.maxGridSize[2]));//
Store_field(specific_info,7, maxG);
Store_field(specific_info,8, Val_int(dev_infos.textureAlign));//
cuDeviceGetAttribute(&infoInt, CU_DEVICE_ATTRIBUTE_GPU_OVERLAP, dev);
Store_field(specific_info,9, Val_bool(infoInt));//
cuDeviceGetAttribute(&infoInt, CU_DEVICE_ATTRIBUTE_KERNEL_EXEC_TIMEOUT, dev);
Store_field(specific_info,10, Val_bool(infoInt));//
cuDeviceGetAttribute(&infoInt, CU_DEVICE_ATTRIBUTE_INTEGRATED, dev);
Store_field(specific_info,11, Val_bool(infoInt));//
cuDeviceGetAttribute(&infoInt, CU_DEVICE_ATTRIBUTE_CAN_MAP_HOST_MEMORY, dev);
Store_field(specific_info,12, Val_bool(infoInt));//
cuDeviceGetAttribute(&infoInt, CU_DEVICE_ATTRIBUTE_COMPUTE_MODE, dev);
Store_field(specific_info,13, Val_int(infoInt));//
cuDeviceGetAttribute(&infoInt, CU_DEVICE_ATTRIBUTE_CONCURRENT_KERNELS, dev);
Store_field(specific_info,14, Val_bool(infoInt));//
cuDeviceGetAttribute(&infoInt, CU_DEVICE_ATTRIBUTE_PCI_BUS_ID, dev);
Store_field(specific_info,15, Val_int(infoInt));
cuDeviceGetAttribute(&infoInt, CU_DEVICE_ATTRIBUTE_PCI_DEVICE_ID, dev);
Store_field(specific_info,16, Val_int(infoInt));
cuDriverGetVersion(&infoInt);
Store_field(specific_info, 17, Val_int(infoInt));
Store_field(cuda_info, 0, specific_info);
device = caml_alloc(4, 0);
Store_field(device, 0, general_info);
Store_field(device, 1, cuda_info);
{spoc_cuda_gc_info* gcInfo = (spoc_cuda_gc_info*)malloc(sizeof(spoc_cuda_gc_info));
CUDA_CHECK_CALL(cuMemGetInfo(&infoUInt, NULL));
infoUInt -= (32*1024*1024);
Store_field(device, 2, (value)gcInfo);
{cuda_event_list* events = NULL;
Store_field(device, 3, (value)events);
CAMLreturn(device);}}
}
CAMLprim value caml_picosat_corelit(value lit) {
CAMLparam1 (lit);
CAMLreturn(Val_int(picosat_corelit(Int_val(lit))));
}
/* Llvm.lltype -> float -> t */
CAMLprim value llvm_genericvalue_of_float(LLVMTypeRef Ty, value N) {
CAMLparam1(N);
CAMLreturn(alloc_generic_value(
LLVMCreateGenericValueOfFloat(Ty, Double_val(N))));
}
value caml_bgzf_getc(value bgzf) {
CAMLparam1(bgzf);
CAMLreturn(Val_int(bgzf_getc(BGZF_val(bgzf))));
}
/* 'a -> t */
CAMLprim value llvm_genericvalue_of_value(value V) {
CAMLparam1(V);
CAMLreturn(alloc_generic_value(LLVMCreateGenericValueOfPointer(Op_val(V))));
}
value caml_bgzf_tell(value bgzf) {
CAMLparam1(bgzf);
CAMLreturn(copy_int64(bgzf_tell(BGZF_val(bgzf))));
}
CAMLprim value stub_fsevents_get_event_fd(value env)
{
CAMLparam1(env);
int fd = ((struct env *)env)->read_event_fd;
CAMLreturn(Val_int(fd));
}
void camlidl_custom_mpq2_finalize(value val)
{
CAMLparam1(val);
__mpq_struct** mpq = (__mpq_struct**)(Data_custom_val(val));
mpq_clear(*mpq);
}
//void clear();
value ml_QObjectCleanupHandler_clear_0(value self) {
CAMLparam1 (self);
((QObjectCleanupHandler*)self) -> clear();
CAMLreturn(Val_unit);
}
/* Llvm.lltype -> nativeint -> t */
CAMLprim value llvm_genericvalue_of_nativeint(LLVMTypeRef Ty, value NatInt) {
CAMLparam1(NatInt);
CAMLreturn(alloc_generic_value(
LLVMCreateGenericValueOfInt(Ty, Nativeint_val(NatInt), 1)));
}
CAMLprim value lwt_unix_valid_dir(value dir)
{
CAMLparam1(dir);
int result = DIR_Val(dir) == NULL ? 0 : 1;
CAMLreturn(Val_int(result));
}
/* Llvm.lltype -> t -> float */
CAMLprim value llvm_genericvalue_as_float(LLVMTypeRef Ty, value GenVal) {
CAMLparam1(GenVal);
CAMLreturn(copy_double(
LLVMGenericValueToFloat(Ty, Genericvalue_val(GenVal))));
}
/* Choose what to do with given data */
LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode, value fd)
{
LPSELECTDATA res;
HANDLE hFileDescr;
void *lpOrig;
struct sockaddr sa;
int sa_len;
BOOL alreadyAdded;
CAMLparam1(fd);
res = lpSelectData;
hFileDescr = Handle_val(fd);
lpOrig = (void *)fd;
sa_len = sizeof(sa);
alreadyAdded = FALSE;
#ifdef DBUG
dbug_print("Begin dispatching handle %x", hFileDescr);
#endif
#ifdef DBUG
dbug_print("Waiting for %d on handle %x", EMode, hFileDescr);
#endif
/* There is only 2 way to have except mode: transmission of OOB data through
a socket TCP/IP and through a strange interaction with a TTY.
With windows, we only consider the TCP/IP except condition
*/
switch(get_handle_type(fd))
{
case SELECT_HANDLE_DISK:
#ifdef DBUG
dbug_print("Handle %x is a disk handle", hFileDescr);
#endif
/* Disk is always ready in read/write operation */
if (EMode == SELECT_MODE_READ || EMode == SELECT_MODE_WRITE)
{
res = static_poll_add(res, EMode, hFileDescr, lpOrig);
};
break;
case SELECT_HANDLE_CONSOLE:
#ifdef DBUG
dbug_print("Handle %x is a console handle", hFileDescr);
#endif
/* Console is always ready in write operation, need to check for read. */
if (EMode == SELECT_MODE_READ)
{
res = read_console_poll_add(res, EMode, hFileDescr, lpOrig);
}
else if (EMode == SELECT_MODE_WRITE)
{
res = static_poll_add(res, EMode, hFileDescr, lpOrig);
};
break;
case SELECT_HANDLE_PIPE:
#ifdef DBUG
dbug_print("Handle %x is a pipe handle", hFileDescr);
#endif
/* Console is always ready in write operation, need to check for read. */
if (EMode == SELECT_MODE_READ)
{
#ifdef DBUG
dbug_print("Need to check availability of data on pipe");
#endif
res = read_pipe_poll_add(res, EMode, hFileDescr, lpOrig);
}
else if (EMode == SELECT_MODE_WRITE)
{
#ifdef DBUG
dbug_print("No need to check availability of data on pipe, write operation always possible");
#endif
res = static_poll_add(res, EMode, hFileDescr, lpOrig);
};
break;
case SELECT_HANDLE_SOCKET:
#ifdef DBUG
dbug_print("Handle %x is a socket handle", hFileDescr);
#endif
if (getsockname((SOCKET)hFileDescr, &sa, &sa_len) == SOCKET_ERROR)
{
if (WSAGetLastError() == WSAEINVAL)
{
/* Socket is not bound */
#ifdef DBUG
dbug_print("Socket is not connected");
#endif
if (EMode == SELECT_MODE_WRITE || EMode == SELECT_MODE_READ)
{
res = static_poll_add(res, EMode, hFileDescr, lpOrig);
alreadyAdded = TRUE;
}
}
}
if (!alreadyAdded)
{
res = socket_poll_add(res, EMode, hFileDescr, lpOrig);
}
break;
default:
#ifdef DBUG
dbug_print("Handle %x is unknown", hFileDescr);
#endif
caml_failwith("Unknown handle");
break;
};
#ifdef DBUG
dbug_print("Finish dispatching handle %x", hFileDescr);
#endif
CAMLreturnT(LPSELECTDATA, res);
}
/* t -> int64 */
CAMLprim value llvm_genericvalue_as_int64(value GenVal) {
CAMLparam1(GenVal);
assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 64
&& "Generic value too wide to treat as an int64!");
CAMLreturn(copy_int64(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)));
}
CAMLprim value sdlimagestub_quit(value unit)
{
CAMLparam1(unit);
IMG_Quit();
CAMLreturn(Val_unit);
}
/* t -> nativeint */
CAMLprim value llvm_genericvalue_as_nativeint(value GenVal) {
CAMLparam1(GenVal);
assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 8 * sizeof(value)
&& "Generic value too wide to treat as a nativeint!");
CAMLreturn(copy_nativeint(LLVMGenericValueToInt(Genericvalue_val(GenVal),1)));
}
/*
* Doesn't make much sense to register commands...
*/
value caml_register_commands(value new_commands) {
CAMLparam1(new_commands);
CAMLreturn(Val_unit);
}
CAMLprim value caml_picosat_set_seed(value seed) {
CAMLparam1 (seed);
picosat_set_seed(Unsigned_int_val(seed));
CAMLreturn(Val_unit);
}