[Xen-devel] [PATCH for-4.11 1/2] ocaml/libs/xb: use bytes in place of strings for mutable buffers

[Marcello Seri <marcello.seri@xxxxxxxxxx>]

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@xxxxxxxxxx>
---
 tools/ocaml/libs/xb/xb.ml      | 12 +++++-------
 tools/ocaml/libs/xb/xb.mli     |  2 +-
 tools/ocaml/libs/xb/xs_ring.ml | 12 +++++++-----
 3 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/tools/ocaml/libs/xb/xb.ml b/tools/ocaml/libs/xb/xb.ml
index 660224f895..ca738657df 100644
--- 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 d566011fc7..3a00da6cdd 100644
--- 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 48e06f4cbf..db7f86bd27 100644
--- 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]
-- 
2.17.0


_______________________________________________
Xen-devel mailing list
Xen-devel@xxxxxxxxxxxxxxxxxxxx
https://lists.xenproject.org/mailman/listinfo/xen-devel