10:57 p.m.
This was a bit harder than sh, but still a lot of copy-and-paste.
Signed-off-by: Eric Blake <eblake(a)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