CAMLprim value get_ifnamsiz() { CAMLparam0(); CAMLreturn(Val_int(IFNAMSIZ)); }
/* t -> int */ CAMLprim value llvm_genericvalue_as_int(value GenVal) { assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 8 * sizeof(value) && "Generic value too wide to treat as an int!"); return Val_int(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)); }
CAMLprim value unix_umask(value perm) { return Val_int(umask(Int_val(perm))); }
CAMLprim value unix_getuid(value unit) { return Val_int(getuid()); }
CAMLprim value caml_dynlink_add_primitive(value handle) { return Val_int(caml_ext_table_add(&caml_prim_table, Handle_val(handle))); }
value caml_bgzf_getc(value bgzf) { CAMLparam1(bgzf); CAMLreturn(Val_int(bgzf_getc(BGZF_val(bgzf)))); }
CAMLprim value ml_gsl_linalg_LU_sgndet(value LU, value sig) { _DECLARE_MATRIX(LU); _CONVERT_MATRIX(LU); return Val_int(gsl_linalg_LU_sgndet(&m_LU, Int_val(sig))); }
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_ptrace_seize(value pid) { CAMLparam1(pid); int res = ptrace(PTRACE_SEIZE, Int_val(pid), NULL, NULL); CAMLreturn(Val_int(res)); }
int fib(int n) { return Int_val(caml_callback(*caml_named_value("fib"), Val_int(n))); }
CAMLprim value caml_picosat_corelit(value lit) { CAMLparam1 (lit); CAMLreturn(Val_int(picosat_corelit(Int_val(lit)))); }
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 ml_gpointer_get_char (value region, value pos) { return Val_int(*(ml_gpointer_base (region) + Long_val(pos))); }
CAMLprim value ml_int_at_pointer (value ptr) { return Val_int(*(int*)Pointer_val(ptr)); }
/* noalloc */ value bap_disasm_backends_size_stub(value unit) { return Val_int(bap_disasm_backends_size()); }
CAMLprim value caml_ptrace_detach(value pid) { CAMLparam1(pid); int res = ptrace(PTRACE_DETACH, Int_val(pid), NULL, NULL); CAMLreturn(Val_int(res)); }
value caml_bgzf_set_cache_size(value bgzf, value sz) { CAMLparam2(bgzf,sz); bgzf_set_cache_size(BGZF_val(bgzf),Val_int(sz)); CAMLreturn(Val_unit); }
CAMLprim value caml_ptrace_cont(value pid, value sig) { CAMLparam2(pid, sig); int sig_no = caml_convert_signal_number(Int_val(sig)); int res = ptrace(PTRACE_CONT, Int_val(pid), NULL, sig_no); CAMLreturn(Val_int(res)); }
CAMLprim value ml_gsl_qrng_dimension(value qrng) { return Val_int((Qrng_val(qrng))->dimension); }
/* noalloc */ value bap_disasm_offset_stub(value d) { return Val_int(bap_disasm_offset(Int_val(d))); }
value sys_system_command(value command) /* ML */ { int retcode = system(String_val(command)); if (retcode == -1) sys_error(String_val(command)); return Val_int(retcode); }
/* noalloc */ value bap_disasm_insns_size_stub(value d) { return Val_int(bap_disasm_insns_size(Int_val(d))); }
CAMLprim value brlapiml_errorCode_of_error(value camlError) { CAMLparam1(camlError); CAMLlocal1(result); switch (Int_val(Field(camlError, 0))) { case BRLAPI_ERROR_NOMEM: result = Val_int(0); break; case BRLAPI_ERROR_TTYBUSY: result = Val_int(1); break; case BRLAPI_ERROR_DEVICEBUSY: result = Val_int(2); break; case BRLAPI_ERROR_UNKNOWN_INSTRUCTION: result = Val_int(3); break; case BRLAPI_ERROR_ILLEGAL_INSTRUCTION: result = Val_int(4); break; case BRLAPI_ERROR_INVALID_PARAMETER: result = Val_int(5); break; case BRLAPI_ERROR_INVALID_PACKET: result = Val_int(6); break; case BRLAPI_ERROR_CONNREFUSED: result = Val_int(7); break; case BRLAPI_ERROR_OPNOTSUPP: result = Val_int(8); break; case BRLAPI_ERROR_GAIERR: { result = caml_alloc(1, 0); Store_field(result, 0, Val_int(Field(camlError, 2))); }; break; case BRLAPI_ERROR_LIBCERR: { result = caml_alloc(1, 1); Store_field(result, 0, unix_error_of_code(Int_val(Field(camlError, 1)))); }; break; case BRLAPI_ERROR_UNKNOWNTTY: result = Val_int(9); break; case BRLAPI_ERROR_PROTOCOL_VERSION: result = Val_int(10); break; case BRLAPI_ERROR_EOF: result = Val_int(11); break; case BRLAPI_ERROR_EMPTYKEY: result = Val_int(12); break; case BRLAPI_ERROR_DRIVERERROR: result = Val_int(13); break; case BRLAPI_ERROR_AUTHENTICATION: result = Val_int(14); break; default: { result = caml_alloc(1, 2); Store_field(result, 0, Val_int(Field(camlError, 0))); } } CAMLreturn(result); }
/* noalloc */ value bap_disasm_insn_offset_stub(value d, value i) { return Val_int(bap_disasm_insn_offset(Int_val(d), Int_val(i))); }
void FileProc(ClientData clientdata, int mask) { callback2(*handler_code,Val_int(clientdata),Val_int(0)); }
/* noalloc */ value bap_disasm_insn_ops_size_stub(value d, value i) { return Val_int(bap_disasm_insn_ops_size(Int_val(d), Int_val(i))); }
value unix_getppid() /* ML */ { return Val_int(getppid()); }
/* noalloc */ value bap_disasm_insn_op_reg_code_stub(value d, value i, value j) { return Val_int(bap_disasm_insn_op_reg_code(Int_val(d), Int_val(i), Int_val(j))); }
CAMLprim value stub_fsevents_get_event_fd(value env) { CAMLparam1(env); int fd = ((struct env *)env)->read_event_fd; CAMLreturn(Val_int(fd)); }
/* Maybe this should be htonl? / sestoft */ s->sockaddr_inet.sin_port = htons(Int_val(Port_sapval(sinaddrport))); break; } } } /* Warning: allocates in the heap, may cause a GC */ /* ML result type: addr */ static value newaddr(int len, int namespace, value addrdata) { value res; Push_roots(r,1) r[0] = addrdata; res = alloc_tuple(3); Data_addrval(res) = r[0]; Size_addrval(res) = Val_int(len); Nspace_addrval(res) = Val_int(namespace); Pop_roots(); return (value) res; } /* Warning: allocates in the heap, may cause a GC */ /* Return type: sinaddrport = int * ml_s_addr */ value newsinaddrport(s_addr_t sa, value port) { value res; Push_roots(r,1); r[0] = alloc_tuple(2); Field(r[0], 0) = 0; /* to please the gc */ Field(r[0], 1) = 0;