C++ CAMLparam5函数代码示例

value ml_ut_format( value u, value encoding, value names, value basic, value max_length ) {
    CAMLparam5( u, encoding, names, basic, max_length );
    CAMLlocal1( ml_buf );

    int opts =
        Int_val( encoding ) |
        (Int_val( basic ) ? UT_DEFINITION : 0) |
        (Int_val( names ) ? UT_NAMES : 0);

    int result;
    char *buf;
    buf = (char *)malloc( sizeof(char) * Int_val( max_length ) );
    if ( buf == NULL ) {
        caml_failwith( "Unable to allocate buffer" );
    }

    result = ut_format( UD_ut_unit_val( u ), buf, Int_val( max_length ), opts );
    if ( result == -1 ) {
        caml_raise_with_arg( *caml_named_value( "ut status exception" ), Val_int( ut_get_status() ) );
    }

    ml_buf = caml_copy_string( buf );

    free( buf );

    CAMLreturn( ml_buf );
}

CAMLprim value sunml_idas_superlumtb_init (value vparent_which,
				       value vneqs, value vnnz,
				       value vnthreads, value vusesens)
{
    CAMLparam5(vparent_which, vneqs, vnnz, vnthreads, vusesens);
#if SUNDIALS_LIB_VERSION < 300
    void *ida_mem = IDA_MEM_FROM_ML (Field(vparent_which, 0));
    int which = Int_val(Field(vparent_which, 1));
    int flag;

    flag = IDASuperLUMTB (ida_mem, which, Int_val(vnthreads), Int_val(vneqs),
			 Int_val(vnnz));
    CHECK_FLAG ("IDASuperLUMTB", flag);
    if (Bool_val(vusesens)) {
	flag = IDASlsSetSparseJacFnBS(ida_mem, which, jacfn_withsens);
	CHECK_FLAG("IDASlsSetSparseJacFnBS", flag);
    } else {
	flag = IDASlsSetSparseJacFnB (ida_mem, which, jacfn_nosens);
	CHECK_FLAG("IDASlsSetSparseJacFnB", flag);
    }
#else
    caml_raise_constant(SUNDIALS_EXN(NotImplementedBySundialsVersion));
#endif
    CAMLreturn (Val_unit);
}

CAMLprim value stub_xc_hvm_build_native(value xc_handle, value domid,
                                        value mem_max_mib, value mem_start_mib, value image_name, value store_evtchn, value console_evtchn)
{
    CAMLparam5(xc_handle, domid, mem_max_mib, mem_start_mib, image_name);
    CAMLxparam2(store_evtchn, console_evtchn);
    CAMLlocal1(result);

    char *image_name_c = strdup(String_val(image_name));
    char *error[256];
    xc_interface *xch;

    unsigned long store_mfn=0;
    unsigned long console_mfn=0;
    int r;
    struct flags f;
    /* The xenguest interface changed and was backported to XCP: */
#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
    struct xc_hvm_build_args args;
#endif
    get_flags(&f, _D(domid));

    xch = _H(xc_handle);
    configure_vcpus(xch, _D(domid), f);
    configure_tsc(xch, _D(domid), f);

#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
    args.mem_size = (uint64_t)Int_val(mem_max_mib) << 20;
    args.mem_target = (uint64_t)Int_val(mem_start_mib) << 20;
    args.mmio_size = f.mmio_size_mib << 20;
    args.image_file_name = image_name_c;
#endif

    caml_enter_blocking_section ();
#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
    r = xc_hvm_build(xch, _D(domid), &args);
#else
    r = xc_hvm_build_target_mem(xch, _D(domid),
                                Int_val(mem_max_mib),
                                Int_val(mem_start_mib),
                                image_name_c);
#endif
    caml_leave_blocking_section ();

    free(image_name_c);

    if (r)
        failwith_oss_xc(xch, "hvm_build");


    r = hvm_build_set_params(xch, _D(domid), Int_val(store_evtchn), &store_mfn,
                             Int_val(console_evtchn), &console_mfn, f);
    if (r)
        failwith_oss_xc(xch, "hvm_build_params");

    result = caml_alloc_tuple(2);
    Store_field(result, 0, caml_copy_nativeint(store_mfn));
    Store_field(result, 1, caml_copy_nativeint(console_mfn));

    CAMLreturn(result);
}

