picos: simplify a bit read/write retry loops

This commit is contained in:
Simon Cruanes 2025-05-01 13:22:45 -04:00
parent 34a1cc1769
commit bd983a395c
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4

View file

@ -85,48 +85,42 @@ let[@inline] unwrap_ = function
| None -> () | None -> ()
| Some (exn, bt) -> Printexc.raise_with_backtrace exn bt | Some (exn, bt) -> Printexc.raise_with_backtrace exn bt
let retry_read_ fd f = let[@unroll 1] rec retry_read_ fd f =
let ev = get_loop_exn_ () in match f () with
let[@unroll 1] rec loop () = | res -> res
match f () with | exception
| res -> res Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _) ->
| exception (* Trace_.message "read must wait"; *)
Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _) -> let trigger = Picos.Trigger.create () in
Trace_.message "read must wait"; let closed_r = ref false in
let trigger = Picos.Trigger.create () in let ev = get_loop_exn_ () in
let closed_r = ref false in Nanoev.on_readable ev fd trigger closed_r (fun ~closed trigger closed_r ->
Nanoev.on_readable ev fd trigger closed_r (fun ~closed trigger closed_r -> closed_r := closed;
closed_r := closed; Picos.Trigger.signal trigger);
Picos.Trigger.signal trigger); Picos.Trigger.await trigger |> unwrap_;
Picos.Trigger.await trigger |> unwrap_; if !closed_r then raise Closed;
if !closed_r then raise Closed; retry_read_ fd f
loop ()
in
loop ()
let retry_write_ fd f = let[@unroll 1] rec retry_write_ fd f =
let ev = get_loop_exn_ () in match f () with
let rec loop () = | res -> res
match f () with | exception
| res -> res Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _) ->
| exception (* Trace_.message "write must wait"; *)
Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _) -> let ev = get_loop_exn_ () in
Trace_.message "write must wait"; let trigger = Picos.Trigger.create () in
let trigger = Picos.Trigger.create () in let closed_r = ref false in
let closed_r = ref false in Nanoev.on_writable ev fd trigger closed_r (fun ~closed trigger closed_r ->
Nanoev.on_writable ev fd trigger closed_r (fun ~closed trigger closed_r -> closed_r := closed;
closed_r := closed; Picos.Trigger.signal trigger);
Picos.Trigger.signal trigger); Picos.Trigger.await trigger |> unwrap_;
Picos.Trigger.await trigger |> unwrap_; if !closed_r then raise Closed;
if !closed_r then raise Closed; retry_write_ fd f
loop ()
in
loop ()
let read fd buf i len : int = let read fd buf i len : int =
try try
retry_read_ fd (fun () -> retry_read_ fd (fun () ->
Trace_.message "read"; (* Trace_.message "read"; *)
Unix.read fd buf i len) Unix.read fd buf i len)
with Closed -> 0 with Closed -> 0
@ -138,7 +132,7 @@ let close fd =
let accept fd = let accept fd =
try try
retry_read_ fd (fun () -> retry_read_ fd (fun () ->
Trace_.message "accept"; (* Trace_.message "accept"; *)
Unix.accept fd) Unix.accept fd)
with Unix.Unix_error ((Unix.ESHUTDOWN | Unix.ECONNABORTED), _, _) -> with Unix.Unix_error ((Unix.ESHUTDOWN | Unix.ECONNABORTED), _, _) ->
raise Closed raise Closed
@ -146,7 +140,7 @@ let accept fd =
let write fd buf i len : int = let write fd buf i len : int =
try try
retry_write_ fd (fun () -> retry_write_ fd (fun () ->
Trace_.message "write"; (* Trace_.message "write"; *)
Unix.write fd buf i len) Unix.write fd buf i len)
with Closed -> 0 with Closed -> 0