ocaml/libs/xb: Use bytes in place of strings for mutable buffers

Since Ocaml 4.06.0, that made safe-string on by default, the compiler is
allowed to perform optimisations on immutable strings.  They should no
longer be used as mutable buffers, and bytes should be used instead.

The C stubs for Xs_ring have been updated to use bytes, and the interface
rationalised mimicking the new Unix module in the standard library (the
implementation of Unix.write_substring uses unsafe_of_string in the exact same
way, and both the write implementations are using the bytes as an immutable
payload for the write).

Signed-off-by: Marcello Seri <marcello.seri@citrix.com>
Acked-by: Christian Lindig <christian.lindig@citrix.com>
Tested-by: Andrew Cooper <andrew.cooper3@citrix.com>
Release-acked-by: Juergen Gross <jgross@suse.com>

diff --git a/tools/ocaml/libs/xb/xb.ml b/tools/ocaml/libs/xb/xb.ml
index 660224f8954d25e5835411902412c5cf83339c96..ca738657df3b522e5c21ed2d8554a2823533a483 100644 (file)
--- a/tools/ocaml/libs/xb/xb.ml
+++ b/tools/ocaml/libs/xb/xb.ml
@@ -76,9 +76,9 @@ let read_fd back con b len =
        rd
 
 let read_mmap back con b len =
-       let s = String.make len (char_of_int 0) in
+       let s = Bytes.make len '\000' in
        let rd = Xs_ring.read back.mmap s len in
-       Bytes.blit_string s 0 b 0 rd;
+       Bytes.blit s 0 b 0 rd;
        back.work_again <- (rd > 0);
        if rd > 0 then
                back.eventchn_notify ();
@@ -90,19 +90,17 @@ let read con b len =
        | Xenmmap backmmap -> read_mmap backmmap con b len
 
 let write_fd back con b len =
-       Unix.write back.fd b 0 len
+       Unix.write_substring back.fd b 0 len
 
 let write_mmap back con s len =
-       let ws = Xs_ring.write back.mmap s len in
+       let ws = Xs_ring.write_substring back.mmap s len in
        if ws > 0 then
                back.eventchn_notify ();
        ws
 
 let write con s len =
        match con.backend with
-       (* we can use unsafe_of_string here as the bytes are used immutably
-          in the Unix.write operation. *)
-       | Fd backfd     -> write_fd backfd con (Bytes.unsafe_of_string s) len
+       | Fd backfd     -> write_fd backfd con s len
        | Xenmmap backmmap -> write_mmap backmmap con s len
 
 (* NB: can throw Reconnect *)

diff --git a/tools/ocaml/libs/xb/xb.mli b/tools/ocaml/libs/xb/xb.mli
index d566011fc76b9b2793c21b0d654c9d9dc9455c93..3a00da6cddc14a5fdb1d79da19473c2d7249e98c 100644 (file)
--- a/tools/ocaml/libs/xb/xb.mli
+++ b/tools/ocaml/libs/xb/xb.mli
@@ -79,7 +79,7 @@ val queue : t -> Packet.t -> unit
 val read_fd : backend_fd -> 'a -> bytes -> int -> int
 val read_mmap : backend_mmap -> 'a -> bytes -> int -> int
 val read : t -> bytes -> int -> int
-val write_fd : backend_fd -> 'a -> bytes -> int -> int
+val write_fd : backend_fd -> 'a -> string -> int -> int
 val write_mmap : backend_mmap -> 'a -> string -> int -> int
 val write : t -> string -> int -> int
 val output : t -> bool

diff --git a/tools/ocaml/libs/xb/xs_ring.ml b/tools/ocaml/libs/xb/xs_ring.ml
index 48e06f4cbf0e3cfcd38a320e85ae19014e1a26a8..db7f86bd27c740ccf4315a086bd0b4f50f12b3a2 100644 (file)
--- a/tools/ocaml/libs/xb/xs_ring.ml
+++ b/tools/ocaml/libs/xb/xs_ring.ml
@@ -24,12 +24,14 @@ module Server_features = Set.Make(struct
        let compare = compare
 end)
 
-external read: Xenmmap.mmap_interface -> string -> int -> int = "ml_interface_read"
-external write: Xenmmap.mmap_interface -> string -> int -> int = "ml_interface_write"
+external read: Xenmmap.mmap_interface -> bytes -> int -> int = "ml_interface_read"
+external write: Xenmmap.mmap_interface -> bytes -> int -> int = "ml_interface_write"
 
-external _internal_set_server_features: Xenmmap.mmap_interface -> int -> unit = "ml_interface_set_server_features" "noalloc"
-external _internal_get_server_features: Xenmmap.mmap_interface -> int = "ml_interface_get_server_features" "noalloc"
+external _internal_set_server_features: Xenmmap.mmap_interface -> int -> unit = "ml_interface_set_server_features" [@@noalloc]
+external _internal_get_server_features: Xenmmap.mmap_interface -> int = "ml_interface_get_server_features" [@@noalloc]
 
+let write_substring mmap buff len =
+       write mmap (Bytes.unsafe_of_string buff) len
 
 let get_server_features mmap =
        (* NB only one feature currently defined above *)
@@ -43,4 +45,4 @@ let set_server_features mmap set =
        let x = if set = Server_features.empty then 0 else 1 in
        _internal_set_server_features mmap x
 
-external close: Xenmmap.mmap_interface -> unit = "ml_interface_close" "noalloc"
+external close: Xenmmap.mmap_interface -> unit = "ml_interface_close" [@@noalloc]