自学教程：C++ CAMLparam1函数代码示例

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);//.........这里部分代码省略.........

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)      {//.........这里部分代码省略.........

/* 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);}