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

CAMLprim value stub_string_of_header(value tid, value rid, value ty, value len){	CAMLparam4(tid, rid, ty, len);	CAMLlocal1(ret);	struct xsd_sockmsg xsd = {		.type = Int_val(ty),		.tx_id = Int_val(tid),		.req_id = Int_val(rid),		.len = Int_val(len),	};	ret = caml_alloc_string(sizeof(struct xsd_sockmsg));	memcpy(String_val(ret), &xsd, sizeof(struct xsd_sockmsg));	CAMLreturn(ret);}

extern CAMLprimvalue kc_exists(value caml_db, value key){  CAMLparam2(caml_db, key);  CAMLlocal1(val);  KCDB* db = get_db(caml_db);  if (! kcdbaccept(db,    String_val(key), caml_string_length(key),    exists_some_value, exists_no_value, &val, 0  )) {     RAISE(kcdbemsg(db));  }    CAMLreturn(val);}

CAMLprim value caml_picosat_sat(value limit) {    CAMLparam1 (limit);    CAMLlocal1( res );    switch (picosat_sat(Int_val(limit))) {    case PICOSAT_UNSATISFIABLE :        res = Val_int(-1) ;        break ;    case PICOSAT_SATISFIABLE :        res = Val_int(1) ;        break ;    case PICOSAT_UNKNOWN :        res = Val_int(0) ;        break ;    }    CAMLreturn(res);}

value alpm_to_caml_list ( alpm_list_t * list, alpm_elem_conv converter ){    CAMLparam0();    CAMLlocal1( cell );    if ( list ) {        cell = caml_alloc( 2, 0 );        Store_field( cell, 0, (*converter)( list->data ));        Store_field( cell, 1, alpm_to_caml_list( list->next, converter ));    }    else {        cell = Val_int( 0 );    }    CAMLreturn( cell );}

