static value alloc_poll_mem(int n) {
struct pollfd *p;
value r;
p = caml_stat_alloc(n * sizeof(struct pollfd));
r = caml_alloc_custom(&poll_mem_ops, sizeof(p), n, 100000);
*(Poll_mem_val(r)) = p;
return r;
};
static value alloc_not_event(void) {
struct not_event *p;
value r;
p = caml_stat_alloc(sizeof(struct not_event));
r = caml_alloc_custom(¬_event_ops, sizeof(p), 0, 1);
*(Not_event_val(r)) = p;
return r;
};
static value alloc_poll_aggreg(void) {
struct poll_aggreg *p;
value r;
p = caml_stat_alloc(sizeof(struct poll_aggreg));
r = caml_alloc_custom(&poll_aggreg_ops, sizeof(p), 1, 0);
*(Poll_aggreg_val(r)) = p;
return r;
};
CAMLprim value ocaml_faad_mp4_open_read(value metaonly, value read, value write, value seek, value trunc)
{
CAMLparam4(read, write, seek, trunc);
CAMLlocal1(ans);
mp4_t *mp = malloc(sizeof(mp4_t));
mp->fd = -1;
mp->ff_cb.read = read_cb;
mp->read_cb = read;
caml_register_global_root(&mp->read_cb);
if (Is_block(write))
{
mp->ff_cb.write = write_cb;
mp->write_cb = Field(write, 0);
caml_register_global_root(&mp->write_cb);
}
else
{
mp->ff_cb.write = NULL;
mp->write_cb = 0;
}
if (Is_block(seek))
{
mp->ff_cb.seek = seek_cb;
mp->seek_cb = Field(seek, 0);
caml_register_global_root(&mp->seek_cb);
}
else
{
mp->ff_cb.seek = NULL;
mp->seek_cb = 0;
}
if (Is_block(trunc))
{
mp->ff_cb.truncate = trunc_cb;
mp->trunc_cb = Field(trunc, 0);
caml_register_global_root(&mp->trunc_cb);
}
else
{
mp->ff_cb.truncate = NULL;
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);
}
CAMLexport value caml_alloc_channel(struct channel *chan)
{
value res;
chan->refcount++; /* prevent finalization during next alloc */
res = caml_alloc_custom(&channel_operations, sizeof(struct channel *),
1, 1000);
Channel(res) = chan;
return res;
}
value cf_wrap(CFTypeRef cf_value) {
CAMLparam0();
if (cf_value != NULL)
CFRetain(cf_value);
CAMLlocal1(block);
block = caml_alloc_custom(&cf_custom_ops, sizeof(CFTypeRef), 0, 1);
*((CFTypeRef*)Data_custom_val(block)) = cf_value;
CAMLreturn(block);
}
static value value_of_appsrc(GstAppSrc *e)
{
value ans = caml_alloc_custom(&appsrc_ops, sizeof(appsrc*), 0, 1);
appsrc *as = malloc(sizeof(appsrc));
as->appsrc = e;
as->need_data_cb = 0;
as->need_data_hid = 0;
Appsrc_val(ans) = as;
return ans;
}
static value value_of_typefind_element(GstElement *e)
{
value ans = caml_alloc_custom(&typefind_element_ops, sizeof(typefind_element*), 0, 1);
typefind_element *tf = malloc(sizeof(typefind_element));
tf->tf = e;
tf->have_type_cb = 0;
tf->have_type_hid = 0;
Typefind_element_data_val(ans) = tf;
return ans;
}
static value value_of_appsink(GstAppSink *e)
{
value ans = caml_alloc_custom(&appsink_ops, sizeof(appsink*), 0, 1);
appsink *as = malloc(sizeof(appsink));
as->appsink = e;
as->new_sample_cb = 0;
as->new_sample_hid = 0;
Appsink_val(ans) = as;
return ans;
}
/**
* Create an OCaml value containing a new z_stream pointer.
*
* This function may raise the following OCaml exception:
* - Out_of_memory exception
*
* @return {value} An OCaml value containing a new z_stream pointer.
*/
value zlib_new_stream() {
value z_streamp_val = caml_alloc_custom(&zlib_stream_ops, sizeof(z_streamp), 0, 1);
ZStreamP_val(z_streamp_val) = caml_stat_alloc(sizeof(z_stream));
ZStreamP_val(z_streamp_val)->zalloc = NULL;
ZStreamP_val(z_streamp_val)->zfree = NULL;
ZStreamP_val(z_streamp_val)->opaque = NULL;
ZStreamP_val(z_streamp_val)->next_in = NULL;
ZStreamP_val(z_streamp_val)->next_out = NULL;
return z_streamp_val;
}
static value value_of_bus(GstBus *b)
{
if (!b) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
value ans = caml_alloc_custom(&bus_ops, sizeof(bus_t*), 0, 1);
bus_t *bus = malloc(sizeof(bus));
bus->bus = b;
bus->element = 0;
caml_register_global_root(&bus->element);
Bus_data_val(ans) = bus;
return ans;
}
value
ffmpeg_stream_new_video(value ctx, value video_info_)
{
CAMLparam2(ctx, video_info_);
CAMLlocal1(stream);
stream = caml_alloc_tuple(StreamSize);
AVCodec* codec = avcodec_find_encoder(AV_CODEC_ID_H264);
int ret;
Stream_aux_direct_val(stream) = caml_alloc_custom(&streamaux_ops, sizeof(struct StreamAux), 0, 1);
Stream_aux_val(stream)->type = Val_int(STREAM_VIDEO);
Stream_context_direct_val(stream) = ctx;
Stream_aux_val(stream)->avstream = avformat_new_stream(Context_val(ctx)->fmtCtx, codec);
Stream_aux_val(stream)->avstream->codec->codec_id = AV_CODEC_ID_H264;
/* Stream_aux_val(stream)->avstream->codec->rc_min_rate = 50000; */
/* Stream_aux_val(stream)->avstream->codec->rc_max_rate = 200000; */
/* Stream_aux_val(stream)->avstream->codec->bit_rate = 10000; */
Stream_aux_val(stream)->avstream->codec->width = Int_val(Field(video_info_, 0));
Stream_aux_val(stream)->avstream->codec->height = Int_val(Field(video_info_, 1));
Stream_aux_val(stream)->avstream->codec->pix_fmt = AV_PIX_FMT_YUV420P;
//Stream_aux_val(stream)->avstream->codec->gop_size = 30;
if (Context_val(ctx)->fmtCtx->oformat->flags & AVFMT_GLOBALHEADER) {
Stream_aux_val(stream)->avstream->codec->flags |= AV_CODEC_FLAG_GLOBAL_HEADER;
}
Stream_aux_val(stream)->avstream->time_base = (AVRational) {1, 10000};
AVDictionary* codecOpts = NULL;
/* av_dict_set(&codecOpts, "profile", "baseline", 0); */
/* av_dict_set(&codecOpts, "crf", "3", 0); */
/* av_dict_set(&codecOpts, "vbr", "1", 0); */
//av_dict_set(&codecOpts, "x264-params", "bitrate=2", 0);
//av_dict_set(&codecOpts, "x264-params", "crf=40:keyint=60:vbv_bufsize=40000:vbv_maxrate=150000", 0);
av_dict_set(&codecOpts, "x264-params", "crf=36:keyint=60", 0);
AVCodecContext* codecCtx = Stream_aux_val(stream)->avstream->codec;
caml_enter_blocking_section();
ret = avcodec_open2( codecCtx, codec, &codecOpts);
raise_and_leave_blocking_section_if_not(ret >= 0, ExnOpen, ret);
caml_leave_blocking_section();
assert(Stream_aux_val(stream)->avstream->codec->pix_fmt == AV_PIX_FMT_YUV420P);
Stream_aux_val(stream)->swsCtx =
sws_getContext(Stream_aux_val(stream)->avstream->codec->width, Stream_aux_val(stream)->avstream->codec->height, USER_PIXFORMAT,
Stream_aux_val(stream)->avstream->codec->width, Stream_aux_val(stream)->avstream->codec->height, Stream_aux_val(stream)->avstream->codec->pix_fmt,
0, NULL, NULL, NULL);
CAMLreturn((value) stream);
}
CAMLprim value brlapiml_openConnectionWithHandle(value settings)
{
CAMLparam1(settings);
CAMLlocal1(handle);
brlapi_connectionSettings_t brlapiSettings;
brlapiSettings.auth = String_val(Field(settings, 0));
brlapiSettings.host = String_val(Field(settings, 1));
handle = caml_alloc_custom(&customOperations, brlapi_getHandleSize(), 0, 1);
if (brlapi__openConnection(Data_custom_val(handle), &brlapiSettings, &brlapiSettings)<0) raise_brlapi_error();
CAMLreturn(handle);
}
/* allocate : int -> managed_buffer */
value ctypes_allocate(value size_)
{
CAMLparam1(size_);
int size = Int_val(size_);
CAMLlocal1(block);
block = caml_alloc_custom(&managed_buffer_custom_ops, sizeof(void*), 0, 1);
void *p = caml_stat_alloc(size);
void **d = (void **)Data_custom_val(block);
*d = p;
CAMLreturn(block);
}
static value
camluv_copy_check(camluv_check_t *camluv_check)
{
CAMLparam0();
CAMLlocal1(check);
check = caml_alloc_custom(&camluv_check_struct_ops,
sizeof(camluv_check_t *), 0, 1);
camluv_check_struct_val(check) = camluv_check;
CAMLreturn(check);
}
static value
camluv_copy_handle(camluv_handle_t *camluv_handle)
{
CAMLparam0();
CAMLlocal1(handle);
handle = caml_alloc_custom(&camluv_handle_struct_ops,
sizeof(camluv_handle_t *), 0, 1);
camluv_handle_struct_val(handle) = camluv_handle;
CAMLreturn(handle);
}
static value
Val_guestfs (guestfs_h *g)
{
CAMLparam0 ();
CAMLlocal1 (rv);
rv = caml_alloc_custom (&guestfs_custom_operations,
sizeof (guestfs_h *), 0, 1);
Guestfs_val (rv) = g;
CAMLreturn (rv);
}
static value
camluv_copy_key(camluv_key_t *camluv_key)
{
CAMLparam0();
CAMLlocal1(key);
key = caml_alloc_custom(&camluv_key_struct_ops,
sizeof(camluv_key_t *), 0, 1);
camluv_key_struct_val(key) = camluv_key;
CAMLreturn(key);
}
value
sankoff_CAML_filter_character(value this_eltarr, value ecode_bigarr, value get_comp) {
CAMLparam3(this_eltarr,ecode_bigarr,get_comp);
CAMLlocal1(res);
int get_complementary = Int_val(get_comp);
int * ecode_arr = (int*) Data_bigarray_val(ecode_bigarr);
eltarr_p eap;
Sankoff_eltarr_custom_val(eap,this_eltarr);
int num_elts=eap->num_elts;
int res_num_elts=0;//must init to 0
int i;
elt_p ep;
int * sign_arr = (int*)calloc(num_elts,sizeof(int));
for (i=0;i<num_elts;i++) {
ep = &((eap->elts)[i]);
if(get_complementary) {
if( int_array_is_mem(ecode_arr,num_elts,ep->ecode) )
{ sign_arr[i]=0; }
else { sign_arr[i]=1; res_num_elts++; }
}
else {
if( int_array_is_mem(ecode_arr,num_elts,ep->ecode) )
{ sign_arr[i]=1; res_num_elts++; }
else sign_arr[i]=0;
}
}
eltarr_p res_eap;
res_eap = (eltarr_p)calloc(1,sizeof(struct elt_arr));
int num_states = eap->num_states;
res_eap->code = eap->code;
res_eap->num_states = eap->num_states;
res_eap->num_elts = res_num_elts;
res_eap->tcm = (int*)calloc(num_states*num_states,sizeof(int));
res_eap->is_identity = eap->is_identity;
memcpy (res_eap->tcm,eap->tcm,sizeof(int)*num_states*num_states);
res_eap->elts = (elt_p)calloc(res_num_elts,sizeof(struct elt));
elt_p res_elts = res_eap->elts;
int j=0;
for (i=0;i<num_elts;i++) {
if(sign_arr[i]==1) {
sankoff_create_empty_elt(&(res_elts[j]),num_states,-1);
sankoff_clone_elt(&(res_elts[j]),&((eap->elts)[i]));
j++;
}
}
free(sign_arr);
assert(j==res_num_elts);
res = caml_alloc_custom(&sankoff_custom_operations_eltarr,sizeof(eltarr_p),1,alloc_custom_max);
Sankoff_return_eltarr(res) = res_eap;
CAMLreturn(res);
}
// INPUT nothing
// OUTPUT a fresh texture id
CAMLprim value
caml_create_texture(value unit)
{
CAMLparam0();
CAMLlocal1(v);
GLuint buf[1];
glGenTextures(1, buf);
v = caml_alloc_custom( &tex_custom_ops, sizeof(GLuint), 0, 1);
memcpy( Data_custom_val(v), buf, sizeof(GLuint) );
CAMLreturn(v);
}
/* Captures a reference to the context to avoid collecting it prematurely */
value caml_zmq_copy_socket(value context, void *zmq_socket) {
CAMLparam0 ();
CAMLlocal2 (socket, tuple);
socket = caml_alloc_custom(&caml_zmq_socket_ops, sizeof (zmq_socket), 0, 1);
CAML_ZMQ_Socket_inner_val(socket) = zmq_socket;
tuple = caml_alloc_tuple(2);
Field(tuple, 0) = context;
Field(tuple, 1) = socket;
CAMLreturn (tuple);
}
CAMLexport value caml_copy_int64(int64 i)
{
value res = caml_alloc_custom(&caml_int64_ops, 8, 0, 1);
#ifndef ARCH_ALIGN_INT64
Int64_val(res) = i;
#else
union { int32 i[2]; int64 j; } buffer;
buffer.j = i;
((int32 *) Data_custom_val(res))[0] = buffer.i[0];
((int32 *) Data_custom_val(res))[1] = buffer.i[1];
#endif
return res;
}
value
ffmpeg_stream_new_audio(value ctx, value audio_info_)
{
CAMLparam2(ctx, audio_info_);
CAMLlocal1(stream);
AVCodec* codec = avcodec_find_encoder(AV_CODEC_ID_AAC);
stream = caml_alloc_tuple(StreamSize);
int ret;
Stream_aux_direct_val(stream) = caml_alloc_custom(&streamaux_ops, sizeof(struct StreamAux), 0, 1);
Stream_aux_val(stream)->type = Val_int(STREAM_AUDIO);
Stream_context_direct_val(stream) = ctx;
Stream_aux_val(stream)->avstream = avformat_new_stream(Context_val(ctx)->fmtCtx, codec);
Stream_aux_val(stream)->avstream->codec->codec_id = AV_CODEC_ID_AAC;
Stream_aux_val(stream)->avstream->codec->sample_rate = Int_val(Field(audio_info_, 0));
Stream_aux_val(stream)->avstream->codec->channels = Int_val(Field(audio_info_, 1));
Stream_aux_val(stream)->avstream->codec->sample_fmt = codec->sample_fmts ? codec->sample_fmts[0] : AV_SAMPLE_FMT_FLTP;
Stream_aux_val(stream)->avstream->codec->channel_layout = AV_CH_LAYOUT_STEREO;
//Stream_aux_val(stream)->avstream->codec->channels = av_get_channel_layout_nb_channels(Stream_aux_val(stream)->avstream->codec->channel_layout);
if (Context_val(ctx)->fmtCtx->oformat->flags & AVFMT_GLOBALHEADER) {
Stream_aux_val(stream)->avstream->codec->flags |= AV_CODEC_FLAG_GLOBAL_HEADER;
}
Stream_aux_val(stream)->avstream->time_base = (AVRational) {1, 10000};
AVDictionary* codecOpts = NULL;
AVCodecContext* codecCtx = Stream_aux_val(stream)->avstream->codec;
caml_enter_blocking_section();
ret = avcodec_open2(codecCtx, codec, &codecOpts);
raise_and_leave_blocking_section_if_not(ret >= 0, ExnOpen, ret);
caml_leave_blocking_section();
if (Stream_aux_val(stream)->avstream->codec->sample_fmt != AV_SAMPLE_FMT_S16) {
Stream_aux_val(stream)->swrCtx = swr_alloc();
assert(Stream_aux_val(stream)->swrCtx);
av_opt_set_int (Stream_aux_val(stream)->swrCtx, "in_channel_count", Stream_aux_val(stream)->avstream->codec->channels, 0);
av_opt_set_int (Stream_aux_val(stream)->swrCtx, "in_sample_rate", Stream_aux_val(stream)->avstream->codec->sample_rate, 0);
av_opt_set_sample_fmt(Stream_aux_val(stream)->swrCtx, "in_sample_fmt", AV_SAMPLE_FMT_S16, 0);
av_opt_set_int (Stream_aux_val(stream)->swrCtx, "out_channel_count", Stream_aux_val(stream)->avstream->codec->channels, 0);
av_opt_set_int (Stream_aux_val(stream)->swrCtx, "out_sample_rate", Stream_aux_val(stream)->avstream->codec->sample_rate, 0);
av_opt_set_sample_fmt(Stream_aux_val(stream)->swrCtx, "out_sample_fmt", Stream_aux_val(stream)->avstream->codec->sample_fmt, 0);
}
CAMLreturn((value) stream);
}
CAMLprim value ocaml_faad_open(value unit)
{
CAMLparam0();
CAMLlocal1(ret);
NeAACDecHandle dh = NeAACDecOpen();
NeAACDecConfigurationPtr conf = NeAACDecGetCurrentConfiguration(dh);
conf->outputFormat = FAAD_FMT_FLOAT;
NeAACDecSetConfiguration(dh, conf);
ret = caml_alloc_custom(&faad_dec_ops, sizeof(NeAACDecHandle), 0, 1);
Dec_val(ret) = dh;
CAMLreturn(ret);
}
value
sankoff_CAML_median(value code, value a, value b) {
CAMLparam3(code,a,b);
CAMLlocal1(res);
eltarr_p eap1;
eltarr_p eap2;
eap1 = Sankoff_return_eltarr(a);
eap2 = Sankoff_return_eltarr(b);
eltarr_p neweltarr;
neweltarr = (eltarr_p)calloc(1,sizeof(struct elt_arr));
sankoff_median(Int_val(code),eap1,eap2,neweltarr);
res = caml_alloc_custom (&sankoff_custom_operations_eltarr,sizeof (eltarr_p), 1,alloc_custom_max);
Sankoff_return_eltarr(res) = neweltarr;
CAMLreturn(res);
}
/* [caml_ba_alloc] will allocate a new bigarray object in the heap.
If [data] is NULL, the memory for the contents is also allocated
(with [malloc]) by [caml_ba_alloc].
[data] cannot point into the OCaml heap.
[dim] may point into an object in the OCaml heap.
*/
CAMLexport value
caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim)
{
uintnat num_elts, asize, size;
int overflow, i;
value res;
struct caml_ba_array * b;
intnat dimcopy[CAML_BA_MAX_NUM_DIMS];
#if defined(__FreeBSD__) && defined(_KERNEL)
struct caml_ba_proxy *proxy;
#endif
Assert(num_dims >= 1 && num_dims <= CAML_BA_MAX_NUM_DIMS);
Assert((flags & CAML_BA_KIND_MASK) <= CAML_BA_COMPLEX64);
for (i = 0; i < num_dims; i++) dimcopy[i] = dim[i];
size = 0;
if (data == NULL) {
overflow = 0;
num_elts = 1;
for (i = 0; i < num_dims; i++) {
num_elts = caml_ba_multov(num_elts, dimcopy[i], &overflow);
}
size = caml_ba_multov(num_elts,
caml_ba_element_size[flags & CAML_BA_KIND_MASK],
&overflow);
if (overflow) caml_raise_out_of_memory();
data = __malloc(size);
if (data == NULL && size != 0) caml_raise_out_of_memory();
flags |= CAML_BA_MANAGED;
}
asize = SIZEOF_BA_ARRAY + num_dims * sizeof(intnat);
res = caml_alloc_custom(&caml_ba_ops, asize, size, CAML_BA_MAX_MEMORY);
b = Caml_ba_array_val(res);
#if defined(__FreeBSD__) && defined(_KERNEL)
if ((flags & CAML_BA_MANAGED_MASK) != CAML_BA_MANAGED) {
b->proxy = __malloc(sizeof(struct caml_ba_proxy));
if (b->proxy == NULL) caml_raise_out_of_memory();
proxy = b->proxy;
for (proxy->size = 0, i = 0; i < num_dims; i++)
proxy->size += dim[i];
proxy->refcount = 1;
if ((flags & CAML_BA_MANAGED_MASK) == CAML_BA_FBSD_MBUF) {
proxy->type = CAML_FREEBSD_MBUF;
proxy->data = data;
b->data = mtod((struct mbuf *) proxy->data, void *);
}
CAMLprim
value caml_extunix_signalfd_read(value vfd)
{
CAMLparam1(vfd);
CAMLlocal1(vret);
struct signalfd_siginfo ssi;
ssize_t nread = 0;
caml_enter_blocking_section();
nread = read(Int_val(vfd), &ssi, SSI_SIZE);
caml_leave_blocking_section();
if (nread != SSI_SIZE)
unix_error(EINVAL,"signalfd_read",Nothing);
vret = caml_alloc_custom(&ssi_ops, SSI_SIZE, 0, 1);
memcpy(Data_custom_val(vret),&ssi,SSI_SIZE);
CAMLreturn(vret);
}
CAMLprim value ml_text_decoder(value enc)
{
CAMLparam1(enc);
/* A decoder is an iconv descriptor from enc to UCS-4: */
iconv_t cd = iconv_open(NATIVE_UCS, String_val(enc));
if (cd == (iconv_t)-1)
caml_failwith("Encoding.decoder: invalid encoding");
else
{
value result = caml_alloc_custom(&ops, sizeof(iconv_t), 0, 1);
*(iconv_t*) Data_custom_val(result) = cd;
CAMLreturn(result);
}
}
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);
}
CAMLprim value ocaml_smf_get_track_by_number(value smf, value trackno)
{
CAMLparam2(smf, trackno);
CAMLlocal1(ret);
Track_t *t;
t = malloc(sizeof(Track_t));
t->t = smf_get_track_by_number(Smf_val(smf), Int_val(trackno));
if(t->t == NULL)
{
free(t);
/* Error */
t = NULL;
smf_err(0);
}
ret = caml_alloc_custom(&track_ops, sizeof(Track_t*), 1, 0);
Track_t_val(ret) = t;
CAMLreturn(ret);
}
