picos: expose Nanoev_picos.Global_ev module and evloop

This commit is contained in:
Simon Cruanes 2025-05-02 15:10:15 -04:00
parent a14280c1a8
commit b96a78cfc0
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
4 changed files with 29 additions and 25 deletions

View file

@ -1,6 +1,6 @@
let is_setup = Global_.has_bg_thread let is_setup = Global_ev.has_bg_thread
let setup = Global_.setup_bg_thread let setup = Global_ev.setup_bg_thread
let shutdown = Global_.shutdown_bg_thread let shutdown = Global_ev.shutdown_bg_thread
let with_setup ev f = let with_setup ev f =
setup ev; setup ev;

View file

@ -1,9 +1,6 @@
open Common_ open Common_
let[@inline] get_loop_exn_ () : Nanoev.t = let get_loop_exn_ : unit -> Nanoev.t = Global_ev.get_nanoev_exn
match Atomic.get Global_.st with
| None -> failwith "No nanoev loop installed."
| Some st -> st.nanoev
let[@inline] unwrap_ = function let[@inline] unwrap_ = function
| None -> () | 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 connect fd addr = retry_write_ fd (fun () -> Unix.connect fd addr)
let[@inline] max_fds () = let[@inline] max_fds () =
match Atomic.get Global_.st with Option.fold ~none:1024 ~some:Nanoev.max_fds @@ Global_ev.get_nanoev ()
| None -> 1024
| Some st -> Nanoev.max_fds st.nanoev
let sleep t = let sleep t =
if t > 0. then ( if t > 0. then (

View file

@ -1,6 +1,9 @@
(** Global loop *)
open Common_ open Common_
type st = open struct
type st =
| None | None
| Some of { | Some of {
active: bool Atomic.t; active: bool Atomic.t;
@ -8,8 +11,9 @@ type st =
th: Thread.t; th: Thread.t;
} }
let st : st Atomic.t = Atomic.make None let st : st Atomic.t = Atomic.make None
let lock = Mutex.create () let lock = Mutex.create ()
end
let with_lock lock f = let with_lock lock f =
Mutex.lock lock; Mutex.lock lock;
@ -27,6 +31,16 @@ let bg_thread_ ~active ~evloop () : unit =
Nanoev.step evloop Nanoev.step evloop
done 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[@inline] has_bg_thread () = Atomic.get st <> None
let setup_bg_thread (ev : Nanoev.t) : unit = let setup_bg_thread (ev : Nanoev.t) : unit =

View file

@ -60,12 +60,7 @@ end
let establish ?backlog ?max_connections ?(exn_handler = default_exn_handler) let establish ?backlog ?max_connections ?(exn_handler = default_exn_handler)
~spawn ~(client_handler : client_handler) addr : t = ~spawn ~(client_handler : client_handler) addr : t =
let ev = let ev = Global_ev.get_nanoev_exn () in
match Atomic.get Global_.st with
| Some { nanoev = ev; _ } -> ev
| None -> invalid_arg "Nanoev_picos.Net_server: no event loop installed"
in
let max_connections = let max_connections =
match max_connections with match max_connections with
| None -> Nanoev.max_fds ev | None -> Nanoev.max_fds ev