This was a bit harder than sh, but still a lot of copy-and-paste. Signed-off-by: Eric Blake <eblake@redhat.com> --- Note: I'm not sure how to actually test this beyond compilation. --- plugins/ocaml/ocaml.c | 51 ++++++++++++++++++++++++++++++++++++++++ plugins/ocaml/NBDKit.ml | 16 ++++++++++++- plugins/ocaml/NBDKit.mli | 5 ++++ 3 files changed, 71 insertions(+), 1 deletion(-) diff --git a/plugins/ocaml/ocaml.c b/plugins/ocaml/ocaml.c index 4447d7f..f664a7f 100644 --- a/plugins/ocaml/ocaml.c +++ b/plugins/ocaml/ocaml.c @@ -128,6 +128,9 @@ static value can_multi_conn_fn; static value can_extents_fn; static value extents_fn; +static value can_cache_fn; +static value cache_fn; + /*----------------------------------------------------------------------*/ /* Wrapper functions that translate calls from C (ie. nbdkit) to OCaml. */ @@ -638,6 +641,48 @@ extents_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags, CAMLreturnT (int, 0); } +static int +can_cache_wrapper (void *h) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + + caml_leave_blocking_section (); + + rv = caml_callback_exn (can_cache_fn, *(value *) h); + if (Is_exception_result (rv)) { + nbdkit_error ("%s", caml_format_exception (Extract_exception (rv))); + caml_enter_blocking_section (); + CAMLreturnT (int, -1); + } + + caml_enter_blocking_section (); + CAMLreturnT (int, Int_val (rv)); +} + +static int +cache_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags) +{ + CAMLparam0 (); + CAMLlocal4 (rv, countv, offsetv, flagsv); + + caml_leave_blocking_section (); + + countv = caml_copy_int32 (count); + offsetv = caml_copy_int32 (offset); + flagsv = Val_flags (flags); + + value args[] = { *(value *) h, countv, offsetv, flagsv }; + rv = caml_callbackN_exn (cache_fn, sizeof args / sizeof args[0], args); + if (Is_exception_result (rv)) { + nbdkit_error ("%s", caml_format_exception (Extract_exception (rv))); + CAMLreturnT (int, -1); + } + + caml_enter_blocking_section (); + CAMLreturnT (int, 0); +} + /*----------------------------------------------------------------------*/ /* set_* functions called from OCaml code at load time to initialize * fields in the plugin struct. @@ -727,6 +772,9 @@ SET(can_multi_conn) SET(can_extents) SET(extents) +SET(can_cache) +SET(cache) + #undef SET static void @@ -766,6 +814,9 @@ remove_roots (void) REMOVE (can_extents); REMOVE (extents); + REMOVE (can_cache); + REMOVE (cache); + #undef REMOVE } diff --git a/plugins/ocaml/NBDKit.ml b/plugins/ocaml/NBDKit.ml index 7aca8c8..02aa200 100644 --- a/plugins/ocaml/NBDKit.ml +++ b/plugins/ocaml/NBDKit.ml @@ -37,6 +37,8 @@ and flag = May_trim | FUA | Req_one type fua_flag = FuaNone | FuaEmulate | FuaNative +type cache_flag = CacheNone | CacheEmulate | CacheNop + type extent = { offset : int64; length : int64; @@ -82,6 +84,9 @@ type 'a plugin = { can_extents : ('a -> bool) option; extents : ('a -> int32 -> int64 -> flags -> extent list) option; + + can_cache : ('a -> cache_flag) option; + cache : ('a -> int32 -> int64 -> flags -> unit) option; } let default_callbacks = { @@ -122,6 +127,9 @@ let default_callbacks = { can_extents = None; extents = None; + + can_cache = None; + cache = None; } type thread_model = @@ -170,6 +178,9 @@ external set_can_multi_conn : ('a -> bool) -> unit = "ocaml_nbdkit_set_can_multi external set_can_extents : ('a -> bool) -> unit = "ocaml_nbdkit_set_can_extents" external set_extents : ('a -> int32 -> int64 -> flags -> extent list) -> unit = "ocaml_nbdkit_set_extents" +external set_can_cache : ('a -> cache_flag) -> unit = "ocaml_nbdkit_set_can_cache" +external set_cache : ('a -> int32 -> int64 -> flags -> unit) -> unit = "ocaml_nbdkit_set_cache" + let may f = function None -> () | Some a -> f a let register_plugin thread_model plugin = @@ -229,7 +240,10 @@ let register_plugin thread_model plugin = may set_can_multi_conn plugin.can_multi_conn; may set_can_extents plugin.can_extents; - may set_extents plugin.extents + may set_extents plugin.extents; + + may set_can_cache plugin.can_cache; + may set_cache plugin.cache external _set_error : int -> unit = "ocaml_nbdkit_set_error" "noalloc" diff --git a/plugins/ocaml/NBDKit.mli b/plugins/ocaml/NBDKit.mli index da110fe..bab8f7f 100644 --- a/plugins/ocaml/NBDKit.mli +++ b/plugins/ocaml/NBDKit.mli @@ -40,6 +40,8 @@ and flag = May_trim | FUA | Req_one type fua_flag = FuaNone | FuaEmulate | FuaNative +type cache_flag = CacheNone | CacheEmulate | CacheNop + type extent = { offset : int64; length : int64; @@ -86,6 +88,9 @@ type 'a plugin = { can_extents : ('a -> bool) option; extents : ('a -> int32 -> int64 -> flags -> extent list) option; + + can_cache : ('a -> cache_flag) option; + cache : ('a -> int32 -> int64 -> flags -> unit) option; } (** The plugin fields and callbacks. ['a] is the handle type. *) -- 2.20.1