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); }