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 CAMLprim value 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 value Val_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, µ, &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 ***)©) ){ 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 value netcgi2_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)); }
value v2v_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 value camluv_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); }
value ocaml_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 value ml_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 field value 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); }