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

CAMLprim value stub_asl_set(value m, value key, value val) {  CAMLparam3(m, key, val);  const char *c_key = strdup(String_val(key));  const char *c_val = strdup(String_val(val));  caml_release_runtime_system();  asl_set(Msg_val(m), c_key, c_val);  caml_acquire_runtime_system();  free((void*)c_key);  free((void*)c_val);  CAMLreturn(0);}

CAMLprim value stub_atomic_fetch_and_uint8(value buf, value idx, value val){  CAMLparam3(buf, idx, val);  uint8_t c_val = (uint8_t)Int_val(val);  uint8_t *ptr = Caml_ba_data_val(buf) + Int_val(idx);  if (Int_val(idx) >= Caml_ba_array_val(buf)->dim[0])    caml_invalid_argument("idx");  CAMLreturn(Val_int((uint8_t)__sync_fetch_and_and(ptr, c_val)));}

value caml_curses_wmove(value mlwindow, value y, value x) {   CAMLparam3(mlwindow, y, x);   WINDOW *window = window_of_ml(mlwindow);      /* Move the cursor in the indicated window */   wmove(window, Int_val(y), Int_val(x));      CAMLreturn(Val_unit);}

CAMLprim valuecaml_gnttab_read(value v_gw, value v_off, value v_size){    CAMLparam3(v_gw, v_off, v_size);    CAMLlocal1(v_ret);    gnttab_wrap *gw = Gnttab_wrap_val(v_gw);    BUG_ON(gw->page == NULL);    v_ret = caml_alloc_string(Int_val(v_size));    memcpy(String_val(v_ret), gw->page + Int_val(v_off), Int_val(v_size));    CAMLreturn(v_ret);}

valuev2v_xml_node_ptr_set_prop (value nodev, value namev, value valv){  CAMLparam3 (nodev, namev, valv);  xmlNodePtr node = (xmlNodePtr) nodev;  if (xmlSetProp (node, BAD_CAST String_val (namev), BAD_CAST String_val (valv))      == NULL)    caml_invalid_argument ("node_ptr_set_prop: failed to set property");  CAMLreturn (Val_unit);}

CAMLprim value win_putenv(value var, value wvar, value v){  BOOL res;  CAMLparam3(var, wvar, v);  res = SetEnvironmentVariableW((LPCWSTR) String_val(wvar), (LPCWSTR) v);  if (res == 0) {    win32_maperr (GetLastError ());    uerror("putenv", var);  }  CAMLreturn (Val_unit);}

