Source file affect_unix__fd.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
(*---------------------------------------------------------------------------
   Copyright (c) 2026 The affect programmers. All rights reserved.
   SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

open Affect__base
open Affect.Action.Private

(* File descriptors *)

module Fd = struct
    module type UNBLOCKER = sig
      type t
      val make : unit -> t
      val dispose : t -> unit
      val is_empty : t -> bool

      val add_wait_readable :
        t -> Unix.file_descr -> blocked:Action.Blocked.Value.t -> unit

      val add_wait_writable :
        t -> Unix.file_descr -> blocked:Action.Blocked.Value.t -> unit

      val unblock : t ->
        timeout_ns:Affect_unix__timeline.mtime_span_ns option -> bool

      val set_block_bypass : t -> unit
      val get_domain_local : unit -> t
      val set_domain_local : t -> unit
      val clear_domain_local : unit -> unit
  end

  module T = struct type t = Unix.file_descr let compare = Repr.compare end
  module Map = Map.Make (T)
  module Synchronized_map = Synchronized_map.Make (Map)
end

module Flagfd = struct
  (* Thanks to MisterDA this should work cross-platform. But we
     could plug platform specific stuff like [eventfd] here. *)

  type t =
    { set : Unix.file_descr; (* send *)
      clear : Unix.file_descr; (* recv *)
      clear_buf : Bytes.t }

  let clear_buf_size = 64
  let make () =
    let set, clear = Unix.socketpair ~cloexec:true PF_UNIX SOCK_STREAM 0 in
    let clear_buf = Bytes.make clear_buf_size '\x00' in
    Unix.set_nonblock set; Unix.set_nonblock clear;
    { set; clear; clear_buf }

  let set flag = try ignore (Unix.write_substring flag.set "1" 0 1) with
  | Unix.Unix_error ((EAGAIN|EWOULDBLOCK), _, _) -> ()

  let rec clear flag =
    try
      let len = Bytes.length flag.clear_buf in
      if Unix.read flag.clear flag.clear_buf 0 len = len
      then clear flag else ()
    with
    | Unix.Unix_error ((EAGAIN|EWOULDBLOCK), _, _) -> ()

  let fd flag = flag.clear
  let close_noerr fd = try Unix.close fd with Unix.Unix_error _ -> ()
  let dispose flag = close_noerr flag.set; close_noerr flag.clear
end