CI

.github/workflows/gh-pages.yml

@@ -22,9 +22,11 @@ jobs:
       # temporary until it's in a release
       - run: opam pin picos 0.6.0 -y -n
 
-      - run: opam install picos moonpool trace
+      - run: opam install odig moonpool trace
+      - run: opam pin . -y -n
+      - run: opam install . --deps-only
 
-      - run: opam exec -- odig odoc --cache-dir=_doc/ nanoev
+      - run: opam exec -- odig odoc --cache-dir=_doc/ nanoev nanoev-picos nanoev-posix nanoev_tiny_httpd
 
       - name: Deploy
         uses: peaceiris/actions-gh-pages@v3

README.md

@@ -28,4 +28,7 @@ let () =
 ## Backends
 
 - [x] select
+- [x] poll/ppoll
+- [ ] epoll
+- [ ] kqueue
 - [ ] uring

src/picos/background_thread.ml

@@ -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 =
   setup ev;

src/picos/base.ml

@@ -1,9 +1,6 @@
 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
   | 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
+  Option.fold ~none:1024 ~some:Nanoev.max_fds @@ Global_ev.get_nanoev ()
-  | None -> 1024
-  | Some st -> Nanoev.max_fds st.nanoev
 
 let sleep t =
   if t > 0. then (

src/picos/global_ev.ml

@@ -1,15 +1,19 @@
+(** Global loop. *)
+
 open Common_
 
-type st =
+open struct
-  | None
+  type st =
-  | Some of {
+    | None
-      active: bool Atomic.t;
+    | Some of {
-      nanoev: Nanoev.t;
+        active: bool Atomic.t;
-      th: Thread.t;
+        nanoev: Nanoev.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 =
   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 =

src/picos/nanoev_picos.ml

@@ -1,6 +1,7 @@
 module Background_thread = Background_thread
 module Base = Base
 include Base
+module Global_ev = Global_ev
 module IO_in = IO_in
 module IO_out = IO_out
 module Net_client = Net_client

src/picos/nanoev_picos.mli

@@ -1,6 +1,7 @@
 (** Basic interface with picos *)
 
 module Background_thread = Background_thread
+module Global_ev = Global_ev
 
 (** {2 Non blocking IO primitives} *)
 

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 =
+  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 =
     match max_connections with
     | None -> Nanoev.max_fds ev