valuecreate_tuple(value a, value b, value c){  CAMLparam3(a,b,c);  CAMLlocal1(tmp);  tmp=caml_alloc(3,0); // allocate 3 tag 0 on ocaml heap  Store_field(tmp,1,a);  Store_field(tmp,2,a);  Store_field(tmp,3,a);  CAMLreturn(tmp);}

CAMLprim value ml_gtk_text_buffer_get_iter_at_line_index(value tb, 							 value l,							 value c){  CAMLparam3(tb,l,c);  GtkTextIter res;  gtk_text_buffer_get_iter_at_line_offset(GtkTextBuffer_val(tb),					  &res,					  Int_val(l),					  Int_val(c));  CAMLreturn(Val_GtkTextIter(&res));}

valuesankoff_CAML_dist_2(value a, value b,value c) {   CAMLparam3(a,b,c);   eltarr_p eapD;   eltarr_p eapA;   eltarr_p eapR;   eapD = Sankoff_return_eltarr(a);   eapA = Sankoff_return_eltarr(b);   eapR = Sankoff_return_eltarr(c);   int res = sankoff_dist_2(eapD,eapA,eapR);   CAMLreturn(Val_int(res));}

PREFIX value ml_evas_object_smart_callback_add(        value v_obj, value v_event, value v_func){        CAMLparam3(v_obj, v_event, v_func);        value* data = caml_stat_alloc(sizeof(value));        *data = v_func;        caml_register_global_root(data);        const char* event = String_val(v_event);        evas_object_smart_callback_add((Evas_Object*) v_obj, event,	ml_Evas_Smart_Cb, data);        CAMLreturn(Val_unit);}

CAMLprim value Wrapper_FT_Load_Glyph(value face, value glyph_index, value load_flags){  CAMLparam3(face, glyph_index, load_flags);  FT_Face f;  f = *(FT_Face *)Data_custom_val(face);  if (FT_Load_Glyph(f, Int_val(glyph_index), Int_val(load_flags)))    failwith("FT_Load_Glyph");  CAMLreturn(Val_unit);};

CAMLprim value ocamlyices_type_tuple3(value v_tau1, value v_tau2,                                      value v_tau3) {  CAMLparam3(v_tau1, v_tau2, v_tau3);  type_t res;  res = yices_tuple_type3(Type_val(v_tau1), Type_val(v_tau2), Type_val(v_tau3));  if (res == NULL_TYPE) {    _oy_error();  }  CAMLreturn(Val_type(res));}

t_value ml_glgetactiveattrib (value program, value index, value bufsize){	CAMLparam3 (program, index, bufsize);	CAMLlocal1 (name);	GLsizei len;	GLint size;	GLenum type;	char *buffer = (char *)malloc (sizeof(char) * bufsize);	glGetActiveAttrib (Long_val(program), Int_val(index), Int_val(bufsize), &len, &size, &type, buffer);	name = caml_copy_string (buffer);	CAMLreturn (name);}

valuesankoff_CAML_init_beta (value this_elt, value position, value cost){    CAMLparam3(this_elt,position,cost);    elt_p ep;    Sankoff_elt_custom_val(ep,this_elt);    int pos, c;    pos = Int_val(position);    c = Int_val(cost);    sankoff_set_beta(ep,pos,c);    CAMLreturn (Val_unit);}

CAMLprim value spoc_cuda_set_block_shape(value ker, value block, value gi){	CAMLparam3(ker, block, gi);	CUfunction *kernel;	CUDA_GET_CONTEXT;	kernel = (CUfunction*) ker;	CUDA_CHECK_CALL(cuFuncSetBlockShape(*kernel, Int_val(Field(block,0)),Int_val(Field(block,1)),Int_val(Field(block,2))));	CUDA_RESTORE_CONTEXT;	CAMLreturn(Val_unit);}

CAMLprim value sunml_lsolver_call_atimes(value vcptr, value vv, value vz){    CAMLparam3(vcptr, vv, vz);    int r;    r = ATIMES_WITH_DATA(vcptr)->atimes_func(	    ATIMES_WITH_DATA(vcptr)->atimes_data, NVEC_VAL(vv), NVEC_VAL(vz));    if (r != 0)	caml_raise_with_arg(LSOLVER_EXN(ATimesFailure), Val_bool(r > 0));    CAMLreturn(Val_unit);}

CAMLprim value spoc_cuda_load_param_int64(value off, value ex, value val){	CAMLparam3(off, ex, val);	int offset;	char *extra;	long long i;	extra = (char*)ex;	offset = Int_val(Field(off, 0));	i = (long long) Int_val(val);	ADD_TO_PARAM_BUFFER(i, __alignof(i));	Store_field(off, 0, Val_int(offset));	CAMLreturn(Val_unit);}

CAMLprim value spoc_cuda_load_param_float64(value off, value ex, value val){	CAMLparam3(off, ex, val);	int offset;	char *extra;	double f;	extra = (char*)ex;	offset = Int_val(Field(off, 0));	f = Double_val(val);	ADD_TO_PARAM_BUFFER(f, __alignof(f));	Store_field(off, 0, Val_int(offset));	CAMLreturn(Val_unit);}

CAMLprim value ml_gsl_multimin_fminimizer_set(value S, value fun, 				     value X, value step_size){  CAMLparam3(S, X, step_size);  struct callback_params *p=CALLBACKPARAMS_VAL(S);  _DECLARE_VECTOR2(X,step_size);  _CONVERT_VECTOR2(X,step_size);  p->closure = fun;  gsl_multimin_fminimizer_set(GSLMULTIMINFMINIMIZER_VAL(S), 			      &(p->gslfun.mmf), &v_X, &v_step_size);  CAMLreturn(Val_unit);}

CAMLprim value Wrapper_FT_Set_Char_Size(value face, value size, value dpi){  CAMLparam3(face, size, dpi);  FT_Face f;  f = *(FT_Face *)Data_custom_val(face);  if (FT_Set_Char_Size(f, 0, Int_val(size), Int_val(dpi), Int_val(dpi)))    failwith("FT_Set_Char_Size");  CAMLreturn(Val_unit);};

CAMLprim valuecaml_SDL_TTF_OpenFontIndex(value file, value ptsize, value index){    CAMLparam3(file, ptsize, index);    TTF_Font *font =        TTF_OpenFontIndex(                String_val(file), Int_val(ptsize), Int_val(index));    if (!font) error("Sdlttf.open_font_index");    CAMLreturn(Val_TTF_Font(font));}

CAMLprim value cstring_of_binary_array (value src_arr, value src_idx, value src_len){	CAMLparam3 (src_arr, src_idx, src_len);	CAMLlocal1 (retval);	int len = Long_val(src_len);	char *retstr = (char *) calloc (len + 1, 1);	if (retstr == NULL) failwith ("unable to allocate internal buffer");	memcpy (retstr, (char *) Data_bigarray_val(src_arr) + (Long_val(src_idx)), len);	retval = copy_string (retstr);	free (retstr);	CAMLreturn (retval);}

CAMLprim value setsockopt_stub(value sock, value sockopt, value val) {    CAMLparam3 (sock, sockopt, val);    int native_sockopt = Int_val(sockopt);    struct wrap *socket = Socket_val(sock);    int result = -1;    switch (native_sockopt) {        case ZMQ_SNDHWM:        case ZMQ_RCVHWM:        case ZMQ_RATE:        case ZMQ_RECOVERY_IVL:        case ZMQ_SNDBUF:        case ZMQ_RCVBUF:        case ZMQ_LINGER:        case ZMQ_RECONNECT_IVL_MAX:        case ZMQ_BACKLOG:        case ZMQ_MULTICAST_HOPS:        case ZMQ_RCVTIMEO:        case ZMQ_SNDTIMEO:        {            int optval = Int_val(val);            result = zmq_setsockopt(socket->wrapped, native_sockopt, &optval, sizeof(optval));        }        break;                case ZMQ_IDENTITY:        case ZMQ_SUBSCRIBE:        case ZMQ_UNSUBSCRIBE:        {            result = zmq_setsockopt(socket->wrapped,                                    native_sockopt,                                    String_val(val),                                    caml_string_length(val));        }        break;        case ZMQ_AFFINITY:        case ZMQ_MAXMSGSIZE:        {            int64 optval = Int64_val(val);            result = zmq_setsockopt(socket->wrapped, native_sockopt, &optval, sizeof(optval));        }        break;        default:            caml_failwith("Bidings error");    }    stub_raise_if (result == -1);    CAMLreturn (Val_unit);}

value sankoff_CAML_filter_character(value this_eltarr, value ecode_bigarr, value get_comp) {    CAMLparam3(this_eltarr,ecode_bigarr,get_comp);    CAMLlocal1(res);    int get_complementary = Int_val(get_comp);    int * ecode_arr = (int*) Data_bigarray_val(ecode_bigarr);    eltarr_p eap;    Sankoff_eltarr_custom_val(eap,this_eltarr);    int num_elts=eap->num_elts;     int res_num_elts=0;//must init to 0    int i;    elt_p ep;    int * sign_arr = (int*)calloc(num_elts,sizeof(int));    for (i=0;i<num_elts;i++) {        ep = &((eap->elts)[i]);        if(get_complementary) {            if( int_array_is_mem(ecode_arr,num_elts,ep->ecode) )            {  sign_arr[i]=0;  }            else { sign_arr[i]=1; res_num_elts++; }        }        else {            if( int_array_is_mem(ecode_arr,num_elts,ep->ecode) )            {  sign_arr[i]=1; res_num_elts++; }            else sign_arr[i]=0;        }            }    eltarr_p res_eap;    res_eap = (eltarr_p)calloc(1,sizeof(struct elt_arr));    int num_states = eap->num_states;    res_eap->code = eap->code;    res_eap->num_states = eap->num_states;    res_eap->num_elts = res_num_elts;    res_eap->tcm = (int*)calloc(num_states*num_states,sizeof(int));    res_eap->is_identity = eap->is_identity;    memcpy (res_eap->tcm,eap->tcm,sizeof(int)*num_states*num_states);    res_eap->elts = (elt_p)calloc(res_num_elts,sizeof(struct elt));    elt_p res_elts = res_eap->elts;    int j=0;    for (i=0;i<num_elts;i++) {        if(sign_arr[i]==1) {         sankoff_create_empty_elt(&(res_elts[j]),num_states,-1);         sankoff_clone_elt(&(res_elts[j]),&((eap->elts)[i]));         j++;        }    }    free(sign_arr);    assert(j==res_num_elts);    res = caml_alloc_custom(&sankoff_custom_operations_eltarr,sizeof(eltarr_p),1,alloc_custom_max);    Sankoff_return_eltarr(res) = res_eap;    CAMLreturn(res);}

CAMLprim value caml_mdb_dbi_open(value txn,value name,value flags){  CAMLparam3(txn,name,flags);  MDB_dbi dbi;  char*str=NULL;  if(caml_string_length(name))    str=String_val(name);  if(mdb_dbi_open((MDB_txn*)txn,str,Int_val(flags),&dbi)){    caml_failwith("error in mdb_dbi_open");  }  CAMLreturn(Val_int(dbi));}

CAMLprim value iocp_ml_write(value fd, value vbuf, value vlen){  CAMLparam3(fd, vbuf, vlen);  CAMLlocal1(res);  intnat len = Long_val(vlen);  SOCKET s = Socket_val(fd);  char *buf = String_val(vbuf);  assert(Descr_kind_val(fd) == KIND_SOCKET);  res =  Val_int(async_write(s, buf, len));  CAMLreturn(res);  /* async_write(s, buf, len); */  /* return Val_unit; */}

CAMLprim value ocamlyices_type_function2(value v_dom1, value v_dom2,    value v_range) {  CAMLparam3(v_dom1, v_dom2, v_range);  type_t res;  res = yices_function_type2(Type_val(v_dom1), Type_val(v_dom2),                             Type_val(v_range));  if (res == NULL_TYPE) {    _oy_error();  }  CAMLreturn(Val_type(res));}

CAMLprim valuecaml_SDL_BlitSurfs(        value src, value dst, value _dstrect){    CAMLparam3(src, dst, _dstrect);    SDL_Rect dstrect;    SDL_Rect_val(&dstrect, _dstrect);    int r = SDL_BlitSurface(        SDL_Surface_val(src), NULL,        SDL_Surface_val(dst), &dstrect);    if (r) caml_failwith("Sdlsurface.blit_surfs");    CAMLreturn(Val_unit);}

CAMLprim value lwt_unix_socketpair_stub(value domain, value type,                                        value protocol) {  CAMLparam3(domain, type, protocol);  CAMLlocal1(result);  SOCKET sockets[2];  lwt_unix_socketpair(socket_domain_table[Int_val(domain)],                      socket_type_table[Int_val(type)], Int_val(protocol),                      sockets);  result = caml_alloc_tuple(2);  Store_field(result, 0, win_alloc_socket(sockets[0]));  Store_field(result, 1, win_alloc_socket(sockets[1]));  CAMLreturn(result);}

CAMLprim value sundials_ml_fvector_scale(value s, value x, value z) {  CAMLparam3(s,x,z);  const double ds = Double_val(s);  struct caml_ba_array* ba_x = Caml_ba_array_val(x);  struct caml_ba_array* ba_z = Caml_ba_array_val(z);  double* dx = (double*) ba_x -> data;  double* dz = (double*) ba_z -> data;  for(int i = 0; i < ba_x->dim[0]; i++)    dz[i] = dx[i] * ds;  CAMLreturn(Val_unit);}