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>

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 *)

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

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]