CAMLprim value stub_xc_gntshr_open(void){	CAMLparam0();	CAMLlocal1(result);#ifdef HAVE_GNTSHR	xc_gntshr *xgh;	xgh = xc_gntshr_open(NULL, 0);	if (NULL == xgh)		failwith_xc(NULL);	result = (value)xgh;#else	gntshr_missing();#endif	CAMLreturn(result);}

static valueVal_SDL_RendererInfo(SDL_RendererInfo * info){#if 0    Uint32 flags;               /**< Supported ::SDL_RendererFlags */    Uint32 num_texture_formats; /**< The number of available texture formats */    Uint32 texture_formats[16]; /**< The available texture formats */#endif    CAMLparam0();    CAMLlocal1(ret);    ret = caml_alloc(3, 0);    Store_field(ret, 0, caml_copy_string(info->name));    Store_field(ret, 1, Val_int(info->max_texture_width));    Store_field(ret, 2, Val_int(info->max_texture_height));    CAMLreturn(ret);}

CAMLprim value caml_sys_read_directory(value path){  CAMLparam1(path);  CAMLlocal1(result);  struct ext_table tbl;  caml_ext_table_init(&tbl, 50);  if (caml_read_directory(String_val(path), &tbl) == -1){    caml_ext_table_free(&tbl, 1);    caml_sys_error(path);  }  caml_ext_table_add(&tbl, NULL);  result = caml_copy_string_array((char const **) tbl.contents);  caml_ext_table_free(&tbl, 1);  CAMLreturn(result);}

CAMLprim value stub_xc_gntshr_munmap(value xgh, value share) {	CAMLparam2(xgh, share);	CAMLlocal1(ml_map);#ifdef HAVE_GNTSHR	ml_map = Field(share, 1);	int size = Caml_ba_array_val(ml_map)->dim[0];	int pages = size >> XC_PAGE_SHIFT;	int result = xc_gntshr_munmap(_G(xgh), Caml_ba_data_val(ml_map), pages);	if(result != 0)		failwith_xc(_G(xgh));#else	gntshr_missing();#endif	CAMLreturn(Val_unit);}

CAMLprim value ocaml_gstreamer_caps_to_string(value _c){  CAMLparam1(_c);  CAMLlocal1(ans);  GstCaps *c = Caps_val(_c);  char *s;  caml_release_runtime_system();  s = gst_caps_to_string(c);  caml_acquire_runtime_system();  ans = caml_copy_string(s);  free(s);  CAMLreturn(ans);}

CAMLprim value ocaml_gstreamer_version(value unit){  CAMLparam0();  CAMLlocal1(ans);  unsigned int major, minor, micro, nano;  gst_version(&major, &minor, &micro, &nano);  ans = caml_alloc_tuple(4);  Store_field(ans,0,Val_int(major));  Store_field(ans,1,Val_int(minor));  Store_field(ans,2,Val_int(micro));  Store_field(ans,3,Val_int(nano));  CAMLreturn(ans);}

CAMLprim value ml_gtk_init (value argv){    CAMLparam1 (argv);    int argc = Wosize_val(argv), i;    CAMLlocal1 (copy);    copy = (argc ? alloc (argc, Abstract_tag) : Atom(0));    for (i = 0; i < argc; i++) Field(copy,i) = Field(argv,i);    if( !gtk_init_check (&argc, (char ***)&copy) ){      ml_raise_gtk ("ml_gtk_init: initialization failed");    }    argv = (argc ? alloc (argc, 0) : Atom(0));    for (i = 0; i < argc; i++) modify(&Field(argv,i), Field(copy,i));    CAMLreturn (argv);}

CAMLprim value stub_gntshr_open(value unit){	CAMLparam1(unit);	CAMLlocal1(result);#ifdef HAVE_GNTSHR	xc_gntshr *xgh;	xgh = xc_gntshr_open(NULL, 0);	if (NULL == xgh)		caml_failwith("Failed to open interface");	result = (value)xgh;#else	gntshr_missing();#endif	CAMLreturn(result);}

CAMLprim valuenetcgi2_apache_request_get_basic_auth_pw (value rv){    CAMLparam1 (rv);    CAMLlocal1 (c);    request_rec *r = Request_rec_val (rv);    const char *pw = 0;    int i = ap_get_basic_auth_pw (r, &pw); /* no need to free(pw) */    /* Return [i] as the first component of a couple so we can deal with     * the possible errors on the Caml side. */    if (i == DECLINED) pw = NULL;	/* FIXME */    c = alloc_tuple (2);    Store_field(c, 0, Val_int(i));    Store_field(c, 1, Val_optstring(pw));    CAMLreturn (c);}

static int callml_custom_solve(SUNLinearSolver ls, SUNMatrix A, N_Vector x,                               N_Vector b, realtype tol){    CAMLparam0();    CAMLlocal1(r);    CAMLlocalN(args, 4);    Store_field(args, 0, (A == NULL) ? Val_unit : MAT_BACKLINK(A));    Store_field(args, 1, NVEC_BACKLINK(x));    Store_field(args, 2, NVEC_BACKLINK(b));    Store_field(args, 3, caml_copy_double(tol));    r = caml_callbackN_exn(GET_OP(ls, SOLVE), 4, args);    CAMLreturnT(int, CHECK_EXCEPTION_SUCCESS(r));}

value caml_read_history(value name) {    CAMLparam1(name);    int result;    result = read_history( String_val(name) );    if (result == ENOENT) {        raise_not_found();    }    else if (result != 0) {        CAMLlocal1(error);        error = copy_string(strerror( result ));        raise_sys_error( error );    }    CAMLreturn(Val_unit);}

CAMLprim value mltds_ct_con_alloc(value context){    CAMLparam1(context);    CS_CONNECTION* conn;    CAMLlocal1(result);    retval_inspect( "ct_con_alloc", ct_con_alloc(context_ptr(context), &conn) );    retval_inspect( "ct_diag",                    ct_diag(conn, CS_INIT, CS_UNUSED, CS_UNUSED, NULL) );    result = alloc_custom(&connection_operations, sizeof(CS_CONNECTION*), 0, 1);    connection_ptr(result) = conn;    CAMLreturn(result);}

/*     LibPar.register_untyped_function(      fn_name_c_str,      globals_array, n_globals,      postional_args_array, n_positional,      default_args_array, default_values_array, n_defaults,      parakeet_syntax))      */int register_untyped_function(  char *name,  char **globals, int num_globals,  char **args, int num_args,  char **default_args, paranode *default_arg_values, int num_defaults,  paranode ast) {  CAMLparam0();  CAMLlocal3(val_name, globals_list, args_list);  CAMLlocal2(default_arg_names_list, default_arg_values_list);  CAMLlocal1(fn_id);  printf(":: registering untyped fn (%s, %d/%d/%d globals/args/defaults)/n",    name, num_globals, num_args, num_defaults);  printf("::: ast pointer %p/n", ast);  val_name = caml_copy_string(name);  printf("::: building globals list/n");  globals_list = build_str_list(globals, num_globals);  printf("::: building args list/n");  args_list    = build_str_list(args, num_args);  printf("::: building defaults list/n");  default_arg_names_list = build_str_list(default_args, num_defaults);  printf("::: building default values list/n");  default_arg_values_list = mk_val_list(default_arg_values, num_defaults);  printf("::: building fn args/n");  printf("::: ast = %d/n", ast);  printf("::: ast->v = %d/n", ast->v);  value func_args[6] = {    val_name,    globals_list,    args_list,    default_arg_names_list,     default_arg_values_list,    ast->v  };  printf("/n/n");  printf("  ...calling into OCaml's register function/n");  fn_id = caml_callbackN(*ocaml_register_untyped_function, 6, func_args);  printf("DONE WITH FN ID: %d/n", Int_val(fn_id));  CAMLreturnT(int, Int_val(fn_id));}

valuev2v_xml_copy_doc (value docv, value recursivev){  CAMLparam2 (docv, recursivev);  CAMLlocal1 (copyv);  xmlDocPtr doc, copy;  doc = Doc_val (docv);  copy = xmlCopyDoc (doc, Bool_val (recursivev));  if (copy == NULL)    caml_invalid_argument ("copy_doc: failed to copy");  copyv = caml_alloc_custom (&doc_custom_operations, sizeof (xmlDocPtr), 0, 1);  Doc_val (copyv) = copy;  CAMLreturn (copyv);}

value mk_actual_ast_args(          paranode *args,           int num_args,          char** keywords,          paranode* keyword_values,          int num_keyword_args) {  CAMLparam0();   CAMLlocal3(pos_list, kwd_list, kwd_values_list);  CAMLlocal1(actual_args);  printf("Creating args, n_positional = %d, n_kwd = %d/n", num_args, num_keyword_args);  pos_list = mk_val_list(args, num_args);  kwd_list = build_str_list(keywords, num_keyword_args);  kwd_values_list = mk_val_list(keyword_values, num_keyword_args);  actual_args = /    caml_callback3(*ocaml_mk_actual_args, pos_list, kwd_list, kwd_values_list);  CAMLreturn(actual_args);}

CAMLprim valuecamluv_key_init(value unit){  CAMLparam0();  CAMLlocal1(key);  int rc = -1;  camluv_key_t *camluv_key = camluv_key_new();  rc = uv_key_create(&(camluv_key->uv_key));  if (rc != UV_OK) {    // TODO: error handling.  }  camluv_key->initialized = 1;  key = camluv_copy_key(camluv_key);  CAMLreturn(key);}

CAMLprim value win_filedescr_of_channel(value vchan){  CAMLparam1(vchan);  CAMLlocal1(fd);  struct channel * chan;  HANDLE h;  chan = Channel(vchan);  if (chan->fd == -1) uerror("descr_of_channel", Nothing);  h = (HANDLE) _get_osfhandle(chan->fd);  if (chan->flags & CHANNEL_FLAG_FROM_SOCKET)    fd = win_alloc_socket((SOCKET) h);  else    fd = win_alloc_handle(h);  CRT_fd_val(fd) = chan->fd;  CAMLreturn(fd);}

CAMLprim value caml_gc_counters(value v){  CAMLparam0 ();   /* v is ignored */  CAMLlocal1 (res);  /* get a copy of these before allocating anything... */  double minwords = caml_stat_minor_words                    + (double) (caml_young_alloc_end - caml_young_ptr);  double prowords = caml_stat_promoted_words;  double majwords = caml_stat_major_words + (double) caml_allocated_words;  res = caml_alloc_tuple (3);  Store_field (res, 0, caml_copy_double (minwords));  Store_field (res, 1, caml_copy_double (prowords));  Store_field (res, 2, caml_copy_double (majwords));  CAMLreturn (res);}

valueocaml_guestfs_last_errno (value gv){  CAMLparam1 (gv);  CAMLlocal1 (rv);  int r;  guestfs_h *g;  g = Guestfs_val (gv);  if (g == NULL)    ocaml_guestfs_raise_closed ("last_errno");  r = guestfs_last_errno (g);  rv = Val_int (r);  CAMLreturn (rv);}

//+   external create : unit -> t = "caml_dbenv_create"value caml_dbenv_create(value unit){  CAMLparam1(unit);  CAMLlocal1(rval);  int err;  int flags = 0;  DB_ENV *dbenv;    err = db_env_create(&dbenv,flags);  if (err != 0) { raise_db(db_strerror(err)); }  dbenv->set_errcall(dbenv,raise_db_cb);  rval = alloc_custom(&dbenv_custom,Camldbenv_wosize,0,1);  UW_dbenv(rval) = dbenv;  UW_dbenv_closed(rval) = False;  CAMLreturn (rval);}

CAMLprim value stub_get_out_data(value ssl){  CAMLparam1(ssl);  CAMLlocal1(v);  unsigned char *str;  int rc=matrixSslGetOutdata(ssl_t_val(ssl), &str);  if(rc>0) {    v=caml_alloc_string(rc);    memcpy(String_val(v),str,rc);  } else {    caml_failwith("No data");  }  CAMLreturn(v);}

/** * Export the constants provided by Facebook's build system to ocaml-land, since * their FFI only allows you to call functions, not reference variables. Doing * it this way makes sense for Facebook internally since our build system has * machinery for providing these two constants automatically (and no machinery * for doing codegen in a consistent way to build an ocaml file with them) but * is very roundabout for external users who have to have CMake codegen these * constants anyways. Sorry about that. */value hh_get_build_revision(void) {  CAMLparam0();  CAMLlocal1(result);#ifdef HH_BUILD_ID  const char* const buf =    STRINGIFY_VALUE(HH_BUILD_ID) "-" HHVM_VERSION_C_STRING_LITERALS;#else  const char* const buf = BuildInfo_kRevision;#endif  const size_t len = strlen(buf);  result = caml_alloc_string(len);  memcpy(String_val(result), buf, len);  CAMLreturn(result);}

CAMLprim value perform_lgetxattr(value file, value name){ CAMLparam2(file, name); CAMLlocal1(ret); ssize_t siz; siz = LGETXATTR(String_val(file), String_val(name), NULL, 0); if(siz < 0)     caml_failwith("lgetxattr"); ret = caml_alloc_string(siz); if(LGETXATTR(String_val(file), String_val(name), String_val(ret), siz) < 0) {     caml_failwith("lgetxattr"); } CAMLreturn(ret);}

CAMLprim valueml_cairo_fill_extents (value v_cr){  double x1, y1, x2, y2;  cairo_fill_extents (cairo_t_val (v_cr), &x1, &y1, &x2, &y2);  check_cairo_status (v_cr);  {    CAMLparam0 ();    CAMLlocal1 (t);    t = caml_alloc_tuple (4);    Store_field (t, 0, caml_copy_double (x1));    Store_field (t, 1, caml_copy_double (y1));    Store_field (t, 2, caml_copy_double (x2));    Store_field (t, 3, caml_copy_double (y2));    CAMLreturn (t);  }}

// Get grid values from a GRIB fieldvalue ml_get_data( value ml_field ) {    CAMLparam1( ml_field );    CAMLlocal1( ml_data );    int i;    gribfield *field;    field = Gribfield_val( ml_field );    // Allocate an OCaml array and copy the data over    ml_data = caml_alloc( field->ndpts * Double_wosize, Double_array_tag );    for ( i = 0; i < field->ndpts; i++ ) {        Store_double_field( ml_data, i, field->fld[i] );    }    // Return the OCaml-formatted data copy    CAMLreturn( ml_data );}

CAMLprim value win_getenv(value var){  LPWSTR s;  DWORD len;  CAMLparam1(var);  CAMLlocal1(res);  s = stat_alloc (65536);  len = GetEnvironmentVariableW((LPCWSTR) String_val(var), s, 65536);  if (len == 0) { stat_free (s); raise_not_found(); }  res = copy_wstring(s);  stat_free (s);  CAMLreturn (res);}