void simulation_set_pose3d_stub(value sim_val, value name_val,
    value gx_val, value gy_val, value gz_val, value groll_val,
    value gpitch_val, value gyaw_val)
{
  CAMLparam5(sim_val, name_val, gx_val, gy_val, gz_val);
//  CAMLxparam3(groll_val, gpitch_val, gyaw_val);

	playerc_simulation_t *sim = Simulation_val(sim_val);
  char *name = String_val(name_val);
  double gx = Double_val(gx_val);
  double gy = Double_val(gy_val);
  double gz = Double_val(gz_val);
  double groll = Double_val(groll_val);
  double gpitch = Double_val(gpitch_val);
  double gyaw = Double_val(gyaw_val);

  DPRINTF("setting sim %p pose3d: name - %s gx = %f gy = %f gz = %f groll = %f gpitch = %f gyaw = %f\n",
      sim, name, gx, gy, gz, groll, gpitch, gyaw);

  if(playerc_simulation_set_pose3d(sim, name, gx, gy, gz, groll, gpitch, gyaw))
    exception_playerc_error();

  DPRINTF("set sim %p pose3d: name - %s gx = %f gy = %f gz = %f groll = %f gpitch = %f gyaw = %f\n",
      sim, name, gx, gy, gz, groll, gpitch, gyaw);

  CAMLreturn0;
}

CAMLprim value sunml_lsolver_call_psolve(value vcptr, value vr, value vz,
	value vtol, value vlr)
{
    CAMLparam5(vcptr, vr, vz, vtol, vlr);
    caml_raise_constant(SUNDIALS_EXN(NotImplementedBySundialsVersion));
    CAMLreturn(Val_unit);
}

CAMLprim value
caml_udpv4_sendto(value v_fd, value v_str, value v_off, value v_len, value v_dst)
{
  CAMLparam5(v_fd, v_str, v_off, v_len, v_dst);
  CAMLlocal2(v_ret, v_err);
  unsigned char *buf = String_val(v_str) + Int_val(v_off);
  size_t len = Int_val(v_len);
  int fd = Int_val(v_fd);
  struct sockaddr_in sa;
  socklen_t sa_len = sizeof(sa);
  bzero(&sa, sizeof sa);
  sa.sin_family = AF_INET;
  sa.sin_addr.s_addr = htonl(Int32_val(Field(v_dst, 0)));
  sa.sin_port = htons(Int_val(Field(v_dst, 1)));

  int r = sendto(fd, buf, len, MSG_DONTWAIT, (struct sockaddr *)&sa, sa_len);
  if (r < 0) {
    if (errno == EAGAIN || errno==EWOULDBLOCK)
      Val_WouldBlock(v_ret);
    else {
      v_err = caml_copy_string(strerror(errno));
      Val_Err(v_ret, v_err);
    }
  } else {
    Val_OK(v_ret, Val_int(r));
  }
  CAMLreturn(v_ret);
}

CAMLprim value stub_mmap_init(value fd, value pflag, value mflag,
                              value len, value offset)
{
	CAMLparam5(fd, pflag, mflag, len, offset);
	CAMLlocal1(result);
	int c_pflag, c_mflag;

	switch (Int_val(pflag)) {
	case 0: c_pflag = PROT_READ; break;
	case 1: c_pflag = PROT_WRITE; break;
	case 2: c_pflag = PROT_READ|PROT_WRITE; break;
	default: caml_invalid_argument("protectiontype");
	}

	switch (Int_val(mflag)) {
	case 0: c_mflag = MAP_SHARED; break;
	case 1: c_mflag = MAP_PRIVATE; break;
	default: caml_invalid_argument("maptype");
	}

	result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);

	if (mmap_interface_init(GET_C_STRUCT(result), Int_val(fd),
	                        c_pflag, c_mflag,
	                        Int_val(len), Int_val(offset)))
		caml_failwith("mmap");
	CAMLreturn(result);
}

