CAMLprim value ocaml_f0r_dlopen(value fname) { CAMLparam1(fname); CAMLlocal1(ans); plugin_t *p = malloc(sizeof(plugin_t)); p->handle = dlopen(String_val(fname), RTLD_LAZY); if (!p->handle) { free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); } p->init = dlsym(p->handle, "f0r_init"); if (!p->init) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); } p->deinit = dlsym(p->handle, "f0r_deinit"); if (!p->deinit) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); } p->get_plugin_info = dlsym(p->handle, "f0r_get_plugin_info"); if (!p->get_plugin_info) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); } p->get_param_info = dlsym(p->handle, "f0r_get_param_info"); if (!p->get_param_info) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); } p->construct = dlsym(p->handle, "f0r_construct"); if (!p->construct) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); } p->destruct = dlsym(p->handle, "f0r_destruct"); if (!p->destruct) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); } p->get_param_value = dlsym(p->handle, "f0r_get_param_value"); if (!p->get_param_value) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); } p->set_param_value = dlsym(p->handle, "f0r_set_param_value"); if (!p->set_param_value) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); } p->update = dlsym(p->handle, "f0r_update"); p->update2 = dlsym(p->handle, "f0r_update2"); if (!p->update && !p->update2) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); } p->init(); ans = caml_alloc_custom(&plugin_ops, sizeof(plugin_t*), 0, 1); Plugin_val(ans) = p; CAMLreturn(ans); }
void zompInitCamlCallbacks() { isBoundCB = caml_named_value("isBound"); lookupCB = caml_named_value("lookup"); parseCB = caml_named_value("parse"); getCounterValueInt = caml_named_value("zompCommonGetCounterValueInt"); getCounterValueFloat = caml_named_value("zompCommonGetCounterValueFloat"); }
static uint64 on_state_change (utp_callback_arguments *a) { CAMLparam0 (); value *cb; static value *on_connect_fun = NULL; static value *on_writable_fun = NULL; static value *on_eof_fun = NULL; static value *on_close_fun = NULL; if (on_connect_fun == NULL) on_connect_fun = caml_named_value ("utp_on_connect"); if (on_writable_fun == NULL) on_writable_fun = caml_named_value ("utp_on_writable"); if (on_eof_fun == NULL) on_eof_fun = caml_named_value ("utp_on_eof"); if (on_close_fun == NULL) on_close_fun = caml_named_value ("utp_on_close"); switch (a->state) { case UTP_STATE_CONNECT: cb = on_connect_fun; break; case UTP_STATE_WRITABLE: cb = on_writable_fun; break; case UTP_STATE_EOF: cb = on_eof_fun; break; case UTP_STATE_DESTROYING: UTP_DEBUG ("destroying socket"); cb = on_close_fun; break; default: UTP_DEBUG ("unknown state change: %d", a->state); cb = NULL; break; } if (cb) caml_callback (*cb, Val_utp_socket (a->socket)); CAMLreturn (0); }
CAMLprim value ocaml_ssl_embed_socket(value socket_, value context) { CAMLparam1(context); CAMLlocal1(block); #ifdef Socket_val SOCKET socket = Socket_val(socket_); #else int socket = Int_val(socket_); #endif SSL_CTX *ctx = Ctx_val(context); SSL *ssl; block = caml_alloc_custom(&socket_ops, sizeof(SSL*), 0, 1); if (socket < 0) caml_raise_constant(*caml_named_value("ssl_exn_invalid_socket")); caml_enter_blocking_section(); ssl = SSL_new(ctx); if (!ssl) { caml_leave_blocking_section(); caml_raise_constant(*caml_named_value("ssl_exn_handler_error")); } SSL_set_fd(ssl, socket); caml_leave_blocking_section(); SSL_val(block) = ssl; CAMLreturn(block); }
CAMLprim value ocaml_gstreamer_appsrc_push_buffer_data(value _as, value _buf) { CAMLparam2(_as, _buf); int buflen = Caml_ba_array_val(_buf)->dim[0]; appsrc *as = Appsrc_val(_as); GstBuffer *gstbuf; GstMapInfo map; GstFlowReturn ret; gboolean bret; caml_release_runtime_system(); gstbuf = gst_buffer_new_and_alloc(buflen); bret = gst_buffer_map(gstbuf, &map, GST_MAP_WRITE); caml_acquire_runtime_system(); if(!bret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure")); memcpy(map.data, (unsigned char*)Caml_ba_data_val(_buf), buflen); caml_release_runtime_system(); gst_buffer_unmap(gstbuf, &map); ret = gst_app_src_push_buffer(as->appsrc, gstbuf); caml_acquire_runtime_system(); if (ret != GST_FLOW_OK) caml_raise_constant(*caml_named_value("gstreamer_exn_failure")); CAMLreturn(Val_unit); }
CAMLprim value ocaml_ssl_ctx_init_ec_from_named_curve(value context, value curve_name) { CAMLparam2(context, curve_name); EC_KEY *ecdh = NULL; int nid = 0; SSL_CTX *ctx = Ctx_val(context); char *ec_curve_name = String_val(curve_name); if(*ec_curve_name == 0) caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error")); nid = OBJ_sn2nid(ec_curve_name); if(nid == 0){ caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error")); } caml_enter_blocking_section(); ecdh = EC_KEY_new_by_curve_name(nid); if(ecdh != NULL){ if(SSL_CTX_set_tmp_ecdh(ctx,ecdh) != 1){ caml_leave_blocking_section(); caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error")); } SSL_CTX_set_options(ctx, SSL_OP_SINGLE_ECDH_USE); caml_leave_blocking_section(); EC_KEY_free(ecdh); } else{ caml_leave_blocking_section(); caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error")); } CAMLreturn(Val_unit); }
CAMLprim value ocaml_ssl_ctx_init_dh_from_file(value context, value dh_file_path) { CAMLparam2(context, dh_file_path); DH *dh = NULL; SSL_CTX *ctx = Ctx_val(context); char *dh_cfile_path = String_val(dh_file_path); if(*dh_cfile_path == 0) caml_raise_constant(*caml_named_value("ssl_exn_diffie_hellman_error")); dh = load_dh_param(dh_cfile_path); caml_enter_blocking_section(); if (dh != NULL){ if(SSL_CTX_set_tmp_dh(ctx,dh) != 1){ caml_leave_blocking_section(); caml_raise_constant(*caml_named_value("ssl_exn_diffie_hellman_error")); } SSL_CTX_set_options(ctx, SSL_OP_SINGLE_DH_USE); caml_leave_blocking_section(); DH_free(dh); } else{ caml_leave_blocking_section(); caml_raise_constant(*caml_named_value("ssl_exn_diffie_hellman_error")); } CAMLreturn(Val_unit); }
CAMLprim value ocaml_ssl_ctx_use_certificate(value context, value cert, value privkey) { CAMLparam3(context, cert, privkey); SSL_CTX *ctx = Ctx_val(context); char *cert_name = String_val(cert); char *privkey_name = String_val(privkey); caml_enter_blocking_section(); if (SSL_CTX_use_certificate_chain_file(ctx, cert_name) <= 0) { caml_leave_blocking_section(); caml_raise_constant(*caml_named_value("ssl_exn_certificate_error")); } if (SSL_CTX_use_PrivateKey_file(ctx, privkey_name, SSL_FILETYPE_PEM) <= 0) { caml_leave_blocking_section(); caml_raise_constant(*caml_named_value("ssl_exn_private_key_error")); } if (!SSL_CTX_check_private_key(ctx)) { caml_leave_blocking_section(); caml_raise_constant(*caml_named_value("ssl_exn_unmatching_keys")); } caml_leave_blocking_section(); CAMLreturn(Val_unit); }
CAMLprim value caml_sqlite3_init(value __unused v_unit) { caml_sqlite3_InternalError = caml_named_value("Sqlite3.InternalError"); caml_sqlite3_Error = caml_named_value("Sqlite3.Error"); caml_sqlite3_RangeError = caml_named_value("Sqlite3.RangeError"); return Val_unit; }
CAMLprim value PQocaml_init(value __unused v_unit) { v_empty_string = caml_alloc_string(0); caml_register_generational_global_root(&v_empty_string); v_exc_Oid = caml_named_value("Postgresql.Oid"); v_null_param = caml_named_value("Postgresql.null"); return Val_unit; }
CAMLprim value camltk_init(value v) { /* Initialize the OCaml pointers */ if (tkerror_exn == NULL) tkerror_exn = caml_named_value("tkerror"); if (handler_code == NULL) handler_code = caml_named_value("camlcb"); return Val_unit; }
value caml_db_init(value v){ CAMLparam1(v); if (caml_db_exn == NULL) caml_db_exn = caml_named_value("dberror"); if (caml_key_exists_exn == NULL) caml_key_exists_exn = caml_named_value("keyexists"); if (caml_db_run_recovery_exn == NULL) caml_db_run_recovery_exn = caml_named_value("dbrunrecovery"); CAMLreturn (Val_unit); }
void ast_init(void) { if (ast_inited) return; ast_inited = 1; ocaml_mk_ast_info = caml_named_value("mk_ast_info"); ocaml_print_ast_node = caml_named_value("print_ast_node"); ocaml_get_prim = caml_named_value("get_prim"); ocaml_mk_formal_args = caml_named_value("mk_formal_args"); ocaml_mk_actual_args = caml_named_value("mk_actual_args"); }
CAMLprim value ocaml_gstreamer_appsink_pull_buffer(value _as, value string_mode) { CAMLparam1(_as); CAMLlocal1(ans); appsink *as = Appsink_val(_as); GstSample *gstsample; GstBuffer *gstbuf; GstMapInfo map; intnat len; gboolean ret; caml_release_runtime_system(); gstsample = gst_app_sink_pull_sample(as->appsink); caml_acquire_runtime_system(); if (!gstsample) { if (gst_app_sink_is_eos(as->appsink)) caml_raise_constant(*caml_named_value("gstreamer_exn_eos")); else caml_raise_constant(*caml_named_value("gstreamer_exn_failure")); } caml_release_runtime_system(); gstbuf = gst_sample_get_buffer(gstsample); caml_acquire_runtime_system(); if (!gstbuf) caml_raise_constant(*caml_named_value("gstreamer_exn_failure")); caml_release_runtime_system(); ret = gst_buffer_map(gstbuf, &map, GST_MAP_READ); caml_acquire_runtime_system(); if (!ret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure")); len = map.size; if (string_mode == Val_false) { ans = caml_ba_alloc(CAML_BA_C_LAYOUT | CAML_BA_UINT8, 1, NULL, &len); memcpy(Caml_ba_data_val(ans), map.data, len); } else { ans = caml_alloc_string(len); memcpy(String_val(ans), map.data, len); } caml_release_runtime_system(); gst_buffer_unmap(gstbuf, &map); gst_sample_unref(gstsample); caml_acquire_runtime_system(); CAMLreturn(ans); }
CAMLprim value caml_bjack_read(value device, value len) { CAMLparam2(device,len); CAMLlocal1(ans); int n = Int_val(len) ; char* buf = malloc(n) ; jack_driver_t* drv = Bjack_drv_val(device); long ret; if (drv->num_input_channels > 0) { caml_enter_blocking_section(); ret = JACK_Read(drv,(unsigned char *)buf,n); caml_leave_blocking_section(); } else { caml_raise_constant(*caml_named_value("bio2jack_exn_too_many_input_channels")); } if (ret < 0) caml_failwith("jack_read"); ans = caml_alloc_string(ret); memcpy(String_val(ans),buf,ret); free(buf); CAMLreturn(ans); }
CAMLprim value caml_bjack_write(value device, value data) { CAMLparam2(device,data); int n = caml_string_length(data) ; jack_driver_t* drv = Bjack_drv_val(device); long ret; char* buf = malloc(n) ; memcpy(buf,String_val(data),n); if (drv->num_output_channels > 0) { caml_enter_blocking_section(); ret = JACK_Write(drv,(unsigned char *)buf,n); caml_leave_blocking_section(); } else { caml_raise_constant(*caml_named_value("bio2jack_exn_too_many_output_channels")); } if (ret < 0) caml_failwith("jack_write"); free(buf); CAMLreturn(Val_long(ret)); }
/* Fetchs the named OCaml-values + caches them and calculates + caches the variant hash values */ CAMLprim value pcre_ocaml_init(value __unused v_unit) { pcre_exc_Error = caml_named_value("Pcre.Error"); pcre_exc_Backtrack = caml_named_value("Pcre.Backtrack"); var_Start_only = caml_hash_variant("Start_only"); var_ANCHORED = caml_hash_variant("ANCHORED"); var_Char = caml_hash_variant("Char"); var_Not_studied = caml_hash_variant("Not_studied"); var_Studied = caml_hash_variant("Studied"); var_Optimal = caml_hash_variant("Optimal"); pcre_callout = &pcre_callout_handler; return 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); }
/* Do a minor collection and a slice of major collection, call finalisation functions, etc. Leave the minor heap empty. */ CAMLexport void caml_minor_collection (void) { value *note_gc; uint64_t start_time; note_gc = caml_named_value("MProf.Trace.note_gc"); if (note_gc) start_time = NOW(); intnat prev_alloc_words = caml_allocated_words; caml_empty_minor_heap (); caml_stat_promoted_words += caml_allocated_words - prev_alloc_words; ++ caml_stat_minor_collections; caml_major_collection_slice (0); caml_force_major_slice = 0; caml_final_do_calls (); if (note_gc){ double duration_ns = (double) (NOW () - start_time); value result = caml_callback_exn(*note_gc, caml_copy_double(duration_ns / 1000000000)); if (Is_exception_result(result)) printk("warning: note_gc threw an exception!\n"); } caml_empty_minor_heap (); }
CAMLprim value wrapper_bdd_allsat(value r) { CAMLparam1(r); BDD bdd = BDD_val(r); value* f = caml_named_value("__allsat_handler"); void handler(char* varset, int size) { CAMLlocal2(tl,v); int i = 0; tl = Val_emptylist; //printf("size : %d\n", size); for (i = 0 ; i < size; i++) { //printf("%d : %d\n", i, varset[i]); // variants in ocaml range from 0 to n-1 !!! switch (varset[i]) { case 0 : v = Val_int(0); break; // False case 1 : v = Val_int(1); break; // True case -1 : v = Val_int(2); break; // Unknown default : caml_failwith("Unknown variable value"); break; } if (varset[i] != -1) { tl = append(tuple(Val_int(i),v),tl); } } caml_callback(*f,tl); CAMLreturn0; }
int function_in_wrapper(void){ printf("Calling back into OCaml...\n"); CAMLlocal2(provided_to_wrapper_v, from_callback); provided_to_wrapper_v = *caml_named_value("provided_to_wrapper"); from_callback = caml_callback(provided_to_wrapper_v, Val_unit); return 0; }
void proc_start( const char* logdir, const uint32_t analysis_id, const char* sockname, bool debug_flag, const THREADID tid, char** argvp, int envc, char** envp ) { CAMLparam0(); CAMLlocalN( caml_args, 8 ); static value *proc_start_closure = NULL; if ( !proc_start_closure ) { proc_start_closure = caml_named_value( "proc_start" ); } caml_args[0] = caml_copy_string( logdir ); caml_args[1] = caml_copy_int32( analysis_id ); caml_args[2] = caml_copy_string( sockname ); caml_args[3] = Val_bool( debug_flag ); caml_args[4] = Val_int( tid ); caml_args[5] = caml_copy_nativeint( (long) argvp ); caml_args[6] = caml_copy_int32( envc ); caml_args[7] = caml_copy_nativeint( (long) envp ); caml_callbackN( *proc_start_closure, 8, caml_args ); CAMLreturn0; }
bool check_mems_taint( memorylog_entry* memlog, unsigned int cnt ) { CAMLparam0(); CAMLlocal4( addrs, ret, v, tupl ); static value *proc_check_mems_taint = NULL; if ( !proc_check_mems_taint ) { proc_check_mems_taint = caml_named_value( "check_mems_taint" ); } addrs = Val_emptylist; for ( unsigned int i = 0; i < cnt; i ++ ) { tupl = caml_alloc_tuple( 2 ); Store_field( tupl, 0, caml_copy_nativeint( memlog[i].addr ) ); Store_field( tupl, 1, Val_int( memlog[i].size * 8 ) ); v = caml_alloc_small( 2, 0 ); Field( v, 0 ) = tupl; Field( v, 1 ) = addrs; addrs = v; } ret = caml_callback( *proc_check_mems_taint, addrs ); CAMLreturnT( bool, Bool_val( ret ) ); }
static void raise_dbm(char *errmsg) { static value * dbm_exn = NULL; if (dbm_exn == NULL) dbm_exn = caml_named_value("dbmerror"); raise_with_string(*dbm_exn, errmsg); }
CAMLexport int triunsuitable(vertex triorg, vertex tridest, vertex triapex, REAL area) { CAMLparam0(); CAMLlocal1(vd); static value * closure = NULL; value args[NARGS_TRIUNSUITABLE]; if (closure == NULL) { closure = caml_named_value("triunsuitable_callback"); } #define COPY_DOUBLE(dest, d) \ vd = caml_copy_double(d); \ dest = vd COPY_DOUBLE(args[0], triorg[0]); COPY_DOUBLE(args[1], triorg[1]); COPY_DOUBLE(args[2], tridest[0]); COPY_DOUBLE(args[3], tridest[1]); COPY_DOUBLE(args[4], triapex[0]); COPY_DOUBLE(args[5], triapex[1]); COPY_DOUBLE(args[6], area); CAMLreturn(Bool_val(callbackN(*closure, NARGS_TRIUNSUITABLE, args))); #undef COPY_DOUBLE }
CAMLprim void p_print_int_test(value b, value num) { CAMLparam2(b, num); intnat x = Long_val(num); static value *buffer_add_char = NULL; if(buffer_add_char == NULL) { buffer_add_char = caml_named_value("Buffer__add_char"); if(buffer_add_char == NULL) { caml_failwith("Could not find Buffer.add_char"); } } if(x < 0) { caml_callback2(*buffer_add_char, b, Val_int((int)'-')); // TODO: min_int if(x == (1 << (8 * SIZEOF_PTR - 2))) { intnat div_me = x / 10; intnat mod_me = x % 10; p_do_enough(b, (uintnat)(-div_me), buffer_add_char); p_do_enough(b, (uintnat)(-mod_me), buffer_add_char); } else { p_do_enough(b, (uintnat)(-x), buffer_add_char); } } else { p_do_enough(b, (uintnat)x, buffer_add_char); } CAMLreturn0; }
CAMLprim value ocaml_ladspa_open(value fname) { void *handle = dlopen(String_val(fname), RTLD_LAZY); LADSPA_Descriptor_Function ladspa_descriptor; if (!handle) caml_raise_constant(*caml_named_value("ocaml_ladspa_exn_not_a_plugin")); ladspa_descriptor = (LADSPA_Descriptor_Function)dlsym((void*)handle, "ladspa_descriptor"); if (dlerror() != NULL || !ladspa_descriptor) { dlclose(handle); caml_raise_constant(*caml_named_value("ocaml_ladspa_exn_not_a_plugin")); } return (value)handle; }
void null_pointer_exn() { static value* e = NULL; if(e == NULL) { e = caml_named_value("Null_pointer_exn"); } caml_raise_constant(*e); }
/* llmodule -> ExecutionEngine.t */ CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleRef M) { LLVMExecutionEngineRef Interp; char *Error; if (LLVMCreateExecutionEngineForModule(&Interp, M, &Error)) llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); return Interp; }
void caml_fatal_uncaught_exception(value exn) { char * msg; value * at_exit; int saved_backtrace_active, saved_backtrace_pos; /* Build a string representation of the exception */ msg = caml_format_exception(exn); /* Perform "at_exit" processing, ignoring all exceptions that may be triggered by this */ saved_backtrace_active = caml_backtrace_active; saved_backtrace_pos = caml_backtrace_pos; caml_backtrace_active = 0; at_exit = caml_named_value("Pervasives.do_at_exit"); if (at_exit != NULL) caml_callback_exn(*at_exit, Val_unit); caml_backtrace_active = saved_backtrace_active; caml_backtrace_pos = saved_backtrace_pos; /* Display the uncaught exception */ fprintf(stderr, "Fatal error: exception %s\n", msg); free(msg); /* Display the backtrace if available */ if (caml_backtrace_active #ifndef NATIVE_CODE && !caml_debugger_in_use #endif ) { caml_print_exception_backtrace(); } /* Terminate the process */ exit(2); }