Source file `wepoll_poll.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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
[%%import "config.h"]
[%%if defined POLL_CONF_WIN32]

let available = true

module Ffi = struct
  external epoll_create1 : unit -> Unix.file_descr = "poll_stub_wepoll_create1"
  external epoll_in : unit -> int = "poll_stub_epollin"
  external epoll_rdhup : unit -> int = "poll_stub_epollrdhup"
  external epoll_hup : unit -> int = "poll_stub_epollhup"
  external epoll_err : unit -> int = "poll_stub_epollerr"
  external epoll_pri : unit -> int = "poll_stub_epollpri"
  external epoll_out : unit -> int = "poll_stub_epollout"
  external epoll_oneshot : unit -> int = "poll_stub_epolloneshot"
  external epoll_event_sizeof : unit -> int = "poll_stub_epoll_event_sizeout"

  external epoll_ctl_add
    :  Unix.file_descr
    -> Unix.file_descr
    -> int
    -> unit
    = "poll_stub_epoll_ctl_add"

  external epoll_ctl_mod
    :  Unix.file_descr
    -> Unix.file_descr
    -> int
    -> unit
    = "poll_stub_epoll_ctl_mod"

  external epoll_ctl_del
    :  Unix.file_descr
    -> Unix.file_descr
    -> unit
    = "poll_stub_epoll_ctl_del"

  external epoll_wait
    :  Unix.file_descr
    -> Bigstring.t
    -> int
    -> int
    = "poll_stub_epoll_wait"

  external epoll_iter_ready
    :  Bigstring.t
    -> int
    -> (Unix.file_descr -> int -> unit)
    -> unit
    = "poll_stub_epoll_iter_ready"

  let epoll_event_sizeof = epoll_event_sizeof ()
  let epoll_in = epoll_in ()
  let epoll_rdhup = epoll_rdhup ()
  let epoll_hup = epoll_hup ()
  let epoll_err = epoll_err ()
  let epoll_pri = epoll_pri ()
  let epoll_out = epoll_out ()
  let epoll_oneshot = epoll_oneshot ()
  let flag_read = epoll_in lor epoll_rdhup lor epoll_hup lor epoll_err lor epoll_pri
  let flag_write = epoll_out lor epoll_hup lor epoll_err
end

type t =
  { epoll_fd : Unix.file_descr
  ; mutable ready_events : int
  ; events : Bigstring.t
  ; mutable closed : bool
  ; flags : (Unix.file_descr, int) Hashtbl.t
  }

let ensure_open t = if t.closed then failwith "Attempting to use a closed epoll fd"
let backend = Backend.Wepoll

let create () =
  { epoll_fd = Ffi.epoll_create1 ()
  ; ready_events = 0
  ; events = Bigstring.create (256 * Ffi.epoll_event_sizeof)
  ; closed = false
  ; flags = Hashtbl.create 65536
  }
;;

let clear t =
  ensure_open t;
  t.ready_events <- 0
;;

let close t =
  if not t.closed
  then (
    t.closed <- true;
    Unix.close t.epoll_fd)
;;

let set t fd event =
  ensure_open t;
  let current_flags = Hashtbl.find_opt t.flags fd in
  let new_flags =
    match event.Event.readable, event.Event.writable with
    | false, false -> None
    | true, false -> Some (Ffi.epoll_oneshot lor Ffi.flag_read)
    | false, true -> Some (Ffi.epoll_oneshot lor Ffi.flag_write)
    | true, true -> Some Ffi.(epoll_oneshot lor flag_read lor flag_write)
  in
  match current_flags, new_flags with
  | None, None -> ()
  | None, Some f ->
    Ffi.epoll_ctl_add t.epoll_fd fd f;
    Hashtbl.replace t.flags fd f
  | Some _, None ->
    Ffi.epoll_ctl_del t.epoll_fd fd;
    Hashtbl.remove t.flags fd
  | Some _, Some b ->
    Ffi.epoll_ctl_mod t.epoll_fd fd b;
    Hashtbl.replace t.flags fd b
;;

let wait t timeout =
  let timeout =
    match timeout with
    | Timeout.Immediate -> 0
    | Never -> -1
    | After x -> Int64.to_int (Int64.div x 1_000_000L)
  in
  ensure_open t;
  t.ready_events <- 0;
  t.ready_events <- Ffi.epoll_wait t.epoll_fd t.events timeout;
  if t.ready_events = 0 then `Timeout else `Ok
;;

let iter_callback f fd flags =
  let readable = flags land Ffi.flag_read <> 0 in
  let writable = flags land Ffi.flag_write <> 0 in
  f fd { Event.readable; writable }
;;

let iter_ready t ~f =
  ensure_open t;
  let callback = iter_callback f in
  Ffi.epoll_iter_ready t.events t.ready_events callback
;;

[%%else]

include Empty_poll

let available = false

[%%endif]