//+   external put : t -> ?txn:txn -> key:string -> data:string 
//+             -> put_flag list -> unit = "caml_db_put"
value caml_db_put(value db, value txn_opt, value vkey, 
		  value vdata, value vflags) {
  CAMLparam5(db, txn_opt, vkey, vdata, vflags);
  DBT key, data;
  int flags, err;
  DB_TXN *txn;

  if (Is_None(txn_opt)) { txn = NULL; }
  else { 
    test_txn_closed(Some_val(txn_opt));
    txn = UW_txn(Some_val(txn_opt)); 
  }

  test_db_closed(db);
  
  zerob(&key,sizeof(DBT)); zerob(&data,sizeof(DBT));

  key.data = String_val(vkey);
  key.size = string_length(vkey);
  data.data = String_val(vdata);
  data.size = string_length(vdata);
  flags = convert_flag_list(vflags, db_put_flags);

  err = UW_db(db)->put(UW_db(db), txn, &key, &data, flags);
  if (err != 0) { 
    if (err  == DB_KEYEXIST) {raise_key_exists();}
    UW_db(db)->err(UW_db(db),err,"caml_db_put"); 
  }

  CAMLreturn (Val_unit);
}

CAMLprim value
caml_backpack_mq_setattr(value val_mq, value val_flags)
{
	CAMLparam2(val_mq, val_flags);
	struct mq_attr attr = {
		.mq_flags = caml_convert_flag_list(val_flags, mqueue_flags)
	};

	if (mq_setattr(Int_val(val_mq), &attr, NULL) == -1)
		uerror("mq_setattr", Nothing);

	CAMLreturn(Val_unit);
}

CAMLprim value
caml_backpack_mq_send(value val_mq, value val_buff, value val_ofs,
		      value val_len, value val_prio)
{
	CAMLparam5(val_mq, val_buff, val_ofs, val_len, val_prio);

	if (mq_send(Int_val(val_mq), &Byte(val_buff, Long_val(val_ofs)),
		    Long_val(val_len), Int_val(val_prio)) == -1)
		uerror("mq_send", Nothing);

	CAMLreturn(Val_unit);
}

value hdf5_h5l_get_name_by_idx(value loc_v, value group_name_v, value index_field_v,
  value order_v, value lapl_v, value n_v)
{
  CAMLparam5(loc_v, group_name_v, index_field_v, order_v, lapl_v);
  CAMLxparam1(n_v);
  CAMLlocal1(name_v);
  hid_t loc_id = Hid_val(loc_v), lapl_id = H5P_opt_val(lapl_v);
  const char *group_name = String_val(group_name_v);
  H5_index_t index_field = H5_index_val(index_field_v);
  H5_iter_order_t order = H5_iter_order_val(order_v);
  hsize_t n = Int_val(n_v);
  char *name;
  ssize_t size;
  size = H5Lget_name_by_idx(loc_id, group_name, index_field, order, n, NULL, 0, lapl_id);
  if (size < 0)
    fail();
  size++;
  name = malloc(size);
  if (name == NULL)
    caml_raise_out_of_memory();
  size = H5Lget_name_by_idx(loc_id, group_name, index_field, order, n, name, size,
    lapl_id);
  if (size < 0)
  {
    free(name);
    fail();
  }
  name_v = caml_copy_string(name);
  free(name);
  CAMLreturn(name_v);
}

CAMLprim value quota_modify (value v_user_or_group, value v_id,
                             value v_path, value v_bytes_limit, value v_inodes_limit)
{
  int id, cmd;
  struct dqblk quota;
  CAMLparam5(v_user_or_group, v_id, v_path, v_bytes_limit, v_inodes_limit);

  id  = Int_val(v_id);
  cmd = quota_command(v_user_or_group, QUOTA_MODIFY_COMMAND);

  memset(&quota, 0, sizeof(quota));

  quota.dqb_bsoftlimit = Int63_val(Field(v_bytes_limit, 0)) / QUOTA_BYTES_PER_SPACE_UNIT;
  quota.dqb_bhardlimit = Int63_val(Field(v_bytes_limit, 1)) / QUOTA_BYTES_PER_SPACE_UNIT;
  quota.dqb_btime      = (time_t) Double_val(Field(v_bytes_limit, 2));

  quota.dqb_isoftlimit = Int63_val(Field(v_inodes_limit, 0));
  quota.dqb_ihardlimit = Int63_val(Field(v_inodes_limit, 1));
  quota.dqb_itime      = (time_t) Double_val(Field(v_inodes_limit, 2));

  QUOTA_SET_VALID_FIELDS(quota);

  if (quota_control(String_val(v_path), cmd, id, (caddr_t)&quota))
    unix_error(errno, "Unix.Quota: unable to set quota", v_path);

  CAMLreturn(Val_unit);
}

