CAMLprim value PQres_isnull(value v_res)
{
return Val_bool(get_res(v_res) ? 0 : 1);
}
CAMLprim value caml_new_lex_engine(struct lexing_table *tbl, value start_state,
struct lexer_buffer *lexbuf)
{
int state, base, backtrk, c, pstate ;
state = Int_val(start_state);
if (state >= 0) {
/* First entry */
lexbuf->lex_last_pos = lexbuf->lex_start_pos = lexbuf->lex_curr_pos;
lexbuf->lex_last_action = Val_int(-1);
} else {
/* Reentry after refill */
state = -state - 1;
}
while(1) {
/* Lookup base address or action number for current state */
base = Short(tbl->lex_base, state);
if (base < 0) {
int pc_off = Short(tbl->lex_base_code, state) ;
run_tag(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem);
/* fprintf(stderr,"Perform: %d\n",-base-1) ; */
return Val_int(-base-1);
}
/* See if it's a backtrack point */
backtrk = Short(tbl->lex_backtrk, state);
if (backtrk >= 0) {
int pc_off = Short(tbl->lex_backtrk_code, state);
run_tag(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem);
lexbuf->lex_last_pos = lexbuf->lex_curr_pos;
lexbuf->lex_last_action = Val_int(backtrk);
}
/* See if we need a refill */
if (lexbuf->lex_curr_pos >= lexbuf->lex_buffer_len){
if (lexbuf->lex_eof_reached == Val_bool (0)){
return Val_int(-state - 1);
}else{
c = 256;
}
}else{
/* Read next input char */
c = Byte_u(lexbuf->lex_buffer, Long_val(lexbuf->lex_curr_pos));
lexbuf->lex_curr_pos += 2;
}
/* Determine next state */
pstate=state ;
if (Short(tbl->lex_check, base + c) == state)
state = Short(tbl->lex_trans, base + c);
else
state = Short(tbl->lex_default, state);
/* If no transition on this char, return to last backtrack point */
if (state < 0) {
lexbuf->lex_curr_pos = lexbuf->lex_last_pos;
if (lexbuf->lex_last_action == Val_int(-1)) {
caml_failwith("lexing: empty token");
} else {
return lexbuf->lex_last_action;
}
}else{
/* If some transition, get and perform memory moves */
int base_code = Short(tbl->lex_base_code, pstate) ;
int pc_off ;
if (Short(tbl->lex_check_code, base_code + c) == pstate)
pc_off = Short(tbl->lex_trans_code, base_code + c) ;
else
pc_off = Short(tbl->lex_default_code, pstate) ;
if (pc_off > 0)
run_mem(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem,
lexbuf->lex_curr_pos) ;
/* Erase the EOF condition only if the EOF pseudo-character was
consumed by the automaton (i.e. there was no backtrack above)
*/
if (c == 256) lexbuf->lex_eof_reached = Val_bool (0);
}
}
}
CAMLprim value caml_ml_runtime_warnings_enabled(value unit)
{
CAMLassert (unit == Val_unit);
return Val_bool(caml_runtime_warnings);
}
/* Target.t -> bool */
CAMLprim value llvm_target_has_jit(LLVMTargetRef Target) {
return Val_bool(LLVMTargetHasJIT(Target));
}
/* Target.t -> bool */
CAMLprim value llvm_target_has_asm_backend(LLVMTargetRef Target) {
return Val_bool(LLVMTargetHasAsmBackend(Target));
}
/* Returns boolean indicating UTF8-support */
CAMLprim value pcre_config_utf8_stub(value __unused v_unit)
{ return Val_bool(pcre_config_int(PCRE_CONFIG_UTF8)); }
CAMLprim value caml_backtrace_status(value vunit)
{
return Val_bool(caml_backtrace_active);
}
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);}}
}
/* noalloc */
value bap_disasm_predicate_is_supported_stub(value d, value p) {
return Val_bool(bap_disasm_predicate_is_supported(Int_val(d), Pred_val(p)));
}
CAMLextern_C value
caml_sfRenderWindow_isOpen(value win)
{
return Val_bool(
SfRenderWindow_val(win)->isOpen());
}
/* unit -> bool */
CAMLprim value llvm_initialize_native_target(value Unit) {
return Val_bool(LLVMInitializeNativeTarget());
}
value_t c_win32_dial (
value_t _mt,
value_t _entryName,
value_t phoneNumber,
value_t userName,
value_t password,
value_t domain,
value_t callback )
{
char * entryName = String_val ( _entryName );
int mt = Bool_val ( _mt );
DWORD dwRet;
RASDIALPARAMS rdParams;
HRASCONN hRasConn;
CAMLparam5 ( mt, _entryName, phoneNumber, userName, password );
CAMLxparam2 ( domain, callback );
printf ( "Callback passed = 0x%08x, deref = 0x%08x\n",
(unsigned) callback, (unsigned)(*(void **)callback) );
fflush ( stdout );
hRasConn = NULL;
rdParams.dwSize = sizeof(RASDIALPARAMS);
lstrcpy(rdParams.szEntryName, entryName );
lstrcpy(rdParams.szPhoneNumber, String_val ( phoneNumber ) );
lstrcpy(rdParams.szCallbackNumber, "" );
lstrcpy(rdParams.szUserName, String_val ( userName ) );
lstrcpy(rdParams.szPassword, String_val ( password ) );
lstrcpy(rdParams.szDomain, String_val ( domain ) );
cb_info.g_status = 0;
cb_info.mt = mt;
cb_info.p_closure = &callback;
cb_info.entryName = entryName;
textout ( mtINFO, "Dialing %s", entryName );
if (debug_print)
printf ( "I am inside c_win32_dial!\n" );
if ( mt )
enter_blocking_section ();
dwRet = RasDial ( NULL, NULL, &rdParams, 1L,
(RASDIALFUNC) RasDialFunc1, &hRasConn );
if ( mt )
leave_blocking_section ();
if ( dwRet )
{
char szBuf[256];
if ( RasGetErrorString( dwRet, szBuf, 256 ) != 0 )
wsprintf( (LPSTR)szBuf, "Undefined RAS Dial Error (%ld).",
dwRet );
textout ( mtERR, "Error attempting to connect: %s", szBuf );
hangup ( hRasConn );
}
CAMLreturn (Val_bool ( 1 ));
return 0; /* dummy, to shut down warning */
}
CAMLprim value lwt_unix_mapped(value v_bstr) {
return Val_bool(Caml_ba_array_val(v_bstr)->flags & CAML_BA_MAPPED_FILE);
}
PREFIX value ml_elm_fileselector_button_inwin_mode_get(value v_obj)
{
return Val_bool(elm_fileselector_button_inwin_mode_get(
Evas_Object_val(v_obj)));
}
PREFIX value ml_elm_fileselector_multi_select_get(value v_obj)
{
return Val_bool(elm_fileselector_multi_select_get(
(Evas_Object*) v_obj));
}
/* noalloc */
value bap_disasm_insn_satisfies_stub(value d, value i, value p) {
return Val_bool(bap_disasm_insn_satisfies(Int_val(d), Int_val(i), Pred_val(p)));
}
/* Executes a pattern match with runtime options, a regular expression, a
string offset, a string length, a subject string, a number of subgroup
offsets, an offset vector and an optional callout function */
CAMLprim value pcre_exec_stub(value v_opt, value v_rex, value v_ofs,
value v_subj, value v_subgroups2, value v_ovec,
value v_maybe_cof)
{
const int ofs = Int_val(v_ofs), len = caml_string_length(v_subj);
if (ofs > len || ofs < 0)
caml_invalid_argument("Pcre.pcre_exec_stub: illegal offset");
{
const pcre *code = (pcre *) Field(v_rex, 1); /* Compiled pattern */
const pcre_extra *extra = (pcre_extra *) Field(v_rex, 2); /* Extra info */
const char *ocaml_subj = String_val(v_subj); /* Subject string */
const int opt = Int_val(v_opt); /* Runtime options */
int subgroups2 = Int_val(v_subgroups2);
const int subgroups2_1 = subgroups2 - 1;
const int subgroups3 = (subgroups2 >> 1) + subgroups2;
/* Special case when no callout functions specified */
if (v_maybe_cof == None) {
int *ovec = (int *) &Field(v_ovec, 0);
/* Performs the match */
const int ret =
pcre_exec(code, extra, ocaml_subj, len, ofs, opt, ovec, subgroups3);
if (ret < 0) {
switch(ret) {
case PCRE_ERROR_NOMATCH : caml_raise_constant(*pcre_exc_Not_found);
case PCRE_ERROR_PARTIAL : caml_raise_constant(*pcre_exc_Partial);
case PCRE_ERROR_MATCHLIMIT :
caml_raise_constant(*pcre_exc_MatchLimit);
case PCRE_ERROR_BADPARTIAL :
caml_raise_constant(*pcre_exc_BadPartial);
case PCRE_ERROR_BADUTF8 : caml_raise_constant(*pcre_exc_BadUTF8);
case PCRE_ERROR_BADUTF8_OFFSET :
caml_raise_constant(*pcre_exc_BadUTF8Offset);
default :
caml_raise_with_string(*pcre_exc_InternalError, "pcre_exec_stub");
}
}
else {
const int *ovec_src = ovec + subgroups2_1;
long int *ovec_dst = (long int *) ovec + subgroups2_1;
/* Converts offsets from C-integers to OCaml-Integers
This is a bit tricky, because there are 32- and 64-bit platforms
around and OCaml chooses the larger possibility for representing
integers when available (also in arrays) - not so the PCRE */
while (subgroups2--) {
*ovec_dst = Val_int(*ovec_src);
--ovec_src; --ovec_dst;
}
}
}
/* There are callout functions */
else {
value v_cof = Field(v_maybe_cof, 0);
value v_substrings;
char *subj = caml_stat_alloc(sizeof(char) * len);
int *ovec = caml_stat_alloc(sizeof(int) * subgroups3);
int ret;
struct cod cod = { (value *) NULL, (value *) NULL, (value) NULL };
struct pcre_extra new_extra =
#ifdef PCRE_CONFIG_MATCH_LIMIT_RECURSION
{ PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL, 0 };
#else
{ PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL };
#endif
memcpy(subj, ocaml_subj, len);
Begin_roots3(v_rex, v_cof, v_substrings);
Begin_roots2(v_subj, v_ovec);
v_substrings = caml_alloc_small(2, 0);
End_roots();
Field(v_substrings, 0) = v_subj;
Field(v_substrings, 1) = v_ovec;
cod.v_substrings_p = &v_substrings;
cod.v_cof_p = &v_cof;
new_extra.callout_data = &cod;
if (extra == NULL) {
ret = pcre_exec(code, &new_extra, subj, len, ofs, opt, ovec,
subgroups3);
}
else {
new_extra.flags = PCRE_EXTRA_CALLOUT_DATA | extra->flags;
new_extra.study_data = extra->study_data;
new_extra.match_limit = extra->match_limit;
new_extra.tables = extra->tables;
#ifdef PCRE_CONFIG_MATCH_LIMIT_RECURSION
new_extra.match_limit_recursion = extra->match_limit_recursion;
#endif
ret = pcre_exec(code, &new_extra, subj, len, ofs, opt, ovec,
subgroups3);
}
free(subj);
End_roots();
if (ret < 0) {
free(ovec);
switch(ret) {
case PCRE_ERROR_NOMATCH : caml_raise_constant(*pcre_exc_Not_found);
case PCRE_ERROR_PARTIAL : caml_raise_constant(*pcre_exc_Partial);
case PCRE_ERROR_MATCHLIMIT :
caml_raise_constant(*pcre_exc_MatchLimit);
case PCRE_ERROR_BADPARTIAL :
caml_raise_constant(*pcre_exc_BadPartial);
case PCRE_ERROR_BADUTF8 : caml_raise_constant(*pcre_exc_BadUTF8);
case PCRE_ERROR_BADUTF8_OFFSET :
caml_raise_constant(*pcre_exc_BadUTF8Offset);
case PCRE_ERROR_CALLOUT : caml_raise(cod.v_exn);
default :
caml_raise_with_string(*pcre_exc_InternalError, "pcre_exec_stub");
}
}
else {
int *ovec_src = ovec + subgroups2_1;
long int *ovec_dst = &Field(v_ovec, 0) + subgroups2_1;
while (subgroups2--) {
*ovec_dst = Val_int(*ovec_src);
--ovec_src; --ovec_dst;
}
free(ovec);
}
}
}
return Val_unit;
}
/* Byte-code hook for pcre_exec_stub
Needed, because there are more than 5 arguments */
CAMLprim value pcre_exec_stub_bc(value *argv, int __unused argn)
{
return pcre_exec_stub(argv[0], argv[1], argv[2], argv[3],
argv[4], argv[5], argv[6]);
}
/* Generates a new set of chartables for the current locale (see man
page of PCRE */
CAMLprim value pcre_maketables_stub(value __unused v_unit)
{
/* GC will do a full cycle every 100 table set allocations
(one table set consumes 864 bytes -> maximum of 86400 bytes
unreclaimed table sets) */
const value v_res = caml_alloc_final(2, pcre_dealloc_tables, 864, 86400);
Field(v_res, 1) = (value) pcre_maketables();
return v_res;
}
/* Wraps around the isspace-function */
CAMLprim value pcre_isspace_stub(value v_c)
{
return Val_bool(isspace(Int_val(v_c)));
}
/* Returns number of substring associated with a name */
CAMLprim value pcre_get_stringnumber_stub(value v_rex, value v_name)
{
const int ret = pcre_get_stringnumber((pcre *) Field(v_rex, 1),
String_val(v_name));
if (ret == PCRE_ERROR_NOSUBSTRING)
caml_invalid_argument("Named string not found");
return Val_int(ret);
}
/* Returns array of names of named substrings in a regexp */
CAMLprim value pcre_names_stub(value v_rex)
{
CAMLparam0();
CAMLlocal1(v_res);
int name_count;
int entry_size;
const char *tbl_ptr;
int i;
int ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMECOUNT, &name_count);
if (ret != 0)
caml_raise_with_string(*pcre_exc_InternalError, "pcre_names_stub");
ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMEENTRYSIZE, &entry_size);
if (ret != 0)
caml_raise_with_string(*pcre_exc_InternalError, "pcre_names_stub");
ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMETABLE, &tbl_ptr);
if (ret != 0)
caml_raise_with_string(*pcre_exc_InternalError, "pcre_names_stub");
v_res = caml_alloc(name_count, 0);
for (i = 0; i < name_count; ++i) {
value v_name = caml_copy_string(tbl_ptr + 2);
Store_field(v_res, i, v_name);
tbl_ptr += entry_size;
}
CAMLreturn(v_res);
}
//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);
}
/* Returns boolean indicating use of stack recursion */
CAMLprim value pcre_config_stackrecurse_stub(value __unused v_unit)
{ return Val_bool(pcre_config_int(PCRE_CONFIG_STACKRECURSE)); }
value caml_mpi_comm_compare(value comm1, value comm2)
{
int res;
MPI_Comm_compare(Comm_val(comm1), Comm_val(comm2), &res);
return Val_bool(res);
}
CAMLprim value bigstring_is_mmapped_stub(value v_bstr)
{
return
Val_bool((Caml_ba_array_val(v_bstr)->flags & CAML_BA_MAPPED_FILE) != 0);
}
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. */
g_main_context_get_poll_func(gc)(gpollfds, n_fds + count, timeout);
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)) {
src_result = caml_alloc_tuple(3);
src = Field(node, 0);
Field(src_result, 0) = Field(src, 0);
revents = gpollfds[i].revents;
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);
}
/* Target.t -> bool */
CAMLprim value llvm_target_has_target_machine(LLVMTargetRef Target) {
return Val_bool(LLVMTargetHasTargetMachine(Target));
}
CAMLexport value
unix_getsockopt_aux(char * name,
enum option_type ty, int level, int option,
value socket)
{
union option_value optval;
socklen_param_type optsize;
switch (ty) {
case TYPE_BOOL:
case TYPE_INT:
case TYPE_UNIX_ERROR:
optsize = sizeof(optval.i);
break;
case TYPE_LINGER:
optsize = sizeof(optval.lg);
break;
case TYPE_TIMEVAL:
optsize = sizeof(optval.tv);
break;
default:
unix_error(EINVAL, name, Nothing);
}
if (getsockopt(Int_val(socket), level, option,
(void *) &optval, &optsize) == -1)
uerror(name, Nothing);
switch (ty) {
case TYPE_BOOL:
return Val_bool(optval.i);
case TYPE_INT:
return Val_int(optval.i);
case TYPE_LINGER:
if (optval.lg.l_onoff == 0) {
return Val_int(0); /* None */
} else {
value res = alloc_small(1, 0); /* Some */
Init_field(res, 0, Val_int(optval.lg.l_linger));
return res;
}
case TYPE_TIMEVAL:
return copy_double((double) optval.tv.tv_sec
+ (double) optval.tv.tv_usec / 1e6);
case TYPE_UNIX_ERROR:
if (optval.i == 0) {
return Val_int(0); /* None */
} else {
value err, res;
err = unix_error_of_code(optval.i);
Begin_root(err);
res = alloc_small(1, 0); /* Some */
Init_field(res, 0, err);
End_roots();
return res;
}
default:
unix_error(EINVAL, name, Nothing);
}
}
CAMLprim value win_terminate_process(value v_pid)
{
return (Val_bool(TerminateProcess((HANDLE) Long_val(v_pid), 0)));
}
CAMLprim value stub_blk_rw(value unit) {
CAMLparam1(unit);
CAMLreturn(Val_bool(solo5_blk_rw()));
}
CAMLprim value caml_sys_file_exists(value name)
{
struct stat st;
return Val_bool(stat(String_val(name), &st) == 0);
}
PREFIX value ml_elm_fileselector_hidden_visible_get(value v_obj)
{
return Val_bool(elm_fileselector_hidden_visible_get(
(Evas_Object*) v_obj));
}
CAMLprim value caml_eq_float(value f, value g)
{
return Val_bool(Double_val(f) == Double_val(g));
}
CAMLprim value PQconn_isnull(value v_conn)
{
return Val_bool((get_conn(v_conn)) ? 0 : 1);
}