示例#1
0
CAMLprim value caml_picosat_assume(value lit) {
    CAMLparam1 (lit);
    picosat_assume(Int_val(lit));
    CAMLreturn(Val_unit);
}
示例#2
0
CAMLprim value sdlimagestub_init(value flags)
{
	CAMLparam1(flags);
	IMG_Init(Initflags_val(flags));
	CAMLreturn(Val_unit);
}
示例#3
0
/*
 * 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);
}
示例#5
0
/* exception occurs */
CAMLprim value brlapiml_setExceptionHandler(value unit)
{
  CAMLparam1(unit);
  brlapi_setExceptionHandler(raise_brlapi_exception);
  CAMLreturn(Val_unit);
}
示例#6
0
/* 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)));
}
示例#7
0
CAMLprim value lwt_unix_invalidate_dir(value dir)
{
    CAMLparam1(dir);
    DIR_Val(dir) = NULL;
    CAMLreturn(Val_unit);
}
示例#8
0
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));
}
示例#9
0
value caml_bgzf_close_in(value bgzf) {
	CAMLparam1(bgzf);
	bgzf_close(BGZF_val(bgzf));
	CAMLreturn(Val_unit);
}
示例#10
0
CAMLprim value caml_ptrace_detach(value pid) {
    CAMLparam1(pid);
    int res = ptrace(PTRACE_DETACH, Int_val(pid), NULL, NULL);
    CAMLreturn(Val_int(res));
}
示例#11
0
/* 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);
}
示例#12
0
CAMLprim value caml_ptrace_seize(value pid) {
    CAMLparam1(pid);
    int res = ptrace(PTRACE_SEIZE, Int_val(pid), NULL, NULL);
    CAMLreturn(Val_int(res));
}
示例#13
0
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);}}
}
示例#14
0
CAMLprim value caml_picosat_corelit(value lit) {
    CAMLparam1 (lit);
    CAMLreturn(Val_int(picosat_corelit(Int_val(lit))));
}
示例#15
0
/* 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))));
}
示例#16
0
value caml_bgzf_getc(value bgzf) {
	CAMLparam1(bgzf);
	CAMLreturn(Val_int(bgzf_getc(BGZF_val(bgzf))));
}
示例#17
0
/* 'a -> t */
CAMLprim value llvm_genericvalue_of_value(value V) {
  CAMLparam1(V);
  CAMLreturn(alloc_generic_value(LLVMCreateGenericValueOfPointer(Op_val(V))));
}
示例#18
0
value caml_bgzf_tell(value bgzf) {
	CAMLparam1(bgzf);
	CAMLreturn(copy_int64(bgzf_tell(BGZF_val(bgzf))));
}
示例#19
0
CAMLprim value stub_fsevents_get_event_fd(value env)
{
  CAMLparam1(env);
  int fd = ((struct env *)env)->read_event_fd;
  CAMLreturn(Val_int(fd));
}
示例#20
0
void camlidl_custom_mpq2_finalize(value val)
{
    CAMLparam1(val);
    __mpq_struct** mpq = (__mpq_struct**)(Data_custom_val(val));
    mpq_clear(*mpq);
}
示例#21
0
//void clear();
value ml_QObjectCleanupHandler_clear_0(value self) {
	CAMLparam1 (self);
	((QObjectCleanupHandler*)self) ->  clear();
	CAMLreturn(Val_unit);
}
示例#22
0
/* 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)));
}
示例#23
0
CAMLprim value lwt_unix_valid_dir(value dir)
{
    CAMLparam1(dir);
    int result = DIR_Val(dir) == NULL ? 0 : 1;
    CAMLreturn(Val_int(result));
}
示例#24
0
/* Llvm.lltype -> t -> float */
CAMLprim value llvm_genericvalue_as_float(LLVMTypeRef Ty, value GenVal) {
  CAMLparam1(GenVal);
  CAMLreturn(copy_double(
    LLVMGenericValueToFloat(Ty, Genericvalue_val(GenVal))));
}
示例#25
0
文件: select.c 项目: OpenXT/ocaml
/* 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);
}
示例#26
0
/* 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)));
}
示例#27
0
CAMLprim value sdlimagestub_quit(value unit)
{
	CAMLparam1(unit);
	IMG_Quit();
	CAMLreturn(Val_unit);
}
示例#28
0
/* 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)));
}
示例#29
0
/*
 * Doesn't make much sense to register commands...
 */
value caml_register_commands(value new_commands) {

   CAMLparam1(new_commands);
   CAMLreturn(Val_unit);

}
示例#30
0
CAMLprim value caml_picosat_set_seed(value seed) {
    CAMLparam1 (seed);
    picosat_set_seed(Unsigned_int_val(seed));
    CAMLreturn(Val_unit);
}