CAMLprim value spoc_cublasDgemm(value transa, value transb,
		value m, value n, value k,
		value alpha, value a, value lda,
		value b, value ldb, value beta, value c, value ldc, value dev){
	CAMLparam5(transa, transb, m, n, k);
	CAMLxparam5(alpha, a, lda, b, ldb);
	CAMLxparam4(beta, c, ldc, dev);
	CAMLlocal3(dev_vec_array, dev_vec, gi);
	CUdeviceptr d_A;
	CUdeviceptr d_B;
	CUdeviceptr d_C;
	int id;
	gi = Field(dev, 0);
	id = Int_val(Field(gi, 7));

	GET_VEC(a, d_A);
	GET_VEC(b, d_B);
	GET_VEC(c, d_C);

	//CUBLAS_GET_CONTEXT;
	CUBLAS_GET_CONTEXT;


	cublasDgemm (Int_val(transa), Int_val(transb), Int_val(m), Int_val(n),
	Int_val(k), (double)Double_val(alpha), (double*) d_A, Int_val(lda),
	(double*) d_B, Int_val(ldb), (double) Double_val(beta),
	(double *)d_C, Int_val(ldc));

	CUDA_RESTORE_CONTEXT;

	CAMLreturn(Val_unit);
}

/* Fill a buffer from a slice of a Binarary.t */
CAMLprim value string_from_binary_array (value src_arr, value buffer, value src_idx, value src_len, value dst_idx)
{
	CAMLparam5 (src_arr, buffer, src_idx, src_len, dst_idx);
	char *dst = (String_val(buffer)) + (Long_val(dst_idx));
	memmove (dst, (char *) Data_bigarray_val(src_arr) + (Long_val(src_idx)), Long_val(src_len));
	CAMLreturn (Val_unit);
}

CAMLprim value spoc_cublasSetMatrix (value rows, value cols, value a, value lda, value b, value ldb, value dev){
	CAMLparam5(rows, cols, a, lda, b);
	CAMLxparam2(ldb, dev);
	CAMLlocal4(dev_vec_array, dev_vec, gi, bigArray);
	CUdeviceptr d_B;
	void* h_A;
	int type_size = sizeof(double);
	int tag;
	int id;
	gi = Field(dev, 0);
	id = Int_val(Field(gi, 7));
	GET_VEC(b, d_B);
	GET_HOST_VEC (a, h_A);

	CUBLAS_GET_CONTEXT;
	int custom = 0;
	GET_TYPE_SIZE;

	//printf("rows : %d, col: %d, type_size : %d, lda :%d, ldb : %d\n", Int_val(rows), Int_val(cols), type_size, Int_val (lda), Int_val(ldb));
	//fflush(stdout);
	CUBLAS_CHECK_CALL(cublasSetMatrix(Int_val(rows), Int_val(cols), type_size, h_A, Int_val(lda), (void*) d_B, Int_val(ldb)));
	
	CUBLAS_RESTORE_CONTEXT;
	CAMLreturn(Val_unit);
}

CAMLprim value
tun_opendev(value devname, value kind, value pi, value persist, value user, value group)
{
  CAMLparam5(devname, kind, pi, persist, user);
  CAMLxparam1(group);
  CAMLlocal2(res, dev_caml);

  char dev[IFNAMSIZ];
  int fd;

#if defined (__APPLE__) && defined (__MACH__)
  if (caml_string_length(devname) < 4)
    caml_failwith("On MacOSX, you need to specify the name of the device, e.g. tap0");
#endif

  memset(dev, 0, sizeof dev);
  memcpy(dev, String_val(devname), caml_string_length(devname));

  // All errors are already checked by tun_alloc, returned fd is valid
  // otherwise it would have crashed before
  fd = tun_alloc(dev, Int_val(kind), Bool_val(pi), Bool_val(persist), Int_val(user), Int_val(group));

  res = caml_alloc_tuple(2);
  dev_caml = caml_copy_string(dev);

  Store_field(res, 0, Val_int(fd));
  Store_field(res, 1, dev_caml);

  CAMLreturn(res);
}