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_list
value 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);
}