diff --git a/src/picos/background_thread.ml b/src/picos/background_thread.ml index 261daad..e753edb 100644 --- a/src/picos/background_thread.ml +++ b/src/picos/background_thread.ml @@ -1,6 +1,6 @@ -let is_setup = Global_.has_bg_thread -let setup = Global_.setup_bg_thread -let shutdown = Global_.shutdown_bg_thread +let is_setup = Global_ev.has_bg_thread +let setup = Global_ev.setup_bg_thread +let shutdown = Global_ev.shutdown_bg_thread let with_setup ev f = setup ev; diff --git a/src/picos/base.ml b/src/picos/base.ml index 142e467..d04e242 100644 --- a/src/picos/base.ml +++ b/src/picos/base.ml @@ -1,9 +1,6 @@ open Common_ -let[@inline] get_loop_exn_ () : Nanoev.t = - match Atomic.get Global_.st with - | None -> failwith "No nanoev loop installed." - | Some st -> st.nanoev +let get_loop_exn_ : unit -> Nanoev.t = Global_ev.get_nanoev_exn let[@inline] unwrap_ = function | None -> () @@ -85,9 +82,7 @@ let rec write fd buf i len = let connect fd addr = retry_write_ fd (fun () -> Unix.connect fd addr) let[@inline] max_fds () = - match Atomic.get Global_.st with - | None -> 1024 - | Some st -> Nanoev.max_fds st.nanoev + Option.fold ~none:1024 ~some:Nanoev.max_fds @@ Global_ev.get_nanoev () let sleep t = if t > 0. then ( diff --git a/src/picos/global_.ml b/src/picos/global_ev.ml similarity index 67% rename from src/picos/global_.ml rename to src/picos/global_ev.ml index 2e590b8..cb773fc 100644 --- a/src/picos/global_.ml +++ b/src/picos/global_ev.ml @@ -1,15 +1,19 @@ +(** Global loop *) + open Common_ -type st = - | None - | Some of { - active: bool Atomic.t; - nanoev: Nanoev.t; - th: Thread.t; - } +open struct + type st = + | None + | Some of { + active: bool Atomic.t; + nanoev: Nanoev.t; + th: Thread.t; + } -let st : st Atomic.t = Atomic.make None -let lock = Mutex.create () + let st : st Atomic.t = Atomic.make None + let lock = Mutex.create () +end let with_lock lock f = Mutex.lock lock; @@ -27,6 +31,16 @@ let bg_thread_ ~active ~evloop () : unit = Nanoev.step evloop done +let[@inline] get_nanoev () : Nanoev.t option = + match Atomic.get st with + | None -> None + | Some st -> Some st.nanoev + +let[@inline] get_nanoev_exn () : Nanoev.t = + match Atomic.get st with + | None -> failwith "No nanoev loop installed in nanoev_picos" + | Some st -> st.nanoev + let[@inline] has_bg_thread () = Atomic.get st <> None let setup_bg_thread (ev : Nanoev.t) : unit = diff --git a/src/picos/net_server.ml b/src/picos/net_server.ml index 642ba48..028f37f 100644 --- a/src/picos/net_server.ml +++ b/src/picos/net_server.ml @@ -60,12 +60,7 @@ end let establish ?backlog ?max_connections ?(exn_handler = default_exn_handler) ~spawn ~(client_handler : client_handler) addr : t = - let ev = - match Atomic.get Global_.st with - | Some { nanoev = ev; _ } -> ev - | None -> invalid_arg "Nanoev_picos.Net_server: no event loop installed" - in - + let ev = Global_ev.get_nanoev_exn () in let max_connections = match max_connections with | None -> Nanoev.max_fds ev