Trace Eio_unix.run_in_systhread

lib_eio/unix/eio_unix.mli

@@ -50,9 +50,11 @@ val sleep : float -> unit
     without having to plumb {!Eio.Stdenv.mono_clock} through your code.
     It can also be used in programs that don't care about tracking determinism. *)
 
-val run_in_systhread : (unit -> 'a) -> 'a
+val run_in_systhread : ?label:string -> (unit -> 'a) -> 'a
 (** [run_in_systhread fn] runs the function [fn] in a newly created system thread (a {! Thread.t}).
-    This allows blocking calls to be made non-blocking. *)
+    This allows blocking calls to be made non-blocking.
+
+    @param label The operation name to use in trace output. *)
 
 val pipe : Switch.t -> source_ty r * sink_ty r
 (** [pipe sw] returns a connected pair of flows [src] and [sink]. Data written to [sink]

lib_eio/unix/net.ml

@@ -51,7 +51,7 @@ let getnameinfo (sockaddr : Eio.Net.Sockaddr.t) =
     | `Udp _ -> [Unix.NI_DGRAM]
   in
   let sockaddr = sockaddr_to_unix sockaddr in
-  Private.run_in_systhread (fun () ->
+  Private.run_in_systhread ~label:"getnameinfo" (fun () ->
     let Unix.{ni_hostname; ni_service} = Unix.getnameinfo sockaddr options in
     (ni_hostname, ni_service))
 

lib_eio/unix/private.ml

@@ -17,12 +17,10 @@ let pipe sw = Effect.perform (Pipe sw)
 module Rcfd = Rcfd
 module Fork_action = Fork_action
 
-let run_in_systhread fn =
-  let f fiber enqueue =
-    match Eio.Private.Fiber_context.get_error fiber with
-    | Some err -> enqueue (Error err)
-    | None ->
-      let _t : Thread.t = Thread.create (fun () -> enqueue (try Ok (fn ()) with exn -> Error exn)) () in
-      ()
-  in
-  Effect.perform (Eio.Private.Effects.Suspend f)
+let run_in_systhread ?(label="systhread") fn =
+  Eio.Private.Suspend.enter label @@ fun fiber enqueue ->
+  match Eio.Private.Fiber_context.get_error fiber with
+  | Some err -> enqueue (Error err)
+  | None ->
+    let _t : Thread.t = Thread.create (fun () -> enqueue (try Ok (fn ()) with exn -> Error exn)) () in
+    ()

lib_eio_linux/low_level.ml

@@ -341,11 +341,11 @@ let lseek fd off cmd =
 
 let fsync fd =
   (* todo: https://github.com/ocaml-multicore/ocaml-uring/pull/103 *)
-  Eio_unix.run_in_systhread @@ fun () ->
+  Eio_unix.run_in_systhread ~label:"fsync" @@ fun () ->
   Fd.use_exn "fsync" fd Unix.fsync
 
 let ftruncate fd len =
-  Eio_unix.run_in_systhread @@ fun () ->
+  Eio_unix.run_in_systhread ~label:"ftruncate" @@ fun () ->
   Fd.use_exn "ftruncate" fd @@ fun fd ->
   Unix.LargeFile.ftruncate fd (Optint.Int63.to_int64 len)
 
@@ -479,7 +479,7 @@ let read_dir fd =
       let files = List.filter (function ".." | "." -> false | _ -> true) files in
       read_all (files @ acc) fd
   in
-  Eio_unix.run_in_systhread (fun () -> read_all [] fd)
+  Eio_unix.run_in_systhread ~label:"read_dir" (fun () -> read_all [] fd)
 
 (* https://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml *)
 let getaddrinfo ~service node =
@@ -494,7 +494,7 @@ let getaddrinfo ~service node =
         | _ -> None)
     | _ -> None
   in
-  Eio_unix.run_in_systhread @@ fun () ->
+  Eio_unix.run_in_systhread ~label:"getaddrinfo" @@ fun () ->
   Unix.getaddrinfo node service []
   |> List.filter_map to_eio_sockaddr_t
 

lib_eio_posix/low_level.ml

@@ -16,7 +16,7 @@ module Trace = Eio.Private.Trace
 module Fiber_context = Eio.Private.Fiber_context
 
 (* todo: keeping a pool of workers is probably faster *)
-let in_worker_thread = Eio_unix.run_in_systhread
+let in_worker_thread label = Eio_unix.run_in_systhread ~label
 
 let await_readable op fd =
   Fd.use_exn "await_readable" fd @@ fun fd ->
@@ -115,11 +115,11 @@ let getrandom { Cstruct.buffer; off; len } =
     else
       loop (n + eio_getrandom buffer (off + n) (len - n))
   in
-  in_worker_thread @@ fun () ->
+  in_worker_thread "getrandom" @@ fun () ->
   loop 0
 
 let realpath path =
-  in_worker_thread @@ fun () ->
+  in_worker_thread "realpath" @@ fun () ->
   Unix.realpath path
 
 let read_entries h =
@@ -132,7 +132,7 @@ let read_entries h =
   aux []
 
 let readdir path =
-  in_worker_thread @@ fun () ->
+  in_worker_thread "readdir" @@ fun () ->
   let h = Unix.opendir path in
   match read_entries h with
   | r -> Unix.closedir h; r
@@ -201,29 +201,29 @@ external eio_openat : Unix.file_descr -> string -> Open_flags.t -> int -> Unix.f
 let openat ?dirfd ~sw ~mode path flags =
   with_dirfd "openat" dirfd @@ fun dirfd ->
   Switch.check sw;
-  in_worker_thread (fun () -> eio_openat dirfd path Open_flags.(flags + cloexec + nonblock) mode)
+  in_worker_thread "openat" (fun () -> eio_openat dirfd path Open_flags.(flags + cloexec + nonblock) mode)
   |> Fd.of_unix ~sw ~blocking:false ~close_unix:true
 
 external eio_mkdirat : Unix.file_descr -> string -> Unix.file_perm -> unit = "caml_eio_posix_mkdirat"
 
 let mkdir ?dirfd ~mode path =
   with_dirfd "mkdirat" dirfd @@ fun dirfd ->
-  in_worker_thread @@ fun () ->
+  in_worker_thread "mkdir" @@ fun () ->
   eio_mkdirat dirfd path mode
 
 external eio_unlinkat : Unix.file_descr -> string -> bool -> unit = "caml_eio_posix_unlinkat"
 
 let unlink ?dirfd ~dir path =
   with_dirfd "unlink" dirfd @@ fun dirfd ->
-  in_worker_thread @@ fun () ->
+  in_worker_thread "unlink" @@ fun () ->
   eio_unlinkat dirfd path dir
 
 external eio_renameat : Unix.file_descr -> string -> Unix.file_descr -> string -> unit = "caml_eio_posix_renameat"
 
 let rename ?old_dir old_path ?new_dir new_path =
   with_dirfd "rename-old" old_dir @@ fun old_dir ->
   with_dirfd "rename-new" new_dir @@ fun new_dir ->
-  in_worker_thread @@ fun () ->
+  in_worker_thread "rename" @@ fun () ->
   eio_renameat old_dir old_path new_dir new_path
 
 type stat
@@ -236,7 +236,7 @@ let fstat ~buf fd =
   eio_fstat buf fd
 
 let fstatat ~buf ?dirfd ~follow path =
-  in_worker_thread @@ fun () ->
+  in_worker_thread "fstat" @@ fun () ->
   let flags = if follow then 0 else Config.at_symlink_nofollow in
   with_dirfd "fstatat" dirfd @@ fun dirfd ->
   eio_fstatat buf dirfd path flags
@@ -273,11 +273,11 @@ let lseek fd off cmd =
   |> Optint.Int63.of_int64
 
 let fsync fd =
-  Eio_unix.run_in_systhread @@ fun () ->
+  Eio_unix.run_in_systhread ~label:"fsync" @@ fun () ->
   Fd.use_exn "fsync" fd Unix.fsync
 
 let ftruncate fd len =
-  Eio_unix.run_in_systhread @@ fun () ->
+  Eio_unix.run_in_systhread ~label:"ftruncate" @@ fun () ->
   Fd.use_exn "ftruncate" fd @@ fun fd ->
   Unix.LargeFile.ftruncate fd (Optint.Int63.to_int64 len)
 

lib_eio_posix/net.ml

@@ -94,7 +94,7 @@ let getaddrinfo ~service node =
         | _ -> None)
     | _ -> None
   in
-  Err.run Eio_unix.run_in_systhread @@ fun () ->
+  Err.run (Eio_unix.run_in_systhread ~label:"getaddrinfo") @@ fun () ->
   let rec aux () =
     try
       Unix.getaddrinfo node service []