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

CAMLprim value spoc_cuda_custom_load_param_vec(value off, value ex, value A, value v){	CAMLparam4(off, ex, A, v);	CAMLlocal1(customArray);	cu_vector* cuv;	CUdeviceptr d_A;	char *extra;	int offset;	int seek;	int type_size;	int tag;	void* ptr;	seek = Int_val(Field(v,10));	customArray = Field (Field(v, 1), 0);	type_size = Int_val(Field(Field(customArray, 1),1));	extra = (char*)ex;	offset = Int_val(Field(off, 0));	cuv = (cu_vector*)Field(A, 1);	d_A = cuv->cu_vector;	ptr = (void*) (size_t) d_A + seek * type_size;	ADD_TO_PARAM_BUFFER(ptr, __alignof(d_A));	Store_field(off, 0, Val_int(offset));	CAMLreturn(Val_unit);}

CAMLprim value sunml_spils_qr_sol(value vn, value vh, value vq, value vb){    CAMLparam4(vn, vh, vq, vb);    int r;    int n = Int_val(vn);#if SUNDIALS_ML_SAFE == 1    struct caml_ba_array *bh = ARRAY2_DATA(vh);    intnat hm = bh->dim[1];    intnat hn = bh->dim[0];    if (hn < n + 1)	caml_invalid_argument("qr_sol: h is too small (< n + 1).");    if (hm < n)	caml_invalid_argument("qr_sol: h is too small (< n).");    if (ARRAY1_LEN(vq) < 2 * n)	caml_invalid_argument("qr_sol: q is too small (< 2n).");    if (ARRAY1_LEN(vb) < n + 1)	caml_invalid_argument("qr_sol: b is too small (< n + 1).");#endif    r = QRsol(n, ARRAY2_ACOLS(vh), REAL_ARRAY(vq), REAL_ARRAY(vb));    if (r != 0) {	caml_raise_with_arg(MATRIX_EXN_TAG(ZeroDiagonalElement),			    Val_long(r));    }    CAMLreturn (Val_unit);}

value caml_curses_newwin(value nlines, value ncols, value beginy, value beginx) {   CAMLparam4(nlines, ncols, beginy, beginx);   failwith("No ncurses support enabled");   CAMLreturn(Val_unit);}

CAMLprim value netsys_openat(value dirfd, value path, value flags, value perm){#ifdef HAVE_AT    CAMLparam4(dirfd, path, flags, perm);    int ret, cv_flags;    char * p;    /* shamelessly copied from ocaml distro */    cv_flags = convert_flag_list(flags, open_flag_table);    p = stat_alloc(string_length(path) + 1);    strcpy(p, String_val(path));    enter_blocking_section();    ret = openat(Int_val(dirfd), p, cv_flags, Int_val(perm));    leave_blocking_section();    stat_free(p);    if (ret == -1) uerror("openat", path);#if defined(NEED_CLOEXEC_EMULATION) && defined(FD_CLOEXEC)    if (convert_flag_list(flags, open_cloexec_table) != 0) {        int flags = fcntl(Int_val(dirfd), F_GETFD, 0);        if (flags == -1 || fcntl(Int_val(dirfd), F_SETFD, flags | FD_CLOEXEC) == -1)          uerror("openat", path);    }#endif    CAMLreturn (Val_int(ret));#else    invalid_argument("Netsys_posix.openat not available");#endif}

CAMLprim value caml_mdb_del(value txn,value dbi,value key,value data){  CAMLparam4(txn,dbi,key,data);  MDB_val key_,data_;  key_.mv_data=String_val(key);  key_.mv_size=caml_string_length(key);  int ret;  if(data ==Val_int(0)){    if((ret=mdb_del(  (MDB_txn*)txn,  (MDB_dbi) Int_val(dbi),  &key_, NULL ))){      if(ret==MDB_NOTFOUND) {        static value *exn=NULL;        if(exn==NULL) exn=caml_named_value("lmdb_not_found");        caml_raise_constant(*exn);      } else        caml_failwith("error in mdb_del");    }  } else {    value x=Field(data,0);    data_.mv_data=String_val(x);    data_.mv_size=caml_string_length(x);    if((ret=mdb_del(  (MDB_txn*)txn,  (MDB_dbi) Int_val(dbi),  &key_, &data_ ))){      caml_failwith("error in mdb_del");    }  }  CAMLreturn0;}

//+   external get : t -> ?txn:txn -> string -> get_flag list -> string//+             = "caml_db_get"value caml_db_get(value db, value txn_opt, value vkey, value vflags) {  CAMLparam4(db, txn_opt, vkey, vflags);  DBT key,data;  int flags, err;  DB_TXN *txn;   CAMLlocal1(rval);  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);  flags = convert_flag_list(vflags, db_get_flags);  err = UW_db(db)->get(UW_db(db), txn, &key, &data, flags);  if (err != 0) {     ////fprintf(stderr,"Error found: %d/n",err); fflush(stderr);    if (err == DB_NOTFOUND) { raise_not_found(); }    UW_db(db)->err(UW_db(db),err,"caml_db_get");   }  // FIX: this currently uses an extra, unnecessary copy in order to simplify  // memory management.  rval = alloc_string(data.size);  memcpy (String_val(rval), data.data, data.size);  CAMLreturn (rval);}

//+   external init_both :  t -> key:string -> data:string //+               -> get_flag list -> unit = "caml_cursor_init_both"value caml_cursor_init_both(value cursor, value vkey, 			    value vdata , value vflags			    ) {   CAMLparam4(cursor,vkey,vdata,vflags);    DBT key,data;   int flags;    int err;  /*   int ctr = 0; */   flags = convert_flag_list(vflags,cursor_get_flags) | DB_GET_BOTH;   test_cursor_closed(cursor);   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);   err = UW_cursor(cursor)->c_get(UW_cursor(cursor), &key, &data, flags);   if (err != 0) {      if (err == DB_NOTFOUND) { raise_not_found (); }     raise_db(db_strerror(err));   }   CAMLreturn (Val_unit);}

CAMLprim value stub_gnttab_map_fresh(    value xgh,    value reference,    value domid,    value writable){    CAMLparam4(xgh, reference, domid, writable);    CAMLlocal2(pair, contents);    void *map =        xc_gnttab_map_grant_ref(_G(xgh), Int_val(domid), Int_val(reference),                                Bool_val(writable)?PROT_READ | PROT_WRITE:PROT_READ);    if(map==NULL) {        caml_failwith("Failed to map grant ref");    }    contents = caml_ba_alloc_dims(XC_GNTTAB_BIGARRAY, 1,                                  map, 1 << XC_PAGE_SHIFT);    pair = caml_alloc_tuple(2);    Store_field(pair, 0, contents); /* grant_handle */    Store_field(pair, 1, contents); /* Io_page.t */    CAMLreturn(pair);}

CAMLprim value caml_extunix_renameat(value v_oldfd, value v_oldname, value v_newfd, value v_newname){  CAMLparam4(v_oldfd, v_oldname, v_newfd, v_newname);  int ret = renameat(Int_val(v_oldfd), String_val(v_oldname), Int_val(v_newfd), String_val(v_newname));  if (ret != 0) uerror("renameat", v_oldname);  CAMLreturn(Val_unit);}

//+   external ajoin : ?nosort:bool -> db -> cursor array -> get_flag list ->//+                       cursor = "caml_join_cursors"//+   let join ?nosort  db cursor_list get_flag_list =//+        ajoin ?nosort db (Array.of_list cursor_list) get_flag_listvalue caml_join_cursors(value vnosort, value db, 			value vcursors, value vflags) {  CAMLparam4(vnosort,db,vcursors,vflags);  CAMLlocal1(rval);  DBC *jcurs; // pointer to joined cursor  int carray_len = Wosize_val(vcursors);  int flags = convert_flag_list(vflags,cursor_get_flags);  DBC *cursors[carray_len + 1];  int i;  if (Is_Some(vnosort) && Bool_val(vnosort)) {     flags = flags | DB_JOIN_NOSORT;   }  for (i=0; i < carray_len; i++) {     if (UW_cursor_closed(Field(vcursors,i))) {      invalid_argument("caml_join_cursors: Attempt to use closed cursor");    }    cursors[i] = UW_cursor(Field(vcursors,i));  }  cursors[i] = NULL;  test_db_closed(db);    UW_db(db)->join(UW_db(db),cursors,&jcurs,flags);    rval = alloc_custom(&cursor_custom,Camlcursor_wosize,0,1);  UW_cursor(rval) = jcurs;  UW_cursor_closed(rval) = False;  CAMLreturn (rval);}

value caml_vc_recordTypeN(value vc, value fields, value types, value num){  char **fs;  Type *ts;  int i;  CAMLparam4(vc,fields,types,num);  CAMLlocal1(result);  fs = (char **)malloc(Int_val(num) * sizeof(char *));  if( !fs )    caml_failwith("malloc returned NULL in vc_recordTypeN wrapper");  ts = (Type *)malloc(Int_val(num) * sizeof(Type));  if( !ts ) {    free( fs );    caml_failwith("malloc returned NULL in vc_recordTypeN wrapper");  }  for( i = 0; i < Int_val(num); i++ ) {    fs[i] = String_val(Field(fields,i));    ts[i] = Type_val(Field(types,i));  }  result = alloc_Type(vc_recordTypeN(VC_val(vc),fs,ts,Int_val(num)));  free(ts);  free(fs);  CAMLreturn(result);}

CAMLprim value caml_ml_input(value vchannel, value buff, value vstart,                             value vlength){  CAMLparam4 (vchannel, buff, vstart, vlength);  struct channel * channel = Channel(vchannel);  intnat start, len;  int n, avail, nread;  Lock(channel);  /* We cannot call caml_getblock here because buff may move during     caml_do_read */  start = Long_val(vstart);  len = Long_val(vlength);  n = len >= INT_MAX ? INT_MAX : (int) len;  avail = channel->max - channel->curr;  if (n <= avail) {    memmove(&Byte(buff, start), channel->curr, n);    channel->curr += n;  } else if (avail > 0) {    memmove(&Byte(buff, start), channel->curr, avail);    channel->curr += avail;    n = avail;  } else {    nread = caml_do_read(channel->fd, channel->buff,                         channel->end - channel->buff);    channel->offset += nread;    channel->max = channel->buff + nread;    if (n > nread) n = nread;    memmove(&Byte(buff, start), channel->buff, n);    channel->curr = channel->buff + n;  }  Unlock(channel);  CAMLreturn (Val_long(n));}

value caml_vc_setStrSeqFlag(value flags, value name, value str, value val){  CAMLparam4(flags,name,str,val);  vc_setStrSeqFlag(Flags_val(flags),String_val(name),		   String_val(val),Int_val(val));  CAMLreturn(Val_unit);}

CAMLprim value stub_sockopt_set_sock_keepalives(value fd, value count, value idle, value interval){    CAMLparam4(fd, count, idle, interval);	int c_fd = Int_val(fd);	int optval;	socklen_t optlen=sizeof(optval);		optval = Int_val(count);	if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPCNT, &optval, optlen) < 0) {	  uerror("setsockopt(TCP_KEEPCNT)", Nothing);	}#if defined(__linux__)		optval = Int_val(idle);	if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPIDLE, &optval, optlen) < 0) {	  uerror("setsockopt(TCP_KEEPIDLE)", Nothing);	}#endif	optval = Int_val(interval);	if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPINTVL, &optval, optlen) < 0) {	  uerror("setsockopt(TCP_KEEPINTVL)", Nothing);	}	CAMLreturn(Val_unit);}

CAMLprim value stub_sha1_update(value ctx, value data, value ofs, value len){	CAMLparam4(ctx, data, ofs, len);	sha1_update(GET_CTX_STRUCT(ctx), String_val(data) + Int_val(ofs), Int_val(len));	CAMLreturn(Val_unit);}

CAMLprim value caml_mdb_cursor_get(value curs,value key,value data,value op){  CAMLparam4(curs,key,data,op);  CAMLlocal3(result,mlkey,mldata);  MDB_val key_,data_;  key_.mv_data=String_val(key);  key_.mv_size=caml_string_length(key);  data_.mv_data=String_val(data);  data_.mv_size=caml_string_length(data);  int ret;  if((ret=mdb_cursor_get(  (MDB_cursor*)curs,  &key_,  &data_, Int_val(op) ))){    if(ret==MDB_NOTFOUND) {      static value *exn=NULL;      if(exn==NULL) exn=caml_named_value("lmdb_not_found");      caml_raise_constant(*exn);    } else      caml_failwith("error in mdb_cursor_get");  }  mlkey=caml_alloc_string(key_.mv_size);  memcpy(String_val(mlkey),key_.mv_data,key_.mv_size);  mldata=caml_alloc_string(data_.mv_size);  memcpy(String_val(mldata),data_.mv_data,data_.mv_size);  result=caml_alloc(2,0);  Store_field(result,0,mlkey);  Store_field(result,1,mldata);  CAMLreturn(result);}

valuecaml_drawtext(value string, value pos, value matches, value colors) {    CAMLparam4(string, pos, matches, colors);    size_t size = textw(dc, String_val (string));    int x = Int_val(Field(pos, 0));    if (bottom)        /* magic formula */        dc->y = mh - (bh - dc->font.ascent - 1 + Int_val(Field(pos, 1)) * bh);    else        dc->y = dc->font.ascent+1 + Int_val(Field(pos, 1)) * bh;    drawrect(dc, x, dc->y-dc->font.ascent-1, size, bh, True, getcolor(dc, String_val(Field(colors, 2))));    int start, stop;    unsigned long fg;    int xoff = x + dc->font.height/2;    const char *str = String_val (string);    value head;    while (matches != Val_int(0)) {        head = Field (matches, 0);        matches = Field (matches, 1);        dc->x = xoff;        fg = getcolor(dc, String_val(Int_val(Field(head, 0)) == 0 ? Field(colors, 0) : Field(colors, 1)));        start = Int_val(Field (head, 1));        stop = Int_val(Field (head, 2));        xoff += drawtext(dc, str, start, stop, fg);    }    CAMLreturn(Val_int(x + size));}

CAMLprim valuestub_ba_send(value fd, value val_buf, value val_ofs, value val_len){  CAMLparam4(fd, val_buf, val_ofs, val_len);  int ret = 0;#ifdef WIN32  char *data = (char*)Caml_ba_data_val(val_buf) + Long_val(val_ofs);  size_t c_len = Int_val(val_len);  SOCKET s = Socket_val(fd);  DWORD err = 0;  caml_release_runtime_system();  ret = send(s, data, c_len, 0);  if (ret == SOCKET_ERROR) err = WSAGetLastError();  caml_acquire_runtime_system();  if (err) {    win32_maperr(err);    uerror("read", Nothing);  }#else  caml_failwith("AF_HYPERV only available on Windows");#endif  CAMLreturn(Val_int(ret));}

CAMLprim value ml_QObject_connect (value sender, value signal, value receiver, value member) {  CAMLparam4(sender,signal,receiver,member);  char *sg = String_val(signal);  char *sl = String_val(member);  int len1 = strlen(sg), len2 = strlen(sl);  char cc1[len1+2];  char cc2[len2+2];//  printf("signal = %s, slot = %s/n", sg, sl);  cc1[len1+1] = cc2[len2+1] = '/0';  cc1[0] = '2'; cc2[0] = '1';  int i=1;  for (   ;i<=len1; ++i) cc1[i] = sg[i-1];  for (i=1;i<=len2; ++i) cc2[i] = sl[i-1];//  QString s1 = QString("2%1").arg(QString(sg)),//	  s2 = QString("1%1").arg(QString(sl));//  printf("signal = %s, slot = %s/n", s1.toLocal8Bit().data(), s2.toLocal8Bit().data() );//  const char *loc1 = s1.toLocal8Bit().data();//  const char *loc2 = s2.toLocal8Bit().data();  printf ("trying to connect %s -> %s/n", cc1, cc2);  CAMLreturn(     Val_bool      (QObject::connect(QObject_val(sender),                          cc1,                        QObject_val(receiver),                        cc2) ) );}

CAMLprim value stub_gnttab_map_fresh(value i, value r, value d, value w){    CAMLparam4(i, r, d, w);    /* The OCaml code will never call this because gnttab_allocates is false */    printk("FATAL ERROR: stub_gnttab_map_fresh called/n");    caml_failwith("stub_gnttab_map_fresh");}

CAMLprim value stub_load_rsa_keys(value keys, value cert, value priv, value trustedCA){  CAMLparam4(keys,cert,priv,trustedCA);  unsigned char *c_cert = (unsigned char *)strdup(String_val(cert));  unsigned char *c_priv = (unsigned char *)strdup(String_val(priv));  unsigned char *c_trustedCA = (unsigned char *)strdup(String_val(trustedCA));  int cert_len = caml_string_length(cert);  int priv_len = caml_string_length(priv);  int trustedCA_len = caml_string_length(trustedCA);  fprintf(stderr,"Got lens: %d %d %d/n",cert_len,priv_len,trustedCA_len);  if(cert_len==0) c_cert=NULL;  if(priv_len==0) c_priv=NULL;  if(trustedCA_len==0) c_trustedCA=NULL;  int rc;  rc=matrixSslLoadRsaKeysMem(sslKeys_t_val(keys), c_cert, cert_len, c_priv, priv_len,			     c_trustedCA, trustedCA_len);  if(rc<0) {    fprintf(stderr,"rc=%d/n",rc);    caml_failwith("Failed to load certificates");  }  CAMLreturn(Val_unit);}

CAMLprim value caml_mdb_env_open(value env,value path,value flags,value mode){  CAMLparam4(env,path,flags,mode);  if(mdb_env_open((MDB_env*)env,String_val(path),Int_val(flags),Int_val(mode))){    caml_failwith("error in mdb_env_open");  }  CAMLreturn(env);}

value f_i4_caml(value i0, value i1, value i2, value i3) {  CAMLparam4(i0,i1,i2,i3);  int ii0 = Int_val(i0);  int ii1 = Int_val(i1);  int ii2 = Int_val(i2);  int ii3 = Int_val(i3);  CAMLreturn(Val_int(f_i4(ii0,ii1,ii2,ii3)));}

CAMLprim value stub_sha1_update(value ctx, value data, value ofs, value len){	CAMLparam4(ctx, data, ofs, len);	sha1_update(GET_CTX_STRUCT(ctx), (unsigned char *) data + Long_val(ofs),	            Long_val(len));	CAMLreturn(Val_unit);}

CAMLprim value cstring_to_binary_array (value dst_arr, value dst_idx, value dst_len, value src_str){	CAMLparam4 (dst_arr, dst_idx, dst_len, src_str);	int len = string_length (src_str), idx = Long_val(dst_idx), dlen = Long_val(dst_len);	if (idx + dlen > Bigarray_val(dst_arr)->dim[0] || len > dlen) invalid_argument ("Binarray.write_sz");	memcpy ((char *) Data_bigarray_val(dst_arr) + idx, String_val(src_str), len);	memset ((char *) Data_bigarray_val(dst_arr) + idx + len, 0, dlen - len);	CAMLreturn (Val_unit);}

void hdf5_h5lt_make_dataset(value loc_id_v, value dset_name_v, value type_id_v,  value buffer_v){  CAMLparam4(loc_id_v, dset_name_v, type_id_v, buffer_v);  struct caml_ba_array *buffer = Caml_ba_array_val(buffer_v);  raise_if_fail(H5LTmake_dataset(Hid_val(loc_id_v), String_val(dset_name_v),    buffer->num_dims, (const hsize_t*) buffer->dim, Hid_val(type_id_v), buffer->data));  CAMLreturn0;}

CAMLprim value stub_utp_write (value socket, value buf, value off, value len){  CAMLparam4(socket, buf, off, len);  ssize_t written;  written = utp_write (Utp_socket_val (socket), Caml_ba_data_val(buf) + Int_val(off), Int_val(len));  if (written < 0) caml_failwith ("utp_write");  CAMLreturn (Val_int (written));}

CAMLprim valuecaml_gnttab_grant_access(value v_ref, value v_bs, value v_domid, value v_readonly){    CAMLparam4(v_ref, v_bs, v_domid, v_readonly);    grant_ref_t ref = Int32_val(v_ref);    char *page = String_val(Field(v_bs, 0)) + (Int_val(Field(v_bs,1)) / 8);    ASSERT(((unsigned long)page) % PAGE_SIZE == 0);    gnttab_grant_access(ref, page, Int_val(v_domid), Bool_val(v_readonly));    CAMLreturn(Val_unit);}

CAMLprim valuenetcgi2_apache_request_output(value rv, value bufv, value ofsv, value lenv){    CAMLparam4(rv, bufv, ofsv, lenv);    request_rec *r = Request_rec_val(rv);    int ofs = Int_val(ofsv);    int len = Int_val(lenv);    int i = ap_rwrite(String_val(bufv) + ofs, len, r);    CAMLreturn(Val_int (i));}