CAMLprim value ocaml_faad_mp4_metadata(value m) { CAMLparam1(m); CAMLlocal2(ans,v); mp4_t *mp = Mp4_val(m); int i, n; char *tag, *item; caml_enter_blocking_section(); n = mp4ff_meta_get_num_items(mp->ff); caml_leave_blocking_section(); ans = caml_alloc_tuple(n); for (i = 0; i < n; i++) { tag = NULL; item = NULL; caml_enter_blocking_section(); mp4ff_meta_get_by_index(mp->ff, i, &item, &tag); caml_leave_blocking_section(); assert(item && tag); v = caml_alloc_tuple(2); Store_field(v, 0, caml_copy_string(item)); Store_field(v, 1, caml_copy_string(tag)); Store_field(ans, i, v); free(item); free(tag); } CAMLreturn(ans); }
static inline int exec_not_null_callback( void *cbx_, int num_columns, char **row, char **header) { callback_with_exn *cbx = cbx_; value v_row, v_header, v_ret; caml_leave_blocking_section(); v_row = copy_not_null_string_array((const char **) row, num_columns); if (v_row == (value) NULL) return 1; Begin_roots1(v_row); v_header = safe_copy_string_array((const char **) header, num_columns); End_roots(); v_ret = caml_callback2_exn(*cbx->cbp, v_row, v_header); if (Is_exception_result(v_ret)) { *cbx->exn = Extract_exception(v_ret); caml_enter_blocking_section(); return 1; } caml_enter_blocking_section(); return 0; }
/* Contrary to caml_md5_chan, this function releases the runtime lock. [fd] must be a file descriptor open for reading and not be nonblocking, otherwise the function might fail non-deterministically. */ CAMLprim value caml_md5_fd(value fd) { CAMLparam1 (fd); value res; struct MD5Context ctx; caml_enter_blocking_section(); { intnat bytes_read; char buffer[4096]; caml_MD5Init(&ctx); while (1){ bytes_read = read (Int_val(fd), buffer, sizeof(buffer)); if (bytes_read < 0) { if (errno == EINTR) continue; caml_leave_blocking_section(); uerror("caml_md5_fd", Nothing); } if (bytes_read == 0) break; caml_MD5Update (&ctx, (unsigned char *) buffer, bytes_read); } } caml_leave_blocking_section(); res = caml_alloc_string(16); caml_MD5Final(&Byte_u(res, 0), &ctx); CAMLreturn (res); }
value ffmpeg_close(value ctx) { CAMLparam1(ctx); if (Context_val(ctx)->fmtCtx) { AVFormatContext* fmtCtx = Context_val(ctx)->fmtCtx; caml_enter_blocking_section(); if (fmtCtx->pb) { av_write_trailer(fmtCtx); } //avcodec_close(Context_val(ctx)->avstream->codec); ?? avformat_free_context(fmtCtx); if (!(fmtCtx->flags & AVFMT_NOFILE)) { int ret = avio_close(fmtCtx->pb); raise_and_leave_blocking_section_if_not(ret >= 0, ExnFileIO, ret); } caml_leave_blocking_section(); Context_val(ctx)->fmtCtx = NULL; free(Context_val(ctx)->filename); Context_val(ctx)->filename = NULL; } CAMLreturn(Val_unit); }
CAMLprim value NAME(value vCMP, value vN, value vOFSX, value vINCX, value vX) { CAMLparam2(vCMP, vX); #if defined(OCAML_SORT_CALLBACK) CAMLlocal2(va, vb); #endif const size_t GET_INT(N); int GET_INT(INCX); VEC_PARAMS(X); NUMBER *const base_ptr = X_data; const size_t max_thresh = MAX_THRESH * sizeof(NUMBER) * INCX; if (N == 0) CAMLreturn(Val_unit); #ifndef OCAML_SORT_CALLBACK caml_enter_blocking_section(); /* Allow other threads */ #endif #define QUICKSORT_LT(a, b) OCAML_SORT_LT((*a), (*b)) QUICKSORT(NUMBER, base_ptr, INCX, max_thresh); #undef QUICKSORT_LT #ifndef OCAML_SORT_CALLBACK caml_leave_blocking_section(); /* Disallow other threads */ #endif CAMLreturn(Val_unit); }
value mlptrace_peek (value pid_v, value adr_v) { pid_t pid; long adr; long r; int savederrno = errno; CAMLparam2 (pid_v, adr_v); CAMLlocal1 (res_v); pid = Long_val (pid_v); adr = Nativeint_val (adr_v); #ifndef NO_BLOCKING_SECTION caml_enter_blocking_section (); #endif r = ptrace (PTRACE_PEEKDATA, pid, adr, 0); #ifndef NO_BLOCKING_SECTION caml_leave_blocking_section (); #endif if (r == -1 && errno) uerror ("Ptrace.peek", Nothing); if (savederrno) errno = savederrno; res_v = caml_copy_nativeint (r); CAMLreturn (res_v); }
CAMLprim value bin_prot_blit_buf_stub( value v_src_pos, value v_src, value v_dst_pos, value v_dst, value v_len) { struct caml_ba_array *ba_src = Caml_ba_array_val(v_src); struct caml_ba_array *ba_dst = Caml_ba_array_val(v_dst); char *src = (char *) ba_src->data + Long_val(v_src_pos); char *dst = (char *) ba_dst->data + Long_val(v_dst_pos); size_t len = (size_t) Long_val(v_len); if ( unlikely(len > 65536) || unlikely(((ba_src->flags & CAML_BA_MAPPED_FILE) != 0)) || unlikely(((ba_dst->flags & CAML_BA_MAPPED_FILE) != 0)) ) /* use [memmove] rather than [memcpy] because src and dst may overlap */ { Begin_roots2(v_src, v_dst); caml_enter_blocking_section(); memmove(dst, src, len); caml_leave_blocking_section(); End_roots(); } else memmove(dst, src, len); return Val_unit; }
CAMLprim value caml_sqlite3_exec(value v_db, value v_maybe_cb, value v_sql) { CAMLparam1(v_db); CAMLlocal2(v_cb, v_exn); callback_with_exn cbx; db_wrap *dbw = Sqlite3_val(v_db); int len = caml_string_length(v_sql) + 1; char *sql; int rc; sqlite3_callback cb = NULL; check_db(dbw, "exec"); sql = caml_stat_alloc(len); memcpy(sql, String_val(v_sql), len); cbx.cbp = &v_cb; cbx.exn = &v_exn; if (v_maybe_cb != Val_None) { v_cb = Field(v_maybe_cb, 0); cb = exec_callback; } caml_enter_blocking_section(); rc = sqlite3_exec(dbw->db, sql, cb, (void *) &cbx, NULL); free(sql); caml_leave_blocking_section(); if (rc == SQLITE_ABORT) caml_raise(*cbx.exn); CAMLreturn(Val_rc(rc)); }
CAMLprim value caml_sqlite3_exec_not_null_no_headers( value v_db, value v_cb, value v_sql) { CAMLparam2(v_db, v_cb); CAMLlocal1(v_exn); callback_with_exn cbx; db_wrap *dbw = Sqlite3_val(v_db); int len = caml_string_length(v_sql) + 1; char *sql; int rc; check_db(dbw, "exec_not_null_no_headers"); sql = caml_stat_alloc(len); memcpy(sql, String_val(v_sql), len); cbx.cbp = &v_cb; cbx.exn = &v_exn; caml_enter_blocking_section(); rc = sqlite3_exec( dbw->db, sql, exec_not_null_no_headers_callback, (void *) &cbx, NULL); free(sql); caml_leave_blocking_section(); if (rc == SQLITE_ABORT) { if (*cbx.exn != 0) caml_raise(*cbx.exn); else raise_sqlite3_Error("Null element in row"); } CAMLreturn(Val_rc(rc)); }
static int do_write(int fd, char *p, int n) { int retcode; again: caml_enter_blocking_section(); // Changed!!! if ((fd == 1/*stdout*/ || fd == 2/*stderr*/) && custom_ocaml_stdout_func) { (*custom_ocaml_stdout_func)(fd, p, n); retcode = n; } else retcode = write(fd, p, n); caml_leave_blocking_section(); if (retcode == -1) { if (errno == EINTR) goto again; if ((errno == EAGAIN || errno == EWOULDBLOCK) && n > 1) { /* We couldn't do a partial write here, probably because n <= PIPE_BUF and POSIX says that writes of less than PIPE_BUF characters must be atomic. We first try again with a partial write of 1 character. If that fails too, we'll raise Sys_blocked_io below. */ n = 1; goto again; } } if (retcode == -1) caml_sys_io_error(NO_ARG); return retcode; }
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 ocaml_faad_mp4_find_aac_track(value m) { CAMLparam1(m); mp4_t *mp = Mp4_val(m); int i, rc; int num_tracks; caml_enter_blocking_section(); num_tracks = mp4ff_total_tracks(mp->ff); for (i = 0; i < num_tracks; i++) { unsigned char *buff = NULL; unsigned int buff_size = 0; mp4AudioSpecificConfig mp4ASC; mp4ff_get_decoder_config(mp->ff, i, &buff, &buff_size); if (buff) { rc = NeAACDecAudioSpecificConfig(buff, buff_size, &mp4ASC); free(buff); if (rc < 0) continue; caml_leave_blocking_section(); CAMLreturn(Val_int(i)); } } caml_leave_blocking_section(); caml_raise_constant(*caml_named_value("ocaml_faad_exn_failed")); }
CAMLprim value ocaml_faad_mp4_init(value m, value dh, value track) { CAMLparam3(m, dh, track); CAMLlocal1(ans); mp4_t *mp = Mp4_val(m); int t = Int_val(track); int ret; long unsigned int samplerate; unsigned char channels; NeAACDecHandle dec = Dec_val(dh); unsigned char *mp4_buffer = NULL; unsigned int mp4_buffer_size = 0; caml_enter_blocking_section(); mp4ff_get_decoder_config(mp->ff, t, &mp4_buffer, &mp4_buffer_size); ret = NeAACDecInit2(dec, mp4_buffer, mp4_buffer_size, &samplerate, &channels); caml_leave_blocking_section(); free(mp4_buffer); check_err(ret); ans = caml_alloc_tuple(2); Store_field(ans, 0, Val_int(samplerate)); Store_field(ans, 1, Val_int(channels)); CAMLreturn(ans); }
CAMLprim value ocaml_faad_mp4_open_read_fd(value metaonly, value fd) { CAMLparam2(metaonly, fd); CAMLlocal1(ans); mp4_t *mp = malloc(sizeof(mp4_t)); mp->fd = GET_FD(fd); mp->ff_cb.read = read_cb; mp->read_cb = 0; mp->ff_cb.write = write_cb; mp->write_cb = 0; mp->ff_cb.seek = seek_cb; mp->seek_cb = 0; mp->ff_cb.truncate = trunc_cb; mp->trunc_cb = 0; mp->ff_cb.user_data = mp; caml_enter_blocking_section(); if(Bool_val(metaonly)) mp->ff = mp4ff_open_read_metaonly(&mp->ff_cb); else mp->ff = mp4ff_open_read(&mp->ff_cb); caml_leave_blocking_section(); assert(mp->ff); ans = caml_alloc_custom(&mp4_ops, sizeof(mp4_t*), 1, 0); Mp4_val(ans) = mp; CAMLreturn(ans); }
CAMLprim value statvfs_stub (value v_path) { CAMLparam1(v_path); CAMLlocal1(v_stat); struct statvfs s; int ret, len = caml_string_length(v_path) + 1; char *pathname = caml_stat_alloc(len); memcpy(pathname, String_val(v_path), len); caml_enter_blocking_section(); ret = statvfs(pathname,&s); caml_leave_blocking_section(); caml_stat_free(pathname); if (ret != 0) uerror("statvfs",v_path); v_stat = caml_alloc(11, 0); Store_field(v_stat, 0, Val_int(s.f_bsize)); Store_field(v_stat, 1, Val_int(s.f_frsize)); Store_field(v_stat, 2, Val_int(s.f_blocks)); Store_field(v_stat, 3, Val_int(s.f_bfree)); Store_field(v_stat, 4, Val_int(s.f_bavail)); Store_field(v_stat, 5, Val_int(s.f_files)); Store_field(v_stat, 6, Val_int(s.f_ffree)); Store_field(v_stat, 7, Val_int(s.f_favail)); Store_field(v_stat, 8, Val_int(s.f_fsid)); Store_field(v_stat, 9, Val_int(s.f_flag)); Store_field(v_stat,10, Val_int(s.f_namemax)); CAMLreturn(v_stat); }
CAMLprim value LFUN(linspace_stub)(value vY, value va, value vb, value vN) { CAMLparam1(vY); integer i, GET_INT(N); REAL ar = Double_field(va, 0), ai = Double_field(va, 1), N1 = N - 1., hr = (Double_field(vb, 0) - ar) / N1, hi = (Double_field(vb, 1) - ai) / N1, xr = ar, xi = ai; VEC_PARAMS1(Y); caml_enter_blocking_section(); /* Allow other threads */ for (i = 1; i <= N; i++) { Y_data->r = xr; Y_data->i = xi; Y_data++; xr = ar + i * hr; xi = ai + i * hi; } caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); }
CAMLprim value LFUN(sqr_nrm2_stub)( value vSTABLE, value vN, value vOFSX, value vINCX, value vX) { CAMLparam1(vX); integer GET_INT(N), GET_INT(INCX); REAL res; VEC_PARAMS(X); caml_enter_blocking_section(); /* Allow other threads */ if (Bool_val(vSTABLE)) { #ifndef LACAML_DOUBLE res = scnrm2_(&N, X_data, &INCX); #else res = dznrm2_(&N, X_data, &INCX); #endif res *= res; } else { COMPLEX cres = FUN(dotc)(&N, X_data, &INCX, X_data, &INCX); res = cres.r; } caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(caml_copy_double(res)); }
value ffmpeg_stream_close(value stream) { CAMLparam1(stream); if (Stream_context_direct_val(stream) != Val_int(0)) { if (Stream_context_val(stream)->fmtCtx && Stream_aux_val(stream)->avstream->codec->flags & AV_CODEC_CAP_DELAY) { int gotIt; AVPacket packet = { 0 }; caml_enter_blocking_section(); do { int ret = avcodec_encode_video2(Stream_aux_val(stream)->avstream->codec, &packet, NULL, &gotIt); raise_and_leave_blocking_section_if_not(ret >= 0, ExnEncode, ret); if (gotIt) { packet.stream_index = 0; ret = av_interleaved_write_frame(Stream_context_val(stream)->fmtCtx, &packet); raise_and_leave_blocking_section_if_not(ret >= 0, ExnFileIO, ret); } } while (gotIt); caml_leave_blocking_section(); } avcodec_close(Stream_aux_val(stream)->avstream->codec); if (Stream_aux_val(stream)->swsCtx) { sws_freeContext(Stream_aux_val(stream)->swsCtx); } Stream_context_direct_val(stream) = Val_int(0); } else { raise(ExnClosed, 0); } CAMLreturn(Val_unit); }
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)); }
value caml_create_QQmlPropertyMap(value _func, value _unit) { CAMLparam2(_func, _unit); CAMLlocal1(_ans); value *fv = (value*) malloc(sizeof(_func)); *fv = _func; caml_register_global_root(fv); CamlPropertyMap *propMap = new CamlPropertyMap(); _ans = caml_alloc_custom(&camlpropertymap_ops, sizeof(CamlPropertyMap*), 0, 1); (*((CamlPropertyMap **) Data_custom_val(_ans))) = propMap; propMap->saveCallback(fv); QObject::connect(propMap, &CamlPropertyMap::valueChanged, [fv](const QString& propName, const QVariant& var) { caml_leave_blocking_section(); [&fv, &propName, &var]() { CAMLparam0(); CAMLlocal2(_nameArg, _variantArg); _nameArg = caml_copy_string( propName.toLocal8Bit().data() ); caml_callback2(*fv, _nameArg, Val_QVariant(_variantArg, var) ); CAMLreturn0; }(); caml_enter_blocking_section(); } ); CAMLreturn(_ans); }
void QSingleFunc::run() { // call callback there caml_leave_blocking_section(); caml_callback(_saved_callback, Val_unit); caml_enter_blocking_section(); }
CAMLprim value caml_sys_close(value fd) { caml_enter_blocking_section(); close(Int_val(fd)); caml_leave_blocking_section(); return Val_unit; }
CAMLprim value caml_sys_is_directory(value name) { CAMLparam1(name); #ifdef _WIN32 struct _stati64 st; #else struct stat st; #endif char * p; int ret; p = caml_strdup(String_val(name)); caml_enter_blocking_section(); #ifdef _WIN32 ret = _stati64(p, &st); #else ret = stat(p, &st); #endif caml_leave_blocking_section(); caml_stat_free(p); if (ret == -1) caml_sys_error(name); #ifdef S_ISDIR CAMLreturn(Val_bool(S_ISDIR(st.st_mode))); #else CAMLreturn(Val_bool(st.st_mode & S_IFDIR)); #endif }
CAMLprim value caml_natdynlink_run_toplevel(value filename, value symbol) { CAMLparam2 (filename, symbol); CAMLlocal3 (res, v, handle_v); void *handle; char *p; /* TODO: dlclose in case of error... */ p = caml_strdup(String_val(filename)); caml_enter_blocking_section(); handle = caml_dlopen(p, 1, 1); caml_leave_blocking_section(); caml_stat_free(p); if (NULL == handle) { res = caml_alloc(1,1); v = caml_copy_string(caml_dlerror()); Store_field(res, 0, v); } else { handle_v = Val_handle(handle); res = caml_alloc(1,0); v = caml_natdynlink_run(handle_v, symbol); Store_field(res, 0, v); } CAMLreturn(res); }
value mlptrace_cont (value pid_v, value signum_v) { pid_t pid; int signum; int savederrno = errno; long l = 0; CAMLparam2 (pid_v, signum_v); pid = Long_val (pid_v); signum = Long_val (signum_v); if (signum < 0) signum = 0; errno = 0; #ifndef NO_BLOCKING_SECTION caml_enter_blocking_section (); #endif l = ptrace (PTRACE_CONT, pid, (void *) 0, (void *) 0); #ifndef NO_BLOCKING_SECTION caml_leave_blocking_section (); #endif if (l == -1 && errno) uerror ("Ptrace.cont", Nothing); if (savederrno) errno = savederrno; CAMLreturn (Val_unit); }
CAMLprim value caml_natdynlink_open(value filename, value global) { CAMLparam2 (filename, global); CAMLlocal3 (res, handle, header); void *sym; void *dlhandle; char *p; /* TODO: dlclose in case of error... */ p = caml_strdup(String_val(filename)); caml_enter_blocking_section(); dlhandle = caml_dlopen(String_val(filename), 1, Int_val(global)); caml_leave_blocking_section(); caml_stat_free(p); if (NULL == dlhandle) caml_failwith(caml_dlerror()); sym = caml_dlsym(dlhandle, "caml_plugin_header"); if (NULL == sym) caml_failwith("not an OCaml plugin"); handle = Val_handle(dlhandle); header = caml_input_value_from_malloc(sym, 0); res = caml_alloc_tuple(2); Init_field(res, 0, handle); Init_field(res, 1, header); CAMLreturn(res); }
CAMLprim value caml_ml_close_channel(value vchannel) { int result; int do_syscall; int fd; /* For output channels, must have flushed before */ struct channel * channel = Channel(vchannel); if (channel->fd != -1){ fd = channel->fd; channel->fd = -1; do_syscall = 1; }else{ do_syscall = 0; result = 0; } /* Ensure that every read or write on the channel will cause an immediate caml_flush_partial or caml_refill, thus raising a Sys_error exception */ channel->curr = channel->max = channel->end; if (do_syscall) { caml_enter_blocking_section(); result = close(fd); caml_leave_blocking_section(); } if (result == -1) caml_sys_error (NO_ARG); return Val_unit; }
void ml_xt_callback( Widget w, XtPointer cb_index, XtPointer cb_data ) { caml_leave_blocking_section(); caml_callback2( caml_xt_cb, (value) cb_index, (value) cb_data ); //caml_callback( caml_xt_cb, (value) cb_index ); caml_enter_blocking_section(); }
CAMLprim value stub_xc_hvm_build_native(value xc_handle, value domid, value mem_max_mib, value mem_start_mib, value image_name, value store_evtchn, value console_evtchn) { CAMLparam5(xc_handle, domid, mem_max_mib, mem_start_mib, image_name); CAMLxparam2(store_evtchn, console_evtchn); CAMLlocal1(result); char *image_name_c = strdup(String_val(image_name)); char *error[256]; xc_interface *xch; unsigned long store_mfn=0; unsigned long console_mfn=0; int r; struct flags f; /* The xenguest interface changed and was backported to XCP: */ #if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200) struct xc_hvm_build_args args; #endif get_flags(&f, _D(domid)); xch = _H(xc_handle); configure_vcpus(xch, _D(domid), f); configure_tsc(xch, _D(domid), f); #if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200) args.mem_size = (uint64_t)Int_val(mem_max_mib) << 20; args.mem_target = (uint64_t)Int_val(mem_start_mib) << 20; args.mmio_size = f.mmio_size_mib << 20; args.image_file_name = image_name_c; #endif caml_enter_blocking_section (); #if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200) r = xc_hvm_build(xch, _D(domid), &args); #else r = xc_hvm_build_target_mem(xch, _D(domid), Int_val(mem_max_mib), Int_val(mem_start_mib), image_name_c); #endif caml_leave_blocking_section (); free(image_name_c); if (r) failwith_oss_xc(xch, "hvm_build"); r = hvm_build_set_params(xch, _D(domid), Int_val(store_evtchn), &store_mfn, Int_val(console_evtchn), &console_mfn, f); if (r) failwith_oss_xc(xch, "hvm_build_params"); result = caml_alloc_tuple(2); Store_field(result, 0, caml_copy_nativeint(store_mfn)); Store_field(result, 1, caml_copy_nativeint(console_mfn)); CAMLreturn(result); }
value ffmpeg_open_input(value filename_) { CAMLparam1(filename_); CAMLlocal1(ctx); av_register_all(); // this is fast to redo ctx = caml_alloc_custom(&context_ops, sizeof(struct Context), 0, 1); Context_val(ctx)->filename = strdup((char*) filename_); int ret; AVFormatContext* fmtCtx; char* filename = Context_val(ctx)->filename; caml_enter_blocking_section(); ret = avformat_open_input(&fmtCtx, filename, NULL, NULL); raise_and_leave_blocking_section_if_not(ret >= 0, ExnOpen, ret); ret = avformat_find_stream_info(fmtCtx, NULL); raise_and_leave_blocking_section_if_not(ret >= 0, ExnStreamInfo, ret); caml_leave_blocking_section(); Context_val(ctx)->fmtCtx = fmtCtx; CAMLreturn(ctx); }