diff --git a/CHANGES b/CHANGES index 0c4de38..a694e8c 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,9 @@ +0.5.0 (unreleased) +===== +* Cleanup API, get rid of global roots, + make ogg encoder and decoder implementation + use the main flac module implementation. + 0.4.0 (2023-05-09) ===== * Move global roots removal out of custom blocks diff --git a/dune-project b/dune-project index adc15b6..60dad88 100644 --- a/dune-project +++ b/dune-project @@ -1,5 +1,5 @@ (lang dune 2.8) -(version 0.4.0) +(version 0.5.0) (name flac) (source (github savonet/ocaml-flac)) (license GPL-2.0) diff --git a/examples/decode.ml b/examples/decode.ml index 266f1ff..bb3f796 100644 --- a/examples/decode.ml +++ b/examples/decode.ml @@ -88,7 +88,7 @@ let process () = Printf.printf "Testing stream %nx\n" serial; let os = Ogg.Stream.create ~serial () in Ogg.Stream.put_page os page; - let packet = Ogg.Stream.get_packet os in + let packet = Ogg.Stream.peek_packet os in (* Test header. Do not catch anything, first page should be sufficient *) if not (Flac_ogg.Decoder.check_packet packet) then raise Not_found; Printf.printf "Got a flac stream !\n"; @@ -96,8 +96,8 @@ 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 write in - let dec = Flac_ogg.Decoder.create packet os 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 -> @@ -113,7 +113,7 @@ let process () = try fill (); process () - with Ogg.Not_enough_data -> `End_of_stream) + with Ogg.End_of_stream | Ogg.Not_enough_data -> `End_of_stream) in (process, info, meta) in diff --git a/examples/dune b/examples/dune index 0dcba5b..7d0978a 100644 --- a/examples/dune +++ b/examples/dune @@ -33,4 +33,6 @@ (action (progn (run ./encode.exe ./src.wav ./src.flac) - (run ./decode.exe -i ./src.flac -o ./dst.wav)))) + (run ./decode.exe -i ./src.flac -o ./dst.wav) + (run ./encode.exe --ogg true ./src.wav ./dst.ogg) + (run ./decode.exe -ogg true -i ./dst.ogg -o ./ogg-dst.wav)))) diff --git a/flac.opam b/flac.opam index 1a86436..ef62400 100644 --- a/flac.opam +++ b/flac.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.4.0" +version: "0.5.0" synopsis: "Bindings to libflac" maintainer: ["The Savonet Team "] authors: ["The Savonet Team "] diff --git a/src/dune b/src/dune index 266e601..3bfe339 100644 --- a/src/dune +++ b/src/dune @@ -2,7 +2,7 @@ (name flac) (public_name flac) (synopsis "OCaml bindings for libflac") - (modules flac) + (modules flac flac_impl) (libraries unix) (foreign_stubs (language c) diff --git a/src/flac.ml b/src/flac.ml index 9854b1f..9ed32f5 100644 --- a/src/flac.ml +++ b/src/flac.ml @@ -1,271 +1 @@ -(* - * 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 : generic callbacks = - { 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 : generic callbacks = - { 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 +include Flac_impl diff --git a/src/flac.mli b/src/flac.mli index 46f3956..bc6519b 100644 --- a/src/flac.mli +++ b/src/flac.mli @@ -82,7 +82,7 @@ module Decoder : sig type read = bytes -> int -> int -> int (** Type of a collection of callbacks. *) - type 'a callbacks + type 'a callbacks = 'a Flac_impl.Decoder.callbacks (** Generic variant type for callbacks and decoder. *) type generic @@ -285,7 +285,7 @@ module Encoder : sig type write = bytes -> unit (** Type of a set of callbacks *) - type 'a callbacks + type 'a callbacks = 'a Flac_impl.Encoder.callbacks (** Generic type for an encoder *) type generic diff --git a/src/flac_decoder.ml b/src/flac_decoder.ml index 6ce01d0..44e15b5 100644 --- a/src/flac_decoder.ml +++ b/src/flac_decoder.ml @@ -22,30 +22,21 @@ let check = Flac_ogg.Decoder.check_packet let decoder os = let ogg_dec = ref None in - let packet = ref None in let decoder = ref None in let os = ref os in - let dummy_c = Flac_ogg.Decoder.get_callbacks (fun _ -> ()) in + let callbacks = Flac_ogg.Decoder.get_callbacks !os (fun _ -> ()) in let init () = match !decoder with | None -> - let packet = - match !packet with - | None -> - let p = Ogg.Stream.get_packet !os in - packet := Some p; - p - | Some p -> p - in let ogg_dec = match !ogg_dec with | None -> - let dec = Flac_ogg.Decoder.create packet !os in + let dec = Flac.Decoder.create callbacks in ogg_dec := Some dec; dec | Some dec -> dec in - let dec, info, m = Flac.Decoder.init ogg_dec dummy_c in + let dec, info, m = Flac.Decoder.init ogg_dec callbacks in let meta = match m with None -> ("Unknown vendor", []) | Some x -> x in @@ -63,7 +54,7 @@ let decoder os = in let decode feed = let decoder, _, _ = init () in - let c = Flac_ogg.Decoder.get_callbacks (fun ret -> feed ret) in + let c = Flac_ogg.Decoder.get_callbacks !os (fun ret -> feed ret) in match Flac.Decoder.state decoder c with | `Search_for_metadata | `Read_metadata | `Search_for_frame_sync | `Read_frame -> @@ -74,9 +65,8 @@ let decoder os = let restart new_os = os := new_os; let d, _, _ = init () in - Flac_ogg.Decoder.update_ogg_stream d new_os; (* Flush error are very unlikely. *) - let c = Flac_ogg.Decoder.get_callbacks (fun _ -> ()) in + let c = Flac_ogg.Decoder.get_callbacks new_os (fun _ -> ()) in assert (Flac.Decoder.flush d c) in Ogg_decoder.Audio diff --git a/src/flac_impl.ml b/src/flac_impl.ml new file mode 100644 index 0000000..954a6d9 --- /dev/null +++ b/src/flac_impl.ml @@ -0,0 +1,270 @@ +(* + * 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 d7c5065..155eeca 100644 --- a/src/flac_ogg.ml +++ b/src/flac_ogg.ml @@ -23,26 +23,42 @@ module Decoder = struct type ogg - let get_callbacks write : ogg Flac.Decoder.callbacks = - Obj.magic (Flac.Decoder.get_callbacks (fun _ -> raise Flac.Internal) write) + 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 read_data = Buffer.create 1024 in + let is_first_packet = ref true in + let read bytes ofs len = + try + if Buffer.length read_data = 0 then ( + let p = Ogg.Stream.get_packet os in + let data = get_packet_data p in + let data = + if !is_first_packet then ( + let len = String.length data in + assert (len > ogg_header_len); + String.sub data ogg_header_len (len - ogg_header_len)) + else data + in + is_first_packet := false; + Buffer.add_string read_data data); + let c = Buffer.contents read_data in + let c_len = String.length c in + let len = min len c_len in + let rem = String.sub c len (c_len - len) in + Buffer.reset read_data; + Buffer.add_string read_data rem; + Bytes.blit_string c 0 bytes ofs len; + len + with Ogg.End_of_stream -> 0 + in + Flac__Flac_impl.Decoder.get_callbacks read write external check_packet : Ogg.Stream.packet -> bool = "ocaml_flac_decoder_check_ogg" - - external finalize_decoder_private_values : ogg Flac.Decoder.dec -> unit - = "ocaml_flac_finalize_ogg_decoder_private_values" - - external create : - Ogg.Stream.packet -> Ogg.Stream.stream -> ogg Flac.Decoder.dec - = "ocaml_flac_decoder_ogg_create" - - let create p os = - let dec = create p os in - Gc.finalise finalize_decoder_private_values dec; - dec - - external update_ogg_stream : ogg Flac.Decoder.t -> Ogg.Stream.stream -> unit - = "ocaml_flac_decoder_ogg_update_os" end module Encoder = struct @@ -55,34 +71,34 @@ module Encoder = struct first_pages : Ogg.Page.t list; } - external finalize_encoder_private_values : enc -> unit - = "ocaml_flac_finalize_ogg_encoder_private_values" - external create : (string * string) array -> Flac.Encoder.params -> - (Ogg.Page.t -> unit) -> + (bytes -> unit) * 'a -> nativeint -> enc = "ocaml_flac_encoder_ogg_create" - external set_write_cb : enc -> (Ogg.Page.t -> unit) -> unit - = "ocaml_flac_encoder_ogg_set_write_cb" - - let create ?(comments = []) ~serialno params write_cb = + let create ?(comments = []) ~serialno params write = if params.Flac.Encoder.channels <= 0 then raise Flac.Encoder.Invalid_data; let comments = Array.of_list comments in - let first_pages = Atomic.make [] in - let write_first_page p = - Atomic.set first_pages (p :: Atomic.get first_pages) + let first_pages = ref [] in + let header = ref None in + let write_wrap write p = + match !header with + | Some h -> + header := None; + 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) in - let enc = create comments params write_first_page serialno in - Gc.finalise finalize_encoder_private_values enc; - set_write_cb enc write_cb; + let enc = create comments params (write_first_page, None) serialno in + assert (!header = None); { encoder = Obj.magic (enc, params); - callbacks = - Obj.magic (Flac.Encoder.get_callbacks (fun _ -> raise Flac.Internal)); - first_pages = List.rev (Atomic.get first_pages); + callbacks = Flac__Flac_impl.Encoder.get_callbacks (write_wrap write); + first_pages = List.rev !first_pages; } end diff --git a/src/flac_ogg.mli b/src/flac_ogg.mli index 51eb82e..9e61246 100644 --- a/src/flac_ogg.mli +++ b/src/flac_ogg.mli @@ -54,14 +54,8 @@ module Decoder : sig val check_packet : Ogg.Stream.packet -> bool (** Create a set of callbacks to decode an ogg/flac stream *) - val get_callbacks : Flac.Decoder.write -> ogg Flac.Decoder.callbacks - - (** Create an ogg/flac decoder *) - val create : Ogg.Stream.packet -> Ogg.Stream.stream -> ogg Flac.Decoder.dec - - (** Update the [Ogg.Stream.stream] associated - * to the decoder. *) - val update_ogg_stream : ogg Flac.Decoder.t -> Ogg.Stream.stream -> unit + val get_callbacks : + Ogg.Stream.stream -> Flac.Decoder.write -> ogg Flac.Decoder.callbacks end (** Encode ogg/flac data *) diff --git a/src/flac_ogg_stubs.c b/src/flac_ogg_stubs.c index ac69e47..02b2233 100644 --- a/src/flac_ogg_stubs.c +++ b/src/flac_ogg_stubs.c @@ -34,40 +34,6 @@ #include "flac_stubs.h" -typedef struct ocaml_flac_ogg_private { - /* This is used by the decoder. */ - unsigned char *data; - long bytes; - long offset; - value os; - /* This is used by the encoder. */ - ogg_page current_page; - value write_cb; -} ocaml_flac_ogg_private; - -void finalize_private_values(ocaml_flac_ogg_private *p) { - if (p->data != NULL) - free(p->data); - - if (p->current_page.header != NULL) - free(p->current_page.header); - - caml_remove_generational_global_root(&p->os); - caml_remove_generational_global_root(&p->write_cb); -} - -CAMLprim value ocaml_flac_finalize_ogg_decoder_private_values(value e) { - CAMLparam1(e); - ocaml_flac_decoder *dec = Decoder_val(e); - finalize_private_values(dec->callbacks.private); - CAMLreturn(Val_unit); -} - -static struct custom_operations ogg_decoder_ops = { - "ocaml_flac_ogg_decoder", finalize_decoder, - custom_compare_default, custom_hash_default, - custom_serialize_default, custom_deserialize_default}; - /* C.f. http://flac.sourceforge.net/ogg_mapping.html */ CAMLprim value ocaml_flac_decoder_check_ogg(value v) { CAMLparam1(v); @@ -81,235 +47,39 @@ CAMLprim value ocaml_flac_decoder_check_ogg(value v) { CAMLreturn(Val_true); } -/* libFLAC is monothread so this - * is run within the main C thread. - * - * Ogg/flac mapping says: - * "each packet corresponds to one FLAC audio frame." - * and we decode frame by frame, so we only need to push one packet at a - * time here. */ -static FLAC__StreamDecoderReadStatus -ogg_read_callback(const FLAC__StreamDecoder *decoder, FLAC__byte buffer[], - size_t *bytes, void *client_data) { - ocaml_flac_decoder_callbacks *callbacks = - (ocaml_flac_decoder_callbacks *)client_data; - - ocaml_flac_ogg_private *h = (ocaml_flac_ogg_private *)callbacks->private; - - caml_acquire_runtime_system(); - - int is_fresh; - long offset; - long data_bytes; - unsigned char *data; - - if (h->data == NULL) { - /* Grap a new ogg_packet */ - ogg_packet op; - - ogg_stream_state *os = Stream_state_val(h->os); - int ret = ogg_stream_packetout(os, &op); - if (ret == 0) - caml_raise_constant(*caml_named_value("ogg_exn_not_enough_data")); - if (ret == -1) - caml_raise_constant(*caml_named_value("ogg_exn_out_of_sync")); - - data = op.packet; - data_bytes = op.bytes; - offset = 0; - is_fresh = 1; - } else { - data = h->data; - data_bytes = h->bytes; - offset = h->offset; - is_fresh = 0; - } - - long len; - /* len is either *bytes or data_bytes-offset. */ - if (data_bytes - offset > *bytes) - len = *bytes; - else - len = data_bytes - offset; - - memcpy(buffer, data + offset, len); - - /* Here we wrote all the data we had, which was less than the required - * amount. */ - if (len == data_bytes - offset) { - if (is_fresh == 0) { - free(h->data); - h->data = NULL; - h->bytes = 0; - h->offset = 0; - } - /* Here, we have some data left so we save it for later.. */ - } else { - if (is_fresh == 1) { - long rem = data_bytes - offset - len; - h->data = malloc(rem); - if (h->data == NULL) - caml_raise_out_of_memory(); - - memcpy(h->data, data + offset + len, rem); - h->bytes = rem; - h->offset = 0; - } else - h->offset = offset + len; - } - - caml_release_runtime_system(); - - *bytes = len; - if (len == 0) - return FLAC__STREAM_DECODER_READ_STATUS_END_OF_STREAM; - else - return FLAC__STREAM_DECODER_READ_STATUS_CONTINUE; -} - -CAMLprim value ocaml_flac_decoder_ogg_update_os(value v, value os) { - CAMLparam2(v, os); - ocaml_flac_decoder *dec = Decoder_val(v); - ocaml_flac_ogg_private *priv = dec->callbacks.private; - caml_modify_generational_global_root(&priv->os, os); - CAMLreturn(Val_unit); -} - -CAMLprim value ocaml_flac_decoder_ogg_create(value v, value os) { - CAMLparam2(v, os); +CAMLprim value ocaml_flac_decoder_packet_data(value v) { + CAMLparam1(v); CAMLlocal1(ans); ogg_packet *p = Packet_val(v); - ans = ocaml_flac_decoder_alloc(&ogg_decoder_ops); - ocaml_flac_decoder *dec = Decoder_val(ans); - - ocaml_flac_ogg_private *priv = malloc(sizeof(ocaml_flac_ogg_private)); - if (priv == NULL) - caml_raise_out_of_memory(); - - priv->data = malloc(p->bytes); - if (priv->data == NULL) - caml_raise_out_of_memory(); - memcpy(priv->data, p->packet, p->bytes); - priv->bytes = p->bytes; - priv->offset = 9; - priv->os = os; - caml_register_generational_global_root(&priv->os); - priv->write_cb = Val_none; - caml_register_generational_global_root(&priv->write_cb); - - dec->callbacks.private = (void *)priv; - - // Intialize decoder - caml_release_runtime_system(); - FLAC__stream_decoder_init_stream(dec->decoder, ogg_read_callback, NULL, NULL, - NULL, NULL, dec_write_callback, - dec_metadata_callback, dec_error_callback, - (void *)&dec->callbacks); - caml_acquire_runtime_system(); - + ans = caml_alloc_string(p->bytes); + memcpy((char *)String_val(ans), p->packet, p->bytes); CAMLreturn(ans); } /* Encoder */ -CAMLprim value ocaml_flac_finalize_ogg_encoder_private_values(value e) { - CAMLparam1(e); - ocaml_flac_encoder *enc = Encoder_val(e); - finalize_private_values(enc->callbacks.private); - CAMLreturn(Val_unit); -} - -static struct custom_operations ogg_encoder_ops = { - "ocaml_flac_ogg_encoder", finalize_encoder, - custom_compare_default, custom_hash_default, - custom_serialize_default, custom_deserialize_default}; - -FLAC__StreamEncoderWriteStatus ogg_enc_write_callback( - const FLAC__StreamEncoder *encoder, const FLAC__byte buffer[], size_t bytes, - unsigned samples, unsigned current_frame, void *client_data) - -{ - ocaml_flac_encoder_callbacks *callbacks = - (ocaml_flac_encoder_callbacks *)client_data; - ocaml_flac_ogg_private *h = (ocaml_flac_ogg_private *)callbacks->private; - - if (!h->current_page.header) { - h->current_page.header = malloc(bytes); - if (!h->current_page.header) - caml_raise_out_of_memory(); - - memcpy(h->current_page.header, buffer, bytes); - h->current_page.header_len = bytes; - } else { - if (!h->current_page.header) - return FLAC__STREAM_ENCODER_WRITE_STATUS_FATAL_ERROR; - - h->current_page.body = (unsigned char *)buffer; - h->current_page.body_len = bytes; - - ocaml_flac_register_thread(); - caml_acquire_runtime_system(); - - value page = value_of_page(&h->current_page); - - free(h->current_page.header); - h->current_page.header = NULL; - - caml_register_generational_global_root(&page); - - value ret = caml_callback_exn(h->write_cb, page); - - caml_remove_generational_global_root(&page); - - if (Is_exception_result(ret)) { - caml_release_runtime_system(); - return FLAC__STREAM_ENCODER_WRITE_STATUS_FATAL_ERROR; - } - - caml_release_runtime_system(); - } - - return FLAC__STREAM_ENCODER_WRITE_STATUS_OK; -} - CAMLprim value ocaml_flac_encoder_ogg_create(value comments, value params, - value write_cb, value _serialno) { - CAMLparam4(comments, params, write_cb, _serialno); + value _enc_cb, value _serialno) { + CAMLparam4(comments, params, _enc_cb, _serialno); CAMLlocal2(tmp, ret); intnat serialno = Nativeint_val(_serialno); - ret = ocaml_flac_encoder_alloc(comments, params, &ogg_encoder_ops); - ocaml_flac_encoder *caml_enc = Encoder_val(ret); - - ocaml_flac_ogg_private *priv = malloc(sizeof(ocaml_flac_ogg_private)); - if (priv == NULL) - caml_raise_out_of_memory(); - priv->data = NULL; - priv->os = Val_none; - caml_register_generational_global_root(&priv->os); - priv->write_cb = write_cb; - caml_register_generational_global_root(&priv->write_cb); - memset(&priv->current_page, 0, sizeof(priv->current_page)); + ret = ocaml_flac_encoder_alloc(comments, params); + ocaml_flac_encoder *enc = Encoder_val(ret); - caml_enc->callbacks.private = priv; + Fill_enc_values(enc, _enc_cb); caml_release_runtime_system(); - FLAC__stream_encoder_init_ogg_stream(caml_enc->encoder, NULL, - ogg_enc_write_callback, NULL, NULL, NULL, - (void *)&caml_enc->callbacks); - FLAC__stream_encoder_set_ogg_serial_number(caml_enc->encoder, serialno); + FLAC__stream_encoder_set_ogg_serial_number(enc->encoder, serialno); + FLAC__stream_encoder_init_ogg_stream(enc->encoder, NULL, enc_write_callback, + NULL, NULL, NULL, + (void *)&enc->callbacks); caml_acquire_runtime_system(); - CAMLreturn(ret); -} + Free_enc_values(enc); -value CAMLprim ocaml_flac_encoder_ogg_set_write_cb(value _enc, value write_cb) { - CAMLparam2(_enc, write_cb); - ocaml_flac_encoder *enc = Encoder_val(_enc); - ocaml_flac_ogg_private *h = (ocaml_flac_ogg_private *)enc->callbacks.private; - caml_modify_generational_global_root(&h->write_cb, write_cb); - CAMLreturn(Val_unit); + CAMLreturn(ret); } /* Ogg skeleton interface */ diff --git a/src/flac_stubs.c b/src/flac_stubs.c index 3793ab1..5d13166 100644 --- a/src/flac_stubs.c +++ b/src/flac_stubs.c @@ -185,7 +185,7 @@ 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))) -void finalize_decoder(value e) { +static void finalize_decoder(value e) { ocaml_flac_decoder *dec = Decoder_val(e); FLAC__stream_decoder_delete(dec->decoder); if (dec->callbacks.info != NULL) @@ -342,9 +342,9 @@ static FLAC__bool dec_eof_callback(const FLAC__StreamDecoder *decoder, return false; } -static FLAC__StreamDecoderReadStatus -dec_read_callback(const FLAC__StreamDecoder *decoder, FLAC__byte buffer[], - size_t *bytes, void *client_data) { +FLAC__StreamDecoderReadStatus static dec_read_callback( + const FLAC__StreamDecoder *decoder, FLAC__byte buffer[], size_t *bytes, + void *client_data) { ocaml_flac_decoder_callbacks *callbacks = (ocaml_flac_decoder_callbacks *)client_data; @@ -420,7 +420,7 @@ dec_write_callback(const FLAC__StreamDecoder *decoder, const FLAC__Frame *frame, return FLAC__STREAM_DECODER_WRITE_STATUS_CONTINUE; } -value ocaml_flac_decoder_alloc(struct custom_operations *decoder_ops) { +value ocaml_flac_decoder_alloc() { CAMLparam0(); CAMLlocal1(ans); @@ -436,7 +436,6 @@ value ocaml_flac_decoder_alloc(struct custom_operations *decoder_ops) { dec->callbacks.length = Val_none; dec->callbacks.eof = Val_none; dec->callbacks.write = Val_none; - dec->callbacks.private = NULL; dec->callbacks.info = NULL; dec->callbacks.meta = NULL; @@ -445,7 +444,7 @@ value ocaml_flac_decoder_alloc(struct custom_operations *decoder_ops) { FLAC__METADATA_TYPE_VORBIS_COMMENT); // Fill custom value - ans = caml_alloc_custom(decoder_ops, sizeof(ocaml_flac_decoder *), 1, 0); + ans = caml_alloc_custom(&decoder_ops, sizeof(ocaml_flac_decoder *), 1, 0); Decoder_val(ans) = dec; CAMLreturn(ans); @@ -455,7 +454,7 @@ CAMLprim value ocaml_flac_decoder_create(value callbacks) { CAMLparam1(callbacks); CAMLlocal1(ans); - ans = ocaml_flac_decoder_alloc(&decoder_ops); + ans = ocaml_flac_decoder_alloc(); ocaml_flac_decoder *dec = Decoder_val(ans); Fill_dec_values(dec, callbacks); @@ -621,7 +620,7 @@ CAMLprim value ocaml_flac_decoder_flush(value d, value c) { /* Encoder */ -void finalize_encoder(value e) { +static void finalize_encoder(value e) { ocaml_flac_encoder *enc = Encoder_val(e); if (enc->encoder != NULL) FLAC__stream_encoder_delete(enc->encoder); @@ -725,8 +724,7 @@ value ocaml_flac_encoder_vorbiscomment_entry_value_is_legal(value _value) { (const FLAC__byte *)String_val(_value), caml_string_length(_value)))); } -value ocaml_flac_encoder_alloc(value comments, value params, - struct custom_operations *encoder_ops) { +value ocaml_flac_encoder_alloc(value comments, value params) { CAMLparam2(comments, params); CAMLlocal1(ret); @@ -748,7 +746,6 @@ value ocaml_flac_encoder_alloc(value comments, value params, } caml_enc->encoder = enc; - caml_enc->callbacks.private = NULL; caml_enc->callbacks.write = Val_none; caml_enc->callbacks.seek = Val_none; caml_enc->callbacks.tell = Val_none; @@ -756,7 +753,7 @@ value ocaml_flac_encoder_alloc(value comments, value params, caml_enc->lines = NULL; // Fill custom value - ret = caml_alloc_custom(encoder_ops, sizeof(ocaml_flac_encoder *), 1, 0); + ret = caml_alloc_custom(&encoder_ops, sizeof(ocaml_flac_encoder *), 1, 0); Encoder_val(ret) = caml_enc; /* Metadata */ @@ -791,7 +788,7 @@ CAMLprim value ocaml_flac_encoder_create(value comments, value params, CAMLparam3(comments, params, callbacks); CAMLlocal1(ret); - ret = ocaml_flac_encoder_alloc(comments, params, &encoder_ops); + ret = ocaml_flac_encoder_alloc(comments, params); ocaml_flac_encoder *enc = Encoder_val(ret); Fill_enc_values(enc, callbacks); diff --git a/src/flac_stubs.h b/src/flac_stubs.h index 8dcda9e..89bb2e2 100644 --- a/src/flac_stubs.h +++ b/src/flac_stubs.h @@ -33,8 +33,6 @@ value flac_Val_some(value v); /* Decoder */ typedef struct ocaml_flac_decoder_callbacks { - /* This is used for ogg callbacks. */ - void *private; /* This is used for callback from caml. */ value read; value seek; @@ -79,10 +77,6 @@ typedef struct ocaml_flac_decoder { x->callbacks.write = Val_none; \ } -value ocaml_flac_decoder_alloc(struct custom_operations *decoder_ops); - -void finalize_decoder(value dec); - /* Caml abstract value containing the decoder. */ #define Decoder_val(v) (*((ocaml_flac_decoder **)Data_custom_val(v))) @@ -105,8 +99,6 @@ typedef struct ocaml_flac_encoder_callbacks { value write; value seek; value tell; - /* This is used by the ogg encoder. */ - void *private; } ocaml_flac_encoder_callbacks; typedef struct ocaml_flac_encoder { @@ -138,10 +130,12 @@ typedef struct ocaml_flac_encoder { /* Caml abstract value containing the decoder. */ #define Encoder_val(v) (*((ocaml_flac_encoder **)Data_custom_val(v))) -value ocaml_flac_encoder_alloc(value comments, value params, - struct custom_operations *encoder_ops); +value ocaml_flac_encoder_alloc(value comments, value params); -void finalize_encoder(value dec); +FLAC__StreamEncoderWriteStatus +enc_write_callback(const FLAC__StreamEncoder *encoder, + const FLAC__byte buffer[], size_t bytes, unsigned samples, + unsigned current_frame, void *client_data); /* Threads management */ void ocaml_flac_register_thread();