Exemple #1
0
CAMLprim value
get_ifnamsiz()
{
  CAMLparam0();
  CAMLreturn(Val_int(IFNAMSIZ));
}
Exemple #2
0
/* 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));
}
Exemple #3
0
CAMLprim value unix_umask(value perm)
{
  return Val_int(umask(Int_val(perm)));
}
Exemple #4
0
CAMLprim value unix_getuid(value unit)
{
  return Val_int(getuid());
}
Exemple #5
0
CAMLprim value caml_dynlink_add_primitive(value handle)
{
  return Val_int(caml_ext_table_add(&caml_prim_table, Handle_val(handle)));
}
Exemple #6
0
value caml_bgzf_getc(value bgzf) {
	CAMLparam1(bgzf);
	CAMLreturn(Val_int(bgzf_getc(BGZF_val(bgzf))));
}
Exemple #7
0
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)));
}
Exemple #8
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);}}
}
Exemple #9
0
CAMLprim value caml_ptrace_seize(value pid) {
    CAMLparam1(pid);
    int res = ptrace(PTRACE_SEIZE, Int_val(pid), NULL, NULL);
    CAMLreturn(Val_int(res));
}
Exemple #10
0
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))));
}
Exemple #12
0
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);
    }
  }
}
Exemple #13
0
CAMLprim value ml_gpointer_get_char (value region, value pos)
{
    return Val_int(*(ml_gpointer_base (region) + Long_val(pos)));
}
Exemple #14
0
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());
}
Exemple #16
0
CAMLprim value caml_ptrace_detach(value pid) {
    CAMLparam1(pid);
    int res = ptrace(PTRACE_DETACH, Int_val(pid), NULL, NULL);
    CAMLreturn(Val_int(res));
}
Exemple #17
0
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);
}
Exemple #18
0
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));
}
Exemple #19
0
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)));
}
Exemple #21
0
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)));
}
Exemple #23
0
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)));
}
Exemple #25
0
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)));
}
Exemple #27
0
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)));
}
Exemple #29
0
CAMLprim value stub_fsevents_get_event_fd(value env)
{
  CAMLparam1(env);
  int fd = ((struct env *)env)->read_event_fd;
  CAMLreturn(Val_int(fd));
}
Exemple #30
0
    /* 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;