自学教程：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 valuecaml_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 valuecaml_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 valuecaml_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 valuetun_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);}

value caml_vc_funType3(value vc, value a1, value a2, value a3, value tr){  CAMLparam5(vc,a1,a2,a3,tr);  CAMLreturn(alloc_Type(vc_funType3(VC_val(vc),Type_val(a1),				    Type_val(a2),Type_val(a3),				    Type_val(tr))));}

//+   external dopen : t -> string -> db_type -> open_flag list //+        -> int -> unit =  "caml_db_open"value caml_db_open(value db, value vfname, 		   value vdbtype, value vflags, 		   value vmode){  CAMLparam5(db, vfname, vdbtype, vflags, vmode);  int err;  char *fname = String_val(vfname);  int flags = convert_flag_list(vflags,db_open_flags);  int dbtype = Flag_val(vdbtype,db_types);  test_db_closed(db);  err = UW_db(db)->open(UW_db(db), 			NULL,			fname, 			NULL, /* no support for multiple databases in 				 a single file */			dbtype, 			flags, /* automatic transaction on database open */			Long_val(vmode) );   if (err != 0) {     UW_db(db)->err(UW_db(db),err,			 "caml_db_open");   }  CAMLreturn (Val_unit);}

CAMLprim valuecaml_udpv4_recvfrom(value v_fd, value v_str, value v_off, value v_len, value v_src){  CAMLparam5(v_fd, v_str, v_off, v_len, v_src);  CAMLlocal3(v_ret, v_err, v_inf);  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);  int r = recvfrom(fd, (void *)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 {    v_inf = caml_alloc_tuple(3);    Store_field(v_inf, 0, caml_copy_int32(ntohl(sa.sin_addr.s_addr)));    Store_field(v_inf, 1, Val_int(ntohs(sa.sin_port)));    Store_field(v_inf, 2, Val_int(r));    Val_OK(v_ret, v_inf);  }  CAMLreturn(v_ret);}

value caml_vc_bvWriteToMemoryArray(value vc, value arr, value bi,				   value e, value num){  CAMLparam5(vc,arr,bi,e,num);  CAMLreturn(alloc_Expr(vc_bvWriteToMemoryArray(VC_val(vc),Expr_val(arr),						Expr_val(bi),Expr_val(e),						Int_val(num))));}

CAMLprim value sunml_nvec_par_n_vlinearsum(value va, value vx, value vb, value vy,					value vz){    CAMLparam5(va, vx, vb, vy, vz);    N_VLinearSum_Parallel(Double_val(va), NVEC_VAL(vx), Double_val(vb),			  NVEC_VAL(vy), NVEC_VAL(vz));    CAMLreturn (Val_unit);}

void tbstub_change_cell(value caml_x, value caml_y, value caml_ch, value caml_fg, value caml_bg) {	CAMLparam5(caml_x, caml_y, caml_ch, caml_fg, caml_bg);	tb_change_cell(Int_val(caml_x), Int_val(caml_y), Int32_val(caml_ch), Int_val(caml_fg), Int_val(caml_bg));	CAMLreturn0;}

void hdf5_h5l_move(value src_loc_v, value src_name_v, value dest_loc_v, value lcpl_v,  value lapl_v, value dest_name_v){  CAMLparam5(src_loc_v, src_name_v, dest_loc_v, lcpl_v, lapl_v);  CAMLxparam1(dest_name_v);  raise_if_fail(H5Lmove(Hid_val(src_loc_v), String_val(src_name_v), Hid_val(dest_loc_v),    String_val(dest_name_v), H5P_opt_val(lcpl_v), H5P_opt_val(lapl_v)));  CAMLreturn0;}

value hdf5_h5l_create_hard(value obj_loc_v, value obj_name_v, value link_loc_v,  value lcpl_v, value lapl_v, value link_name_v){  CAMLparam5(obj_loc_v, obj_name_v, link_loc_v, lcpl_v, lapl_v);  CAMLxparam1(link_name_v);  CAMLreturn(alloc_h5l(H5Lcreate_hard(Hid_val(obj_loc_v), String_val(obj_name_v),    Hid_val(link_loc_v), String_val(link_name_v), H5P_opt_val(lcpl_v),    H5P_opt_val(lapl_v))));}

value f_i5_caml(value i0, value i1, value i2, value i3, value i4) {  CAMLparam5(i0,i1,i2,i3,i4);  int ii0 = Int_val(i0);  int ii1 = Int_val(i1);  int ii2 = Int_val(i2);  int ii3 = Int_val(i3);  int ii4 = Int_val(i4);  CAMLreturn(Val_int(f_i5(ii0,ii1,ii2,ii3,ii4)));}

CAMLprim value caml_extunix_linkat(value v_olddirfd, value v_oldname, value v_newdirfd, value v_newname, value v_flags){  CAMLparam5(v_olddirfd, v_oldname, v_newdirfd, v_newname, v_flags);  int ret = 0;  int flags = caml_convert_flag_list(v_flags, at_flags_table);  flags &= AT_SYMLINK_FOLLOW;  /* only allowed flag here */  ret = linkat(Int_val(v_olddirfd), String_val(v_oldname), Int_val(v_newdirfd), String_val(v_newname), flags);  if (ret != 0) uerror("linkat", v_oldname);  CAMLreturn(Val_unit);}

/* Writes to a page from an OCaml string */CAMLprim valuecaml_page_write(value v_src, value v_srcoff, value v_dst, value v_dstoff, value v_len){    CAMLparam5(v_src, v_srcoff, v_dst, v_dstoff, v_len);    char *page = (char *)v_dst;    if (Int_val(v_dstoff) + Int_val(v_len) >= PAGE_SIZE || caml_string_length(v_src) + Int_val(v_srcoff) < Int_val(v_len))        caml_array_bound_error();    memcpy(page + Int_val(v_srcoff), String_val(v_src) + Int_val(v_srcoff), Int_val(v_len));    CAMLreturn(Val_unit);}

value f_i6_caml(value i0, value i1, value i2, value i3, value i4, value i5) {  CAMLparam5(i0,i1,i2,i3,i4);  CAMLxparam1(i5);  int ii0 = Int_val(i0);  int ii1 = Int_val(i1);  int ii2 = Int_val(i2);  int ii3 = Int_val(i3);  int ii4 = Int_val(i4);  int ii5 = Int_val(i5);  CAMLreturn(Val_int(f_i6(ii0,ii1,ii2,ii3,ii4,ii5)));}

CAMLprim value stub_utp_process_udp (value context, value addr, value buf, value off, value len){  CAMLparam5 (context, addr, buf, off, len);  union sock_addr_union sock_addr;  socklen_param_type addr_len;  int handled;  get_sockaddr (addr, &sock_addr, &addr_len);  handled = utp_process_udp (Utp_context_val (context), Caml_ba_data_val (buf) + Int_val (off), Int_val (len), &sock_addr.s_gen, addr_len);  CAMLreturn (Val_bool (handled));}

CAMLprim value spoc_cublasSscal (value n, value alpha, value x, value incx, value dev){	CAMLparam5(n, alpha, x,incx, dev);	CAMLlocal3(dev_vec_array, dev_vec, gi);	CUdeviceptr d_A;	int id;	GET_VEC(x, d_A);	CUBLAS_GET_CONTEXT;	cublasSscal(Int_val(n), (float)(Double_val(alpha)), (float*)d_A, Int_val(incx));	CUBLAS_CHECK_CALL(cublasGetError());	CUDA_RESTORE_CONTEXT;	CAMLreturn(Val_unit);}

value f_i8_caml(value i0, value i1, value i2, value i3, value i4, value i5, value i6, value i7) {  CAMLparam5(i0,i1,i2,i3,i4);  CAMLxparam3(i5,i6,i7);  int ii0 = Int_val(i0);  int ii1 = Int_val(i1);  int ii2 = Int_val(i2);  int ii3 = Int_val(i3);  int ii4 = Int_val(i4);  int ii5 = Int_val(i5);  int ii6 = Int_val(i6);  int ii7 = Int_val(i7);  CAMLreturn(Val_int(f_i8(ii0,ii1,ii2,ii3,ii4,ii5,ii6,ii7)));}