diff --git a/examples/decode.ml b/examples/decode.ml index bb3f796..ec6a2db 100644 --- a/examples/decode.ml +++ b/examples/decode.ml @@ -69,11 +69,10 @@ let process () = in let process, info, comments = if not !ogg then ( - let h = Flac.Decoder.File.create_from_fd write fd in + let h = Flac.Decoder.File.create_from_fd ~write fd in let process () = - Flac.Decoder.process h.Flac.Decoder.File.dec - h.Flac.Decoder.File.callbacks; - Flac.Decoder.state h.Flac.Decoder.File.dec h.Flac.Decoder.File.callbacks + Flac.Decoder.process h.Flac.Decoder.File.dec; + Flac.Decoder.state h.Flac.Decoder.File.dec in (process, h.Flac.Decoder.File.info, h.Flac.Decoder.File.comments)) else ( @@ -96,19 +95,11 @@ let process () = let page = Ogg.Sync.read sync in if Ogg.Page.serialno page = serial then Ogg.Stream.put_page os page in - let callbacks = Flac_ogg.Decoder.get_callbacks os write in - let dec = Flac.Decoder.create callbacks in - let rec info () = - try Flac.Decoder.init dec callbacks - with Ogg.Not_enough_data -> - fill (); - info () - in - let dec, info, meta = info () in + let dec, info, meta = Flac_ogg.Decoder.create ~fill ~write os in let rec process () = try - Flac.Decoder.process dec callbacks; - Flac.Decoder.state dec callbacks + Flac.Decoder.process dec; + Flac.Decoder.state dec with Ogg.Not_enough_data -> ( try fill (); diff --git a/examples/encode.ml b/examples/encode.ml index 14dba7c..428271c 100644 --- a/examples/encode.ml +++ b/examples/encode.ml @@ -74,13 +74,9 @@ let _ = let encode, finish = if not !ogg then ( let enc = Flac.Encoder.File.create ~comments params !dst in - let encode buf = - Flac.Encoder.process enc.Flac.Encoder.File.enc - enc.Flac.Encoder.File.callbacks buf - in + let encode buf = Flac.Encoder.process enc.Flac.Encoder.File.enc buf in let finish () = - Flac.Encoder.finish enc.Flac.Encoder.File.enc - enc.Flac.Encoder.File.callbacks; + Flac.Encoder.finish enc.Flac.Encoder.File.enc; Unix.close enc.Flac.Encoder.File.fd in (encode, finish)) @@ -91,12 +87,12 @@ let _ = output_string oc body in let serialno = Random.nativeint Nativeint.max_int in - let { Flac_ogg.Encoder.encoder; callbacks; first_pages } = - Flac_ogg.Encoder.create ~comments ~serialno params write_page + let { Flac_ogg.Encoder.encoder; first_pages } = + Flac_ogg.Encoder.create ~comments ~serialno ~write:write_page params in List.iter write_page first_pages; - let encode = Flac.Encoder.process encoder callbacks in - let finish () = Flac.Encoder.finish encoder callbacks in + let encode = Flac.Encoder.process encoder in + let finish () = Flac.Encoder.finish encoder in (encode, finish)) in let start = Unix.time () in diff --git a/src/dune b/src/dune index 3bfe339..266e601 100644 --- a/src/dune +++ b/src/dune @@ -2,7 +2,7 @@ (name flac) (public_name flac) (synopsis "OCaml bindings for libflac") - (modules flac flac_impl) + (modules flac) (libraries unix) (foreign_stubs (language c) diff --git a/src/flac.ml b/src/flac.ml index 9ed32f5..cf3038e 100644 --- a/src/flac.ml +++ b/src/flac.ml @@ -1 +1,240 @@ -include Flac_impl +(* + * Copyright 2003-2011 Savonet team + * + * This file is part of Ocaml-flac. + * + * Ocaml-flac is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * Ocaml-flac is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with Ocaml-flac; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + *) + +(* Author; Romain Beauxis *) + +exception Internal + +let () = Callback.register_exception "flac_exn_internal" Internal + +module Decoder = struct + type t + + (** Possible states of a decoder. *) + type state = + [ `Search_for_metadata + | `Read_metadata + | `Search_for_frame_sync + | `Read_frame + | `End_of_stream + | `Ogg_error + | `Seek_error + | `Aborted + | `Memory_allocation_error + | `Uninitialized ] + + exception Lost_sync + exception Bad_header + exception Frame_crc_mismatch + exception Unparseable_stream + exception Not_flac + + let () = + Callback.register_exception "flac_dec_exn_lost_sync" Lost_sync; + Callback.register_exception "flac_dec_exn_bad_header" Bad_header; + Callback.register_exception "flac_dec_exn_crc_mismatch" Frame_crc_mismatch; + Callback.register_exception "flac_dec_exn_unparseable_stream" + Unparseable_stream + + type info = { + sample_rate : int; + channels : int; + bits_per_sample : int; + total_samples : int64; + md5sum : string; + } + + type comments = string * (string * string) list + type comments_array = string * string array + + external info : t -> info * comments_array option = "ocaml_flac_decoder_info" + + let split_comment comment = + try + let equal_pos = String.index_from comment 0 '=' in + let c1 = String.uppercase_ascii (String.sub comment 0 equal_pos) in + let c2 = + String.sub comment (equal_pos + 1) + (String.length comment - equal_pos - 1) + in + (c1, c2) + with Not_found -> (comment, "") + + let _comments cmts = + match cmts with + | None -> None + | Some (vd, cmts) -> + Some (vd, Array.to_list (Array.map split_comment cmts)) + + let info x = + try + let info, comments = info x in + (info, _comments comments) + with Internal -> raise Not_flac + + external alloc : + seek:(int64 -> unit) option -> + tell:(unit -> int64) option -> + length:(unit -> int64) option -> + eof:(unit -> bool) option -> + read:(bytes -> int -> int -> int) -> + write:(float array array -> unit) -> + unit -> + t = "ocaml_flac_decoder_alloc_bytecode" "ocaml_flac_decoder_alloc_native" + + external cleanup : t -> unit = "ocaml_flac_cleanup_decoder" + external init : t -> unit = "ocaml_flac_decoder_init" + + let create ?seek ?tell ?length ?eof ~read ~write () = + let dec = alloc ~seek ~tell ~length ~eof ~read ~write () in + Gc.finalise cleanup dec; + init dec; + let info, comments = info dec in + (dec, info, comments) + + external state : t -> state = "ocaml_flac_decoder_state" + external process : t -> unit = "ocaml_flac_decoder_process" + external seek : t -> Int64.t -> bool = "ocaml_flac_decoder_seek" + external flush : t -> bool = "ocaml_flac_decoder_flush" + external reset : t -> bool = "ocaml_flac_decoder_reset" + external to_s16le : float array array -> string = "caml_flac_float_to_s16le" + + module File = struct + type handle = { + fd : Unix.file_descr; + dec : t; + info : info; + comments : (string * (string * string) list) option; + } + + let create_from_fd ~write fd = + let read = Unix.read fd in + let seek n = + let n = Int64.to_int n in + ignore (Unix.lseek fd n Unix.SEEK_SET) + in + let tell () = Int64.of_int (Unix.lseek fd 0 Unix.SEEK_CUR) in + let length () = + let stats = Unix.fstat fd in + Int64.of_int stats.Unix.st_size + in + let eof () = + let stats = Unix.fstat fd in + Unix.lseek fd 0 Unix.SEEK_CUR = stats.Unix.st_size + in + let dec, info, comments = + create ~seek ~tell ~length ~eof ~write ~read () + in + { fd; comments; dec; info } + + let create ~write filename = + let fd = Unix.openfile filename [Unix.O_RDONLY] 0o640 in + try create_from_fd ~write fd + with e -> + Unix.close fd; + raise e + end +end + +module Encoder = struct + type priv + + type params = { + channels : int; + bits_per_sample : int; + sample_rate : int; + compression_level : int option; + total_samples : int64 option; + } + + type comments = (string * string) list + type t = priv * params + + exception Invalid_data + exception Invalid_metadata + + let () = + Callback.register_exception "flac_enc_exn_invalid_metadata" Invalid_metadata + + external vorbiscomment_entry_name_is_legal : string -> bool + = "ocaml_flac_encoder_vorbiscomment_entry_name_is_legal" + + external vorbiscomment_entry_value_is_legal : string -> bool + = "ocaml_flac_encoder_vorbiscomment_entry_value_is_legal" + + external alloc : + (string * string) array -> + seek:(int64 -> unit) option -> + tell:(unit -> int64) option -> + write:(bytes -> unit) -> + params -> + priv = "ocaml_flac_encoder_alloc" + + external cleanup : priv -> unit = "ocaml_flac_cleanup_encoder" + external init : priv -> unit = "ocaml_flac_encoder_init" + + let create ?(comments = []) ?seek ?tell ~write p = + if p.channels <= 0 then raise Invalid_data; + let comments = Array.of_list comments in + let enc = alloc comments ~seek ~tell ~write p in + Gc.finalise cleanup enc; + init enc; + (enc, p) + + external process : priv -> float array array -> int -> unit + = "ocaml_flac_encoder_process" + + let process (enc, p) data = + if Array.length data <> p.channels then raise Invalid_data; + process enc data p.bits_per_sample + + external finish : priv -> unit = "ocaml_flac_encoder_finish" + + let finish (enc, _) = finish enc + + external from_s16le : string -> int -> float array array + = "caml_flac_s16le_to_float" + + module File = struct + type handle = { fd : Unix.file_descr; enc : t } + + let create_from_fd ?comments params fd = + let write s = + let len = Bytes.length s in + let rec f pos = + if pos < len then ( + let ret = Unix.write fd s pos (len - pos) in + f (pos + ret)) + in + f 0 + in + let seek n = + let n = Int64.to_int n in + ignore (Unix.lseek fd n Unix.SEEK_SET) + in + let tell () = Int64.of_int (Unix.lseek fd 0 Unix.SEEK_CUR) in + let enc = create ?comments ~seek ~tell ~write params in + { fd; enc } + + let create ?comments params filename = + let fd = Unix.openfile filename [Unix.O_CREAT; Unix.O_RDWR] 0o640 in + create_from_fd ?comments params fd + end +end diff --git a/src/flac.mli b/src/flac.mli index bc6519b..72a827d 100644 --- a/src/flac.mli +++ b/src/flac.mli @@ -50,44 +50,27 @@ module Decoder : sig * Flac.Decoder.process decoder callbacks * | _ -> raise End_of_stream v} * - * Some remarks: + * Some remarks: * - Exceptions raised by callbacks should be treated - * as fatal errors. The dehaviour of the flac library + * as fatal errors. The dehaviour of the flac library * after being interrupted by an exception is unknown. * The only notable exception is Ogg/flac decoding, where * the read callback raises [Ogg.Not_enough_data]. * - The state of the decoder should be checked prior to calling * [process]. Termination may not be detected nor raise an * exception so it is the caller's responsibility to check - * on this. - * - See FLAC documentation for the information on the - * callbacks. + * on this. + * - See FLAC documentation for the information on the + * callbacks. * - The variant type for decoder and callbacks is used - * to make sure that different type of decoders + * to make sure that different type of decoders * (generic, file, ogg) are only used with the same * type of callbacks. *) (** {3 Types } *) - (** Type of an uninitialized decoder. *) - type 'a dec + type t - (** Type of an initialized decoder. *) - type 'a t - - (** Type of a write callback. *) - type write = float array array -> unit - - (** Type of a read callback. *) - type read = bytes -> int -> int -> int - - (** Type of a collection of callbacks. *) - type 'a callbacks = 'a Flac_impl.Decoder.callbacks - - (** Generic variant type for callbacks and decoder. *) - type generic - - (** Info about decoded FLAC data. *) type info = { sample_rate : int; channels : int; @@ -143,64 +126,59 @@ module Decoder : sig (** {3 Functions} *) - (** Create a set of callbacks. *) - val get_callbacks : + (** Create a decoder. The decoder will be used to decode + * all metadata. Initial audio data shall be immediatly available + * after this call. *) + val create : ?seek:(int64 -> unit) -> ?tell:(unit -> int64) -> ?length:(unit -> int64) -> ?eof:(unit -> bool) -> - read -> - write -> - generic callbacks - - (** Create an uninitialized decoder. *) - val create : 'a callbacks -> 'a dec - - (** Initialize a decoder. The decoder will be used to decode - * all metadata. Initial audio data shall be immediatly available - * after this call. *) - val init : 'a dec -> 'a callbacks -> 'a t * info * comments option + read:(bytes -> int -> int -> int) -> + write:(float array array -> unit) -> + unit -> + t * info * comments option (** Decode one frame of audio data. *) - val process : 'a t -> 'a callbacks -> unit + val process : t -> unit (** Flush the input and seek to an absolute sample. - * Decoding will resume at the given sample. Note - * that because of this, the next write callback may - * contain a partial block. The client must support seeking - * the input or this function will fail and return [false]. + * Decoding will resume at the given sample. Note + * that because of this, the next write callback may + * contain a partial block. The client must support seeking + * the input or this function will fail and return [false]. * Furthermore, if the decoder state is [`Seek_error] * then the decoder must be flushed or reset * before decoding can continue. *) - val seek : 'a t -> 'a callbacks -> Int64.t -> bool + val seek : t -> Int64.t -> bool (** Flush the stream input. * The decoder's input buffer will be cleared and the state set to * [`Search_for_frame_sync]. This will also turn * off MD5 checking. *) - val flush : 'a t -> 'a callbacks -> bool + val flush : t -> bool (** Reset the decoding process. * The decoder's input buffer will be cleared and the state set to * [`Search_for_metadata]. MD5 checking will be restored to its original * setting. * - * If the decoder is seekable, the decoder will also attempt to seek to - * the beginning of the stream. If this rewind fails, this function will - * return [false]. It follows that [reset] cannot be used when decoding + * If the decoder is seekable, the decoder will also attempt to seek to + * the beginning of the stream. If this rewind fails, this function will + * return [false]. It follows that [reset] cannot be used when decoding * from [stdin]. * - * If the decoder is not seekable (i.e. no seek callback was provided) - * it is the duty of the client to start feeding data from the beginning + * If the decoder is not seekable (i.e. no seek callback was provided) + * it is the duty of the client to start feeding data from the beginning * of the stream on the next [process]. *) - val reset : 'a t -> 'a callbacks -> bool + val reset : t -> bool (** Get the state of a decoder. *) - val state : 'a t -> 'a callbacks -> state + val state : t -> state (** {3 Convenience} *) - (** Convert an audio array to a S16LE string for + (** Convert an audio array to a S16LE string for * decoding FLAC to WAV and raw PCM *) val to_s16le : float array array -> string @@ -211,17 +189,10 @@ module Decoder : sig (** {3 Types} *) - (** File variant type for a file decoder *) - type file - (* Handler for file decoder *) type handle = { fd : Unix.file_descr; - dec : file t; - (* These callback support [seek] and [tell] - * if the underlying [Unix.file_descriptor] - * supports them. *) - callbacks : file callbacks; + dec : t; info : info; comments : (string * (string * string) list) option; } @@ -229,14 +200,15 @@ module Decoder : sig (** {3 Functions} *) (** Create a file decoder from a Unix file - * descriptor + * descriptor * * Note: this decoder requires seeking thus will only work on seekable * file descriptor. *) - val create_from_fd : write -> Unix.file_descr -> handle + val create_from_fd : + write:(float array array -> unit) -> Unix.file_descr -> handle (** Create a file decoder from a file URI *) - val create : write -> string -> handle + val create : write:(float array array -> unit) -> string -> handle end end @@ -255,23 +227,23 @@ module Encoder : sig * (* Create an encoder *) * let enc = Flac.Encoder.create ~comments params callbacks in * (* Encode data *) - * let data = (..a value of type float array array.. in + * let data = (..a value of type float array array.. in * Flac.Encoder.process enc callbacks data ; * (..repeat encoding process..) * (* Close encoder *) * Flac.Encoder.finish enc callbacks v} - * - * Remarks: + * + * Remarks: * - Exceptions raised by the callbacks should be treated * as fatal. The behaviour of the FLAC encoding library is * unknown after interrupted by an exception. * - Encoded data should have the same number of channels as * specified in encoder's parameters and the same number of - * samples in each channels. + * samples in each channels. * - See FLAC documentation for informations about the callbacks. * Note in particular that some information about encoded data - * such as md5 sum and total samples are only written when a - * [seek] callback is given. + * such as md5 sum and total samples are only written when a + * [seek] callback is given. * - Variant types for callbacks and encoder are used to make sure * that different type of callbacks (generic, file, ogg) are always * used with the corresponding decoder type. *) @@ -279,16 +251,7 @@ module Encoder : sig (** {3 Types} *) (** Type of an encoder. *) - type 'a t - - (** Type of a write callback *) - type write = bytes -> unit - - (** Type of a set of callbacks *) - type 'a callbacks = 'a Flac_impl.Encoder.callbacks - - (** Generic type for an encoder *) - type generic + type t (** Type of encoding parameters *) type params = { @@ -315,10 +278,6 @@ module Encoder : sig (** {3 Functions} *) - (** Create a set of encoding callbacks *) - val get_callbacks : - ?seek:(int64 -> unit) -> ?tell:(unit -> int64) -> write -> generic callbacks - (** Check if a comment label is valid *) val vorbiscomment_entry_name_is_legal : string -> bool @@ -326,19 +285,25 @@ module Encoder : sig val vorbiscomment_entry_value_is_legal : string -> bool (** Create an encoder *) - val create : ?comments:comments -> params -> 'a callbacks -> 'a t + val create : + ?comments:comments -> + ?seek:(int64 -> unit) -> + ?tell:(unit -> int64) -> + write:(bytes -> unit) -> + params -> + t (** Encode some data *) - val process : 'a t -> 'a callbacks -> float array array -> unit + val process : t -> float array array -> unit (** Terminate an encoder. Causes the encoder to * flush remaining encoded data. The encoder should * not be used anymore afterwards. *) - val finish : 'a t -> 'a callbacks -> unit + val finish : t -> unit (** {3 Convenience} *) - (** Convert S16LE pcm data to an audio array for + (** Convert S16LE pcm data to an audio array for * encoding WAV and raw PCM to flac. *) val from_s16le : string -> int -> float array array @@ -348,20 +313,13 @@ module Encoder : sig (** {3 Types} *) - (** Generic variant type for file encoder *) - type file - (** Handle for file encoder *) - type handle = { - fd : Unix.file_descr; - enc : file t; - callbacks : file callbacks; - } + type handle = { fd : Unix.file_descr; enc : t } (** {3 Functions} *) (** Create a file encoder writing data to a given Unix file descriptor. - * + * * Note: this encoder requires seeking thus will only work on seekable * file descriptor. *) val create_from_fd : diff --git a/src/flac_decoder.ml b/src/flac_decoder.ml index 4dfcac2..e06da5a 100644 --- a/src/flac_decoder.ml +++ b/src/flac_decoder.ml @@ -20,30 +20,22 @@ let check = Flac_ogg.Decoder.check_packet -let decoder os = - let ogg_dec = ref None in +let mk_decoder ~fill ~write os = + let dec, info, m = Flac_ogg.Decoder.create ~fill ~write os in + let meta = match m with None -> ("Unknown vendor", []) | Some x -> x in + (dec, info, meta) + +let decoder ~fill os = let decoder = ref None in let write_ref = ref (fun _ -> ()) in let write ret = let fn = !write_ref in fn ret in - let callbacks_ref = ref (Flac_ogg.Decoder.get_callbacks os write) in let get_decoder () = match !decoder with | None -> - let ogg_dec = - match !ogg_dec with - | None -> - let dec = Flac.Decoder.create !callbacks_ref in - ogg_dec := Some dec; - dec - | Some dec -> dec - in - let dec, info, m = Flac.Decoder.init ogg_dec !callbacks_ref in - let meta = - match m with None -> ("Unknown vendor", []) | Some x -> x - in + let dec, info, meta = mk_decoder ~fill ~write os in decoder := Some (dec, info, meta); (dec, info, meta) | Some d -> d @@ -56,22 +48,22 @@ let decoder os = }, m ) in - let decode feed = - write_ref := feed; + let decode write = + write_ref := write; let decoder, _, _ = get_decoder () in - match Flac.Decoder.state decoder !callbacks_ref with + match Flac.Decoder.state decoder with | `Search_for_metadata | `Read_metadata | `Search_for_frame_sync | `Read_frame -> - Flac.Decoder.process decoder !callbacks_ref + Flac.Decoder.process decoder (* Ogg decoder is responsible for detecting end of stream vs. end of track. *) | _ -> raise Ogg.Not_enough_data in - let restart new_os = + let restart ~fill new_os = (write_ref := fun _ -> ()); let d, _, _ = get_decoder () in (* Flush error are very unlikely. *) - assert (Flac.Decoder.flush d !callbacks_ref); - callbacks_ref := Flac_ogg.Decoder.get_callbacks new_os write + assert (Flac.Decoder.flush d); + decoder := Some (mk_decoder ~fill ~write new_os) in Ogg_decoder.Audio { diff --git a/src/flac_impl.ml b/src/flac_impl.ml deleted file mode 100644 index 954a6d9..0000000 --- a/src/flac_impl.ml +++ /dev/null @@ -1,270 +0,0 @@ -(* - * Copyright 2003-2011 Savonet team - * - * This file is part of Ocaml-flac. - * - * Ocaml-flac is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * Ocaml-flac is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with Ocaml-flac; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - *) - -(* Author; Romain Beauxis *) - -exception Internal - -let () = Callback.register_exception "flac_exn_internal" Internal - -module Decoder = struct - type 'a dec - type 'a t = 'a dec - type write = float array array -> unit - type read = bytes -> int -> int -> int - - type 'a callbacks = { - read : read; - seek : (int64 -> unit) option; - tell : (unit -> int64) option; - length : (unit -> int64) option; - eof : (unit -> bool) option; - write : write; - } - - type generic - - let get_callbacks ?seek ?tell ?length ?eof read write = - { read; seek; tell; length; eof; write } - - (** Possible states of a decoder. *) - type state = - [ `Search_for_metadata - | `Read_metadata - | `Search_for_frame_sync - | `Read_frame - | `End_of_stream - | `Ogg_error - | `Seek_error - | `Aborted - | `Memory_allocation_error - | `Uninitialized ] - - exception Lost_sync - exception Bad_header - exception Frame_crc_mismatch - exception Unparseable_stream - exception Not_flac - - let () = - Callback.register_exception "flac_dec_exn_lost_sync" Lost_sync; - Callback.register_exception "flac_dec_exn_bad_header" Bad_header; - Callback.register_exception "flac_dec_exn_crc_mismatch" Frame_crc_mismatch; - Callback.register_exception "flac_dec_exn_unparseable_stream" - Unparseable_stream - - type info = { - sample_rate : int; - channels : int; - bits_per_sample : int; - total_samples : int64; - md5sum : string; - } - - type comments = string * (string * string) list - type comments_array = string * string array - - external info : 'a dec -> info * comments_array option - = "ocaml_flac_decoder_info" - - let split_comment comment = - try - let equal_pos = String.index_from comment 0 '=' in - let c1 = String.uppercase_ascii (String.sub comment 0 equal_pos) in - let c2 = - String.sub comment (equal_pos + 1) - (String.length comment - equal_pos - 1) - in - (c1, c2) - with Not_found -> (comment, "") - - let _comments cmts = - match cmts with - | None -> None - | Some (vd, cmts) -> - Some (vd, Array.to_list (Array.map split_comment cmts)) - - let info x = - try - let info, comments = info x in - (info, _comments comments) - with Internal -> raise Not_flac - - external create : 'a callbacks -> 'a dec = "ocaml_flac_decoder_create" - external state : 'a t -> 'a callbacks -> state = "ocaml_flac_decoder_state" - external init : 'a dec -> 'a callbacks -> unit = "ocaml_flac_decoder_init" - - let init dec c = - init dec c; - let info, comments = info dec in - (dec, info, comments) - - external process : 'a t -> 'a callbacks -> unit = "ocaml_flac_decoder_process" - - external seek : 'a t -> 'a callbacks -> Int64.t -> bool - = "ocaml_flac_decoder_seek" - - external flush : 'a t -> 'a callbacks -> bool = "ocaml_flac_decoder_flush" - external reset : 'a t -> 'a callbacks -> bool = "ocaml_flac_decoder_reset" - external to_s16le : float array array -> string = "caml_flac_float_to_s16le" - - module File = struct - type file - - type handle = { - fd : Unix.file_descr; - dec : file t; - callbacks : file callbacks; - info : info; - comments : (string * (string * string) list) option; - } - - let create_from_fd write fd = - let read = Unix.read fd in - let seek n = - let n = Int64.to_int n in - ignore (Unix.lseek fd n Unix.SEEK_SET) - in - let tell () = Int64.of_int (Unix.lseek fd 0 Unix.SEEK_CUR) in - let length () = - let stats = Unix.fstat fd in - Int64.of_int stats.Unix.st_size - in - let eof () = - let stats = Unix.fstat fd in - Unix.lseek fd 0 Unix.SEEK_CUR = stats.Unix.st_size - in - let callbacks = - { - read; - seek = Some seek; - tell = Some tell; - length = Some length; - eof = Some eof; - write; - } - in - let dec = create callbacks in - let dec, info, comments = init dec callbacks in - { fd; comments; callbacks; dec; info } - - let create write filename = - let fd = Unix.openfile filename [Unix.O_RDONLY] 0o640 in - try create_from_fd write fd - with e -> - Unix.close fd; - raise e - end -end - -module Encoder = struct - type 'a priv - type write = bytes -> unit - - type 'a callbacks = { - write : write; - seek : (int64 -> unit) option; - tell : (unit -> int64) option; - } - - type generic - - let get_callbacks ?seek ?tell write = { write; seek; tell } - - type params = { - channels : int; - bits_per_sample : int; - sample_rate : int; - compression_level : int option; - total_samples : int64 option; - } - - type comments = (string * string) list - type 'a t = 'a priv * params - - exception Invalid_data - exception Invalid_metadata - - let () = - Callback.register_exception "flac_enc_exn_invalid_metadata" Invalid_metadata - - external vorbiscomment_entry_name_is_legal : string -> bool - = "ocaml_flac_encoder_vorbiscomment_entry_name_is_legal" - - external vorbiscomment_entry_value_is_legal : string -> bool - = "ocaml_flac_encoder_vorbiscomment_entry_value_is_legal" - - external create : (string * string) array -> params -> 'a callbacks -> 'a priv - = "ocaml_flac_encoder_create" - - let create ?(comments = []) p c = - if p.channels <= 0 then raise Invalid_data; - let comments = Array.of_list comments in - let enc = create comments p c in - (enc, p) - - external process : 'a priv -> 'a callbacks -> float array array -> int -> unit - = "ocaml_flac_encoder_process" - - let process (enc, p) c data = - if Array.length data <> p.channels then raise Invalid_data; - process enc c data p.bits_per_sample - - external finish : 'a priv -> 'a callbacks -> unit - = "ocaml_flac_encoder_finish" - - let finish (enc, _) c = finish enc c - - external from_s16le : string -> int -> float array array - = "caml_flac_s16le_to_float" - - module File = struct - type file - - type handle = { - fd : Unix.file_descr; - enc : file t; - callbacks : file callbacks; - } - - let create_from_fd ?comments params fd = - let write s = - let len = Bytes.length s in - let rec f pos = - if pos < len then ( - let ret = Unix.write fd s pos (len - pos) in - f (pos + ret)) - in - f 0 - in - let seek n = - let n = Int64.to_int n in - ignore (Unix.lseek fd n Unix.SEEK_SET) - in - let tell () = Int64.of_int (Unix.lseek fd 0 Unix.SEEK_CUR) in - let callbacks = { write; seek = Some seek; tell = Some tell } in - let enc = create ?comments params callbacks in - { fd; enc; callbacks } - - let create ?comments params filename = - let fd = Unix.openfile filename [Unix.O_CREAT; Unix.O_RDWR] 0o640 in - create_from_fd ?comments params fd - end -end diff --git a/src/flac_ogg.ml b/src/flac_ogg.ml index 154a911..9941a6d 100644 --- a/src/flac_ogg.ml +++ b/src/flac_ogg.ml @@ -21,17 +21,15 @@ (* Author; Romain Beauxis *) module Decoder = struct - type ogg - external get_packet_data : Ogg.Stream.packet -> string = "ocaml_flac_decoder_packet_data" let ogg_header_len = 9 - let get_callbacks os write : ogg Flac.Decoder.callbacks = + let create ~fill ~write os = let read_data = Buffer.create 1024 in let is_first_packet = ref true in - let read bytes ofs len = + let rec read bytes ofs len = try if Buffer.length read_data = 0 then ( let p = Ogg.Stream.get_packet os in @@ -53,34 +51,33 @@ module Decoder = struct Buffer.add_string read_data rem; Bytes.blit_string c 0 bytes ofs len; len - with Ogg.End_of_stream -> 0 + with + | Ogg.Not_enough_data -> + fill (); + read bytes ofs len + | Ogg.End_of_stream -> 0 in - Flac__Flac_impl.Decoder.get_callbacks read write + Flac.Decoder.create ~read ~write () external check_packet : Ogg.Stream.packet -> bool = "ocaml_flac_decoder_check_ogg" end module Encoder = struct - type ogg - type enc - - type t = { - encoder : ogg Flac.Encoder.t; - callbacks : ogg Flac.Encoder.callbacks; - first_pages : Ogg.Page.t list; - } + type priv + type t = { encoder : Flac.Encoder.t; first_pages : Ogg.Page.t list } external create : (string * string) array -> Flac.Encoder.params -> - 'a Flac.Encoder.callbacks -> nativeint -> - enc = "ocaml_flac_encoder_ogg_create" + (bytes -> unit) -> + priv = "ocaml_flac_encoder_ogg_create" - let create ?(comments = []) ~serialno params write = + let create ?(comments = []) ~serialno ~write params = if params.Flac.Encoder.channels <= 0 then raise Flac.Encoder.Invalid_data; let comments = Array.of_list comments in + let first_pages_parsed = ref false in let first_pages = ref [] in let header = ref None in let write_wrap write p = @@ -90,17 +87,15 @@ module Encoder = struct write (Bytes.unsafe_to_string h, Bytes.unsafe_to_string p) | None -> header := Some p in - let write_first_page = - write_wrap (fun p -> first_pages := p :: !first_pages) + let write_first_page p = first_pages := p :: !first_pages in + let write = + write_wrap (fun p -> + if !first_pages_parsed then write p else write_first_page p) in - let callbacks = Flac.Encoder.get_callbacks write_first_page in - let enc = create comments params callbacks serialno in + let enc = create comments params serialno write in + first_pages_parsed := true; assert (!header = None); - { - encoder = Obj.magic (enc, params); - callbacks = Flac__Flac_impl.Encoder.get_callbacks (write_wrap write); - first_pages = List.rev !first_pages; - } + { encoder = Obj.magic (enc, params); first_pages = List.rev !first_pages } end module Skeleton = struct diff --git a/src/flac_ogg.mli b/src/flac_ogg.mli index 9e61246..cb0fd36 100644 --- a/src/flac_ogg.mli +++ b/src/flac_ogg.mli @@ -22,74 +22,26 @@ (** {1 Ogg/flac encoder/decoder modules for OCaml} *) -(** Decode ogg/flac data *) module Decoder : sig - (** {3 Usage} *) - - (** Usage is similar to the case - * of the native FLAC decoder, using - * the appropriate ogg/flac decoding - * callbacks. - * - * The main difference is that in the - * case of the ogg/flac decoding, the - * exception [Ogg.Not_enough_data] may - * be raised if the ogg stream used to - * create the decoder does not contain - * enough data. In this case, you should - * feed more data into the ogg stream and - * call the decoding function again. - * - * This remark is valid for both the - * [Flac.Decoder.init] and [Flac.Decoder.process] - * functions. *) - - (** {3 Types} *) - - (** Variant type for ogg/flac decoder *) - type ogg - (** Check if an ogg packet is the first * packet of an ogg/flac stream. *) val check_packet : Ogg.Stream.packet -> bool - (** Create a set of callbacks to decode an ogg/flac stream *) - val get_callbacks : - Ogg.Stream.stream -> Flac.Decoder.write -> ogg Flac.Decoder.callbacks + val create : + fill:(unit -> unit) -> + write:(float array array -> unit) -> + Ogg.Stream.stream -> + Flac.Decoder.t * Flac.Decoder.info * Flac.Decoder.comments option end -(** Encode ogg/flac data *) module Encoder : sig - (** {3 Usage} *) - - (** Usage is similar to the case - * of the native FLAC encoder, using - * the appropriate ogg/flac encoding - * callbacks. *) - - (** {3 Types} *) - - (** Variant type for ogg/flac encoder *) - type ogg - - type t = { - encoder : ogg Flac.Encoder.t; - callbacks : ogg Flac.Encoder.callbacks; - first_pages : Ogg.Page.t list; - } + type t = { encoder : Flac.Encoder.t; first_pages : Ogg.Page.t list } - (** Create an ogg/flac encoder. - * - * The returned value contains an encoder value - * that can be used with the functions from the - * [Flac.Encoder] module, as well as the - * corresponding callbacks to use with the various - * encoding functions. *) val create : ?comments:(string * string) list -> serialno:Nativeint.t -> + write:(Ogg.Page.t -> unit) -> Flac.Encoder.params -> - (Ogg.Page.t -> unit) -> t end diff --git a/src/flac_ogg_stubs.c b/src/flac_ogg_stubs.c index 2d4fa6f..448874c 100644 --- a/src/flac_ogg_stubs.c +++ b/src/flac_ogg_stubs.c @@ -60,17 +60,16 @@ CAMLprim value ocaml_flac_decoder_packet_data(value v) { /* Encoder */ CAMLprim value ocaml_flac_encoder_ogg_create(value comments, value params, - value _enc_cb, value _serialno) { - CAMLparam4(comments, params, _enc_cb, _serialno); + value _serialno, value _write_cb) { + CAMLparam4(comments, params, _serialno, _write_cb); CAMLlocal2(tmp, ret); intnat serialno = Nativeint_val(_serialno); - ret = ocaml_flac_encoder_alloc(comments, params); + ret = + ocaml_flac_encoder_alloc(comments, Val_none, Val_none, _write_cb, params); ocaml_flac_encoder *enc = Encoder_val(ret); - caml_modify_generational_global_root(&enc->callbacks, _enc_cb); - caml_release_runtime_system(); FLAC__stream_encoder_set_ogg_serial_number(enc->encoder, serialno); FLAC__stream_encoder_init_ogg_stream(enc->encoder, NULL, enc_write_callback, @@ -78,8 +77,6 @@ CAMLprim value ocaml_flac_encoder_ogg_create(value comments, value params, (void *)&enc->callbacks); caml_acquire_runtime_system(); - caml_modify_generational_global_root(&enc->callbacks, Val_none); - CAMLreturn(ret); } diff --git a/src/flac_stubs.c b/src/flac_stubs.c index 4305a6c..1b96442 100644 --- a/src/flac_stubs.c +++ b/src/flac_stubs.c @@ -53,18 +53,20 @@ value flac_Val_some(value v) { /* Threads management. */ static pthread_key_t ocaml_c_thread_key; static pthread_once_t ocaml_c_thread_key_once = PTHREAD_ONCE_INIT; -static int ocaml_flac_thread_initialized = 1; static void ocaml_flac_on_thread_exit(void *key) { caml_c_thread_unregister(); } static void ocaml_flac_make_key() { - caml_c_thread_register(); pthread_key_create(&ocaml_c_thread_key, ocaml_flac_on_thread_exit); - pthread_setspecific(ocaml_c_thread_key, &ocaml_flac_thread_initialized); } void ocaml_flac_register_thread() { + static int initialized = 1; + pthread_once(&ocaml_c_thread_key_once, ocaml_flac_make_key); + + if (caml_c_thread_register() && !pthread_getspecific(ocaml_c_thread_key)) + pthread_setspecific(ocaml_c_thread_key, (void *)&initialized); } /* Convenience functions */ @@ -183,15 +185,29 @@ static value raise_exn_of_error(FLAC__StreamDecoderErrorStatus e) { /* Caml abstract value containing the decoder. */ #define Decoder_val(v) (*((ocaml_flac_decoder **)Data_custom_val(v))) +CAMLprim value ocaml_flac_cleanup_decoder(value e) { + ocaml_flac_decoder *dec = Decoder_val(e); + + caml_remove_generational_global_root(&dec->callbacks.read_cb); + caml_remove_generational_global_root(&dec->callbacks.seek_cb); + caml_remove_generational_global_root(&dec->callbacks.tell_cb); + caml_remove_generational_global_root(&dec->callbacks.eof_cb); + caml_remove_generational_global_root(&dec->callbacks.length_cb); + caml_remove_generational_global_root(&dec->callbacks.write_cb); + caml_remove_generational_global_root(&dec->callbacks.buffer); + + return Val_unit; +} + static void finalize_decoder(value e) { ocaml_flac_decoder *dec = Decoder_val(e); + FLAC__stream_decoder_delete(dec->decoder); if (dec->callbacks.info != NULL) free(dec->callbacks.info); if (dec->callbacks.meta != NULL) FLAC__metadata_object_delete(dec->callbacks.meta); - caml_remove_generational_global_root(&dec->callbacks.callbacks); free(dec); } @@ -240,7 +256,7 @@ void dec_metadata_callback(const FLAC__StreamDecoder *decoder, void dec_error_callback(const FLAC__StreamDecoder *decoder, FLAC__StreamDecoderErrorStatus status, void *client_data) { - /* This callback is executed in non-blocking section. */ + ocaml_flac_register_thread(); caml_acquire_runtime_system(); raise_exn_of_error(status); return; @@ -252,35 +268,15 @@ dec_seek_callback(const FLAC__StreamDecoder *decoder, ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; + if (callbacks->seek_cb == Val_none) + return FLAC__STREAM_DECODER_SEEK_STATUS_UNSUPPORTED; + ocaml_flac_register_thread(); caml_acquire_runtime_system(); - - value seek = Dec_read(callbacks->callbacks); - - if (seek != Val_none) { - caml_register_generational_global_root(&seek); - - value ret = caml_callback_exn(Some_val(seek), - caml_copy_int64(absolute_byte_offset)); - caml_register_generational_global_root(&ret); - - if (Is_exception_result(ret)) { - caml_remove_generational_global_root(&seek); - caml_remove_generational_global_root(&ret); - caml_raise(Extract_exception(ret)); - } - - caml_register_generational_global_root(&seek); - caml_remove_generational_global_root(&ret); - - caml_release_runtime_system(); - - return FLAC__STREAM_DECODER_SEEK_STATUS_OK; - } - + caml_callback(callbacks->seek_cb, caml_copy_int64(absolute_byte_offset)); caml_release_runtime_system(); - return FLAC__STREAM_DECODER_SEEK_STATUS_UNSUPPORTED; + return FLAC__STREAM_DECODER_SEEK_STATUS_OK; } static FLAC__StreamDecoderTellStatus @@ -289,35 +285,16 @@ dec_tell_callback(const FLAC__StreamDecoder *decoder, ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; + if (callbacks->tell_cb == Val_none) + return FLAC__STREAM_DECODER_TELL_STATUS_UNSUPPORTED; + ocaml_flac_register_thread(); caml_acquire_runtime_system(); - - value tell = Dec_tell(callbacks->callbacks); - - if (tell != Val_none) { - caml_register_generational_global_root(&tell); - - value ret = caml_callback_exn(Some_val(tell), Val_unit); - caml_register_generational_global_root(&ret); - - if (Is_exception_result(ret)) { - caml_remove_generational_global_root(&tell); - caml_remove_generational_global_root(&ret); - caml_raise(Extract_exception(ret)); - } - - *absolute_byte_offset = (FLAC__uint64)Int64_val(ret); - - caml_remove_generational_global_root(&tell); - caml_remove_generational_global_root(&ret); - caml_release_runtime_system(); - - return FLAC__STREAM_DECODER_TELL_STATUS_OK; - } - + value ret = caml_callback(callbacks->tell_cb, Val_unit); + *absolute_byte_offset = (FLAC__uint64)Int64_val(ret); caml_release_runtime_system(); - return FLAC__STREAM_DECODER_TELL_STATUS_UNSUPPORTED; + return FLAC__STREAM_DECODER_TELL_STATUS_OK; } static FLAC__StreamDecoderLengthStatus @@ -326,35 +303,16 @@ dec_length_callback(const FLAC__StreamDecoder *decoder, ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; + if (callbacks->length_cb == Val_none) + return FLAC__STREAM_DECODER_LENGTH_STATUS_UNSUPPORTED; + ocaml_flac_register_thread(); caml_acquire_runtime_system(); - - value length = Dec_length(callbacks->callbacks); - - if (length != Val_none) { - caml_register_generational_global_root(&length); - - value ret = caml_callback_exn(Some_val(length), Val_unit); - caml_register_generational_global_root(&ret); - - if (Is_exception_result(ret)) { - caml_remove_generational_global_root(&length); - caml_remove_generational_global_root(&ret); - caml_raise(Extract_exception(ret)); - } - - *stream_length = (FLAC__uint64)Int64_val(ret); - - caml_remove_generational_global_root(&length); - caml_remove_generational_global_root(&ret); - caml_release_runtime_system(); - - return FLAC__STREAM_DECODER_LENGTH_STATUS_OK; - } - + value ret = caml_callback(callbacks->length_cb, Val_unit); + *stream_length = (FLAC__uint64)Int64_val(ret); caml_release_runtime_system(); - return FLAC__STREAM_DECODER_LENGTH_STATUS_UNSUPPORTED; + return FLAC__STREAM_DECODER_LENGTH_STATUS_OK; } static FLAC__bool dec_eof_callback(const FLAC__StreamDecoder *decoder, @@ -362,37 +320,15 @@ static FLAC__bool dec_eof_callback(const FLAC__StreamDecoder *decoder, ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; + if (callbacks->eof_cb == Val_none) + return false; + ocaml_flac_register_thread(); caml_acquire_runtime_system(); - - value eof = Dec_eof(callbacks->callbacks); - - if (eof != Val_none) { - caml_register_generational_global_root(&eof); - - value ret = caml_callback_exn(Some_val(eof), Val_unit); - caml_register_generational_global_root(&ret); - - if (Is_exception_result(ret)) { - caml_remove_generational_global_root(&eof); - caml_remove_generational_global_root(&ret); - caml_raise(Extract_exception(ret)); - } - - int res = false; - if (ret == Val_true) - res = true; - - caml_remove_generational_global_root(&eof); - caml_remove_generational_global_root(&ret); - caml_release_runtime_system(); - - return res; - } - + value ret = caml_callback(callbacks->eof_cb, Val_unit); caml_release_runtime_system(); - return false; + return ret == Val_true; } FLAC__StreamDecoderReadStatus static dec_read_callback( @@ -405,29 +341,13 @@ FLAC__StreamDecoderReadStatus static dec_read_callback( caml_acquire_runtime_system(); int readlen = *bytes; + if (callbacks->buflen < readlen) + readlen = callbacks->buflen; - value data = caml_alloc_string(readlen); - caml_register_generational_global_root(&data); - - value read_cb = Dec_read(callbacks->callbacks); - caml_register_generational_global_root(&read_cb); - - value ret = caml_callback3_exn(Dec_read(callbacks->callbacks), data, - Val_int(0), Val_int(readlen)); - caml_register_generational_global_root(&ret); + value ret = caml_callback3(callbacks->read_cb, callbacks->buffer, Val_int(0), + Val_int(readlen)); - if (Is_exception_result(ret)) { - caml_remove_generational_global_root(&data); - caml_remove_generational_global_root(&read_cb); - caml_remove_generational_global_root(&ret); - caml_raise(Extract_exception(ret)); - } - - caml_remove_generational_global_root(&data); - caml_remove_generational_global_root(&read_cb); - caml_remove_generational_global_root(&ret); - - memcpy(buffer, String_val(data), Int_val(ret)); + memcpy(buffer, String_val(callbacks->buffer), Int_val(ret)); *bytes = Int_val(ret); caml_release_runtime_system(); @@ -474,30 +394,30 @@ dec_write_callback(const FLAC__StreamDecoder *decoder, const FLAC__Frame *frame, sample_to_double(buffer[c][i], bps)); } - value write_cb = Dec_write(callbacks->callbacks); - caml_register_generational_global_root(&write_cb); - - value ret = caml_callback_exn(write_cb, data); - caml_register_generational_global_root(&ret); + value ret = caml_callback_exn(callbacks->write_cb, data); + caml_remove_generational_global_root(&data); if (Is_exception_result(ret)) { + ret = Extract_exception(ret); caml_remove_generational_global_root(&data); - caml_remove_generational_global_root(&write_cb); - caml_remove_generational_global_root(&ret); - caml_raise(Extract_exception(ret)); + caml_raise(ret); } caml_remove_generational_global_root(&data); - caml_remove_generational_global_root(&write_cb); - caml_remove_generational_global_root(&ret); caml_release_runtime_system(); return FLAC__STREAM_DECODER_WRITE_STATUS_CONTINUE; } -value ocaml_flac_decoder_alloc() { - CAMLparam0(); +#define Some_or_none(v) (v == Val_none ? Val_none : Some_val(v)) + +CAMLprim value ocaml_flac_decoder_alloc_native(value seek, value tell, + value length, value eof, + value read, value write, + value u) { + CAMLparam5(seek, tell, length, eof, read); + CAMLxparam1(write); CAMLlocal1(ans); // Initialize things @@ -506,12 +426,32 @@ value ocaml_flac_decoder_alloc() { caml_raise_out_of_memory(); dec->decoder = FLAC__stream_decoder_new(); - dec->callbacks.callbacks = Val_none; + + dec->callbacks.seek_cb = Some_or_none(seek); + caml_register_generational_global_root(&dec->callbacks.seek_cb); + + dec->callbacks.tell_cb = Some_or_none(tell); + caml_register_generational_global_root(&dec->callbacks.tell_cb); + + dec->callbacks.length_cb = Some_or_none(length); + caml_register_generational_global_root(&dec->callbacks.length_cb); + + dec->callbacks.eof_cb = Some_or_none(eof); + caml_register_generational_global_root(&dec->callbacks.eof_cb); + + dec->callbacks.write_cb = write; + caml_register_generational_global_root(&dec->callbacks.write_cb); + + dec->callbacks.read_cb = read; + caml_register_generational_global_root(&dec->callbacks.read_cb); + + dec->callbacks.buflen = 1024; + dec->callbacks.buffer = caml_alloc_string(dec->callbacks.buflen); + caml_register_generational_global_root(&dec->callbacks.buffer); + dec->callbacks.info = NULL; dec->callbacks.meta = NULL; - caml_register_generational_global_root(&dec->callbacks.callbacks); - // Accept vorbis comments FLAC__stream_decoder_set_metadata_respond(dec->decoder, FLAC__METADATA_TYPE_VORBIS_COMMENT); @@ -523,14 +463,15 @@ value ocaml_flac_decoder_alloc() { CAMLreturn(ans); } -CAMLprim value ocaml_flac_decoder_create(value callbacks) { - CAMLparam1(callbacks); - CAMLlocal1(ans); +CAMLprim value ocaml_flac_decoder_alloc_bytecode(value *argv, int argn) { + return ocaml_flac_decoder_alloc_native(argv[0], argv[1], argv[2], argv[3], + argv[4], argv[5], argv[6]); +} - ans = ocaml_flac_decoder_alloc(); - ocaml_flac_decoder *dec = Decoder_val(ans); +CAMLprim value ocaml_flac_decoder_init(value _dec) { + CAMLparam1(_dec); - caml_modify_generational_global_root(&dec->callbacks.callbacks, callbacks); + ocaml_flac_decoder *dec = Decoder_val(dec); // Intialize decoder caml_release_runtime_system(); @@ -538,41 +479,19 @@ CAMLprim value ocaml_flac_decoder_create(value callbacks) { dec->decoder, dec_read_callback, dec_seek_callback, dec_tell_callback, dec_length_callback, dec_eof_callback, dec_write_callback, dec_metadata_callback, dec_error_callback, (void *)&dec->callbacks); - caml_acquire_runtime_system(); - - caml_modify_generational_global_root(&dec->callbacks.callbacks, Val_none); - - CAMLreturn(ans); -} - -CAMLprim value ocaml_flac_decoder_init(value d, value c) { - CAMLparam2(d, c); - - ocaml_flac_decoder *dec = Decoder_val(d); - - caml_modify_generational_global_root(&dec->callbacks.callbacks, c); - - // Process metadata - caml_release_runtime_system(); FLAC__stream_decoder_process_until_end_of_metadata(dec->decoder); caml_acquire_runtime_system(); - caml_modify_generational_global_root(&dec->callbacks.callbacks, Val_none); - CAMLreturn(Val_unit); } -CAMLprim value ocaml_flac_decoder_state(value d, value c) { - CAMLparam2(d, c); +CAMLprim value ocaml_flac_decoder_state(value d) { + CAMLparam1(d); ocaml_flac_decoder *dec = Decoder_val(d); - caml_modify_generational_global_root(&dec->callbacks.callbacks, c); - int ret = FLAC__stream_decoder_get_state(dec->decoder); - caml_modify_generational_global_root(&dec->callbacks.callbacks, Val_none); - CAMLreturn(val_of_state(ret)); } @@ -621,84 +540,65 @@ CAMLprim value ocaml_flac_decoder_info(value d) { CAMLreturn(ret); } -CAMLprim value ocaml_flac_decoder_process(value d, value c) { - CAMLparam2(d, c); +CAMLprim value ocaml_flac_decoder_process(value d) { + CAMLparam1(d); ocaml_flac_decoder *dec = Decoder_val(d); - caml_modify_generational_global_root(&dec->callbacks.callbacks, c); - // Process one frame caml_release_runtime_system(); FLAC__stream_decoder_process_single(dec->decoder); caml_acquire_runtime_system(); - caml_modify_generational_global_root(&dec->callbacks.callbacks, Val_none); - CAMLreturn(Val_unit); } -CAMLprim value ocaml_flac_decoder_seek(value d, value c, value pos) { - CAMLparam3(d, c, pos); +CAMLprim value ocaml_flac_decoder_seek(value d, value pos) { + CAMLparam2(d, pos); FLAC__uint64 offset = Int64_val(pos); FLAC_API FLAC__bool ret; ocaml_flac_decoder *dec = Decoder_val(d); - caml_modify_generational_global_root(&dec->callbacks.callbacks, c); - - // Process one frame caml_release_runtime_system(); ret = FLAC__stream_decoder_seek_absolute(dec->decoder, offset); caml_acquire_runtime_system(); - caml_modify_generational_global_root(&dec->callbacks.callbacks, Val_none); - if (ret == true) CAMLreturn(Val_true); else CAMLreturn(Val_false); } -CAMLprim value ocaml_flac_decoder_reset(value d, value c) { - CAMLparam2(d, c); +CAMLprim value ocaml_flac_decoder_reset(value d) { + CAMLparam1(d); FLAC_API FLAC__bool ret; ocaml_flac_decoder *dec = Decoder_val(d); - caml_modify_generational_global_root(&dec->callbacks.callbacks, c); - - // Process one frame caml_release_runtime_system(); ret = FLAC__stream_decoder_reset(dec->decoder); caml_acquire_runtime_system(); - caml_modify_generational_global_root(&dec->callbacks.callbacks, Val_none); - if (ret == true) CAMLreturn(Val_true); else CAMLreturn(Val_false); } -CAMLprim value ocaml_flac_decoder_flush(value d, value c) { - CAMLparam2(d, c); +CAMLprim value ocaml_flac_decoder_flush(value d) { + CAMLparam1(d); FLAC_API FLAC__bool ret; ocaml_flac_decoder *dec = Decoder_val(d); - caml_modify_generational_global_root(&dec->callbacks.callbacks, c); - - // Process one frame caml_release_runtime_system(); ret = FLAC__stream_decoder_flush(dec->decoder); caml_acquire_runtime_system(); - caml_modify_generational_global_root(&dec->callbacks.callbacks, Val_none); - if (ret == true) CAMLreturn(Val_true); else @@ -707,6 +607,17 @@ CAMLprim value ocaml_flac_decoder_flush(value d, value c) { /* Encoder */ +CAMLprim value ocaml_flac_cleanup_encoder(value e) { + ocaml_flac_encoder *enc = Encoder_val(e); + + caml_remove_generational_global_root(&enc->callbacks.write_cb); + caml_remove_generational_global_root(&enc->callbacks.seek_cb); + caml_remove_generational_global_root(&enc->callbacks.tell_cb); + caml_remove_generational_global_root(&enc->callbacks.buffer); + + return Val_unit; +} + static void finalize_encoder(value e) { ocaml_flac_encoder *enc = Encoder_val(e); if (enc->encoder != NULL) @@ -718,7 +629,6 @@ static void finalize_encoder(value e) { if (enc->lines != NULL) free(enc->lines); - caml_remove_generational_global_root(&enc->callbacks); free(enc); } @@ -732,33 +642,26 @@ enc_write_callback(const FLAC__StreamEncoder *encoder, unsigned current_frame, void *client_data) { - value callbacks = *(value *)client_data; + int pos, len; + ocaml_flac_encoder_callbacks *callbacks = + (ocaml_flac_encoder_callbacks *)client_data; ocaml_flac_register_thread(); caml_acquire_runtime_system(); - value buf = caml_alloc_string(bytes); - caml_register_generational_global_root(&buf); - - memcpy(Bytes_val(buf), buffer, bytes); + pos = 0; + while (pos < bytes) { + len = bytes - pos; - value write_cb = Enc_write(callbacks); - caml_register_generational_global_root(&write_cb); + if (callbacks->buflen < len) + len = callbacks->buflen; - value res = caml_callback_exn(write_cb, buf); - caml_register_generational_global_root(&res); + memcpy(Bytes_val(callbacks->buffer), buffer, len); + caml_callback(callbacks->write_cb, callbacks->buffer); - if (Is_exception_result(res)) { - caml_remove_generational_global_root(&buf); - caml_remove_generational_global_root(&write_cb); - caml_remove_generational_global_root(&res); - caml_raise(Extract_exception(res)); + pos += len; } - caml_remove_generational_global_root(&buf); - caml_remove_generational_global_root(&write_cb); - caml_remove_generational_global_root(&res); - caml_release_runtime_system(); return FLAC__STREAM_ENCODER_WRITE_STATUS_OK; @@ -767,60 +670,55 @@ enc_write_callback(const FLAC__StreamEncoder *encoder, FLAC__StreamEncoderSeekStatus enc_seek_callback(const FLAC__StreamEncoder *encoder, FLAC__uint64 absolute_byte_offset, void *client_data) { - ocaml_flac_register_thread(); - caml_acquire_runtime_system(); - - value seek = Enc_seek(*(value *)client_data); + ocaml_flac_encoder_callbacks *callbacks = + (ocaml_flac_encoder_callbacks *)client_data; - if (seek != Val_none) { - caml_callback(Some_val(seek), caml_copy_int64(absolute_byte_offset)); - - caml_release_runtime_system(); - - return FLAC__STREAM_ENCODER_SEEK_STATUS_OK; - } + if (callbacks->seek_cb == Val_none) + return FLAC__STREAM_ENCODER_SEEK_STATUS_UNSUPPORTED; + ocaml_flac_register_thread(); + caml_acquire_runtime_system(); + caml_callback(callbacks->seek_cb, caml_copy_int64(absolute_byte_offset)); caml_release_runtime_system(); - return FLAC__STREAM_ENCODER_SEEK_STATUS_UNSUPPORTED; + return FLAC__STREAM_ENCODER_SEEK_STATUS_OK; } static FLAC__StreamEncoderTellStatus enc_tell_callback(const FLAC__StreamEncoder *decoder, FLAC__uint64 *absolute_byte_offset, void *client_data) { - ocaml_flac_register_thread(); - caml_acquire_runtime_system(); + ocaml_flac_encoder_callbacks *callbacks = + (ocaml_flac_encoder_callbacks *)client_data; - value tell = Enc_tell(*(value *)client_data); - - if (tell != Val_none) { - *absolute_byte_offset = - (FLAC__uint64)Int64_val(caml_callback(Some_val(tell), Val_unit)); - - caml_release_runtime_system(); - - return FLAC__STREAM_ENCODER_TELL_STATUS_OK; - } + if (callbacks->tell_cb == Val_none) + return FLAC__STREAM_ENCODER_TELL_STATUS_UNSUPPORTED; + ocaml_flac_register_thread(); + caml_acquire_runtime_system(); + *absolute_byte_offset = + (FLAC__uint64)Int64_val(caml_callback(callbacks->tell_cb, Val_unit)); caml_release_runtime_system(); - return FLAC__STREAM_ENCODER_TELL_STATUS_UNSUPPORTED; + return FLAC__STREAM_ENCODER_TELL_STATUS_OK; } -value ocaml_flac_encoder_vorbiscomment_entry_name_is_legal(value name) { +CAMLprim value +ocaml_flac_encoder_vorbiscomment_entry_name_is_legal(value name) { CAMLparam1(name); CAMLreturn(Val_bool( FLAC__format_vorbiscomment_entry_name_is_legal(String_val(name)))); } -value ocaml_flac_encoder_vorbiscomment_entry_value_is_legal(value _value) { +CAMLprim value +ocaml_flac_encoder_vorbiscomment_entry_value_is_legal(value _value) { CAMLparam1(_value); CAMLreturn(Val_bool(FLAC__format_vorbiscomment_entry_value_is_legal( (const FLAC__byte *)String_val(_value), caml_string_length(_value)))); } -value ocaml_flac_encoder_alloc(value comments, value params) { - CAMLparam2(comments, params); +CAMLprim value ocaml_flac_encoder_alloc(value comments, value seek, value tell, + value write, value params) { + CAMLparam5(comments, seek, tell, write, params); CAMLlocal1(ret); FLAC__StreamEncoder *enc = FLAC__stream_encoder_new(); @@ -834,6 +732,10 @@ value ocaml_flac_encoder_alloc(value comments, value params) { FLAC__stream_encoder_set_compression_level( enc, Int_val(Some_val(Field(params, 3)))); + if (Field(params, 4) != Val_none) + FLAC__stream_encoder_set_total_samples_estimate( + enc, Int64_val(Some_val(Field(params, 4)))); + ocaml_flac_encoder *caml_enc = malloc(sizeof(ocaml_flac_encoder)); if (caml_enc == NULL) { FLAC__stream_encoder_delete(enc); @@ -841,12 +743,23 @@ value ocaml_flac_encoder_alloc(value comments, value params) { } caml_enc->encoder = enc; - caml_enc->callbacks = Val_none; + + caml_enc->callbacks.seek_cb = Some_or_none(seek); + caml_register_generational_global_root(&caml_enc->callbacks.seek_cb); + + caml_enc->callbacks.tell_cb = Some_or_none(tell); + caml_register_generational_global_root(&caml_enc->callbacks.tell_cb); + + caml_enc->callbacks.write_cb = write; + caml_register_generational_global_root(&caml_enc->callbacks.write_cb); + + caml_enc->callbacks.buflen = 1024; + caml_enc->callbacks.buffer = caml_alloc_string(caml_enc->callbacks.buflen); + caml_register_generational_global_root(&caml_enc->callbacks.buffer); + caml_enc->buf = NULL; caml_enc->lines = NULL; - caml_register_generational_global_root(&caml_enc->callbacks); - // Fill custom value ret = caml_alloc_custom(&encoder_ops, sizeof(ocaml_flac_encoder *), 1, 0); Encoder_val(ret) = caml_enc; @@ -854,10 +767,13 @@ value ocaml_flac_encoder_alloc(value comments, value params) { /* Metadata */ caml_enc->meta = FLAC__metadata_object_new(FLAC__METADATA_TYPE_VORBIS_COMMENT); + if (caml_enc->meta == NULL) { + FLAC__stream_encoder_delete(enc); caml_raise_out_of_memory(); } FLAC__StreamMetadata_VorbisComment_Entry entry; + /* Vendor string is ignored by libFLAC.. */ int i; for (i = 0; i < Wosize_val(comments); i++) { @@ -871,22 +787,13 @@ value ocaml_flac_encoder_alloc(value comments, value params) { } FLAC__stream_encoder_set_metadata(enc, &caml_enc->meta, 1); - if (Field(params, 4) != Val_none) - FLAC__stream_encoder_set_total_samples_estimate( - enc, Int64_val(Some_val(Field(params, 4)))); - CAMLreturn(ret); } -CAMLprim value ocaml_flac_encoder_create(value comments, value params, - value callbacks) { - CAMLparam3(comments, params, callbacks); - CAMLlocal1(ret); +CAMLprim value ocaml_flac_encoder_init(value _enc) { + CAMLparam1(_enc); - ret = ocaml_flac_encoder_alloc(comments, params); - ocaml_flac_encoder *enc = Encoder_val(ret); - - caml_modify_generational_global_root(&enc->callbacks, callbacks); + ocaml_flac_encoder *enc = Encoder_val(_enc); caml_release_runtime_system(); FLAC__stream_encoder_init_stream(enc->encoder, enc_write_callback, @@ -894,9 +801,7 @@ CAMLprim value ocaml_flac_encoder_create(value comments, value params, (void *)&enc->callbacks); caml_acquire_runtime_system(); - caml_modify_generational_global_root(&enc->callbacks, Val_none); - - CAMLreturn(ret); + CAMLreturn(Val_unit); } static inline FLAC__int32 sample_from_double(double x, unsigned bps) { @@ -918,9 +823,8 @@ static inline FLAC__int32 sample_from_double(double x, unsigned bps) { } } -CAMLprim value ocaml_flac_encoder_process(value _enc, value cb, value data, - value bps) { - CAMLparam3(_enc, data, cb); +CAMLprim value ocaml_flac_encoder_process(value _enc, value data, value bps) { + CAMLparam2(_enc, data); ocaml_flac_encoder *enc = Encoder_val(_enc); @@ -949,30 +853,22 @@ CAMLprim value ocaml_flac_encoder_process(value _enc, value cb, value data, sample_from_double(Double_field(Field(data, c), i), Int_val(bps)); } - caml_modify_generational_global_root(&enc->callbacks, cb); - caml_release_runtime_system(); FLAC__stream_encoder_process(enc->encoder, (const FLAC__int32 *const *)enc->buf, samples); caml_acquire_runtime_system(); - caml_modify_generational_global_root(&enc->callbacks, Val_none); - CAMLreturn(Val_unit); } -CAMLprim value ocaml_flac_encoder_finish(value _enc, value c) { - CAMLparam2(_enc, c); +CAMLprim value ocaml_flac_encoder_finish(value _enc) { + CAMLparam1(_enc); ocaml_flac_encoder *enc = Encoder_val(_enc); - caml_modify_generational_global_root(&enc->callbacks, c); - caml_release_runtime_system(); FLAC__stream_encoder_finish(enc->encoder); caml_acquire_runtime_system(); - caml_modify_generational_global_root(&enc->callbacks, Val_none); - CAMLreturn(Val_unit); } diff --git a/src/flac_stubs.h b/src/flac_stubs.h index 44eba5d..d8c288b 100644 --- a/src/flac_stubs.h +++ b/src/flac_stubs.h @@ -34,7 +34,14 @@ value flac_Val_some(value v); typedef struct ocaml_flac_decoder_callbacks { /* This is used for callback from caml. */ - value callbacks; + value read_cb; + value seek_cb; + value tell_cb; + value length_cb; + value eof_cb; + value write_cb; + value buffer; + int buflen; FLAC__StreamMetadata_StreamInfo *info; FLAC__StreamMetadata *meta; } ocaml_flac_decoder_callbacks; @@ -44,13 +51,6 @@ typedef struct ocaml_flac_decoder { ocaml_flac_decoder_callbacks callbacks; } ocaml_flac_decoder; -#define Dec_read(v) Field(v, 0) -#define Dec_seek(v) Field(v, 1) -#define Dec_tell(v) Field(v, 2) -#define Dec_length(v) Field(v, 3) -#define Dec_eof(v) Field(v, 4) -#define Dec_write(v) Field(v, 5) - /* Caml abstract value containing the decoder. */ #define Decoder_val(v) (*((ocaml_flac_decoder **)Data_custom_val(v))) @@ -68,22 +68,27 @@ void dec_error_callback(const FLAC__StreamDecoder *decoder, /* Encoder */ +typedef struct ocaml_flac_encoder_callbacks { + value write_cb; + value seek_cb; + value tell_cb; + value buffer; + int buflen; +} ocaml_flac_encoder_callbacks; + typedef struct ocaml_flac_encoder { FLAC__StreamEncoder *encoder; FLAC__StreamMetadata *meta; FLAC__int32 **buf; FLAC__int32 *lines; - value callbacks; + ocaml_flac_encoder_callbacks callbacks; } ocaml_flac_encoder; /* Caml abstract value containing the decoder. */ #define Encoder_val(v) (*((ocaml_flac_encoder **)Data_custom_val(v))) -#define Enc_write(v) Field(v, 0) -#define Enc_seek(v) Field(v, 1) -#define Enc_tell(v) Field(v, 2) - -value ocaml_flac_encoder_alloc(value comments, value params); +value ocaml_flac_encoder_alloc(value comments, value seek, value tell, + value write, value params); FLAC__StreamEncoderWriteStatus enc_write_callback(const FLAC__StreamEncoder *encoder,