From d7220c75f526baf7883f5804530ca3921ef7021d Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 1 Jun 2023 20:59:25 -0400
Subject: [PATCH] add start_thread_on_some_domain

---
 src/moonpool.ml  | 11 +++++++++++
 src/moonpool.mli |  5 +++++
 2 files changed, 16 insertions(+)

diff --git a/src/moonpool.ml b/src/moonpool.ml
index 018f8c5d..a9e22fdc 100644
--- a/src/moonpool.ml
+++ b/src/moonpool.ml
@@ -69,8 +69,19 @@ module D_pool_ = struct
     let (lazy arr) = domains_ in
     assert (i < Array.length arr);
     S_queue.push arr.(i).q f
+
+  let run_on_and_wait (i : int) (f : unit -> 'a) : 'a =
+    let q = S_queue.create () in
+    run_on i (fun () ->
+        let x = f () in
+        S_queue.push q x);
+    S_queue.pop q
 end
 
+let start_thread_on_some_domain f x =
+  let did = Random.int (D_pool_.n_domains ()) in
+  D_pool_.run_on_and_wait did (fun () -> Thread.create f x)
+
 module Pool = struct
   (* TODO: use a better queue for the tasks *)
 
diff --git a/src/moonpool.mli b/src/moonpool.mli
index 96a0f2c8..8694ccf8 100644
--- a/src/moonpool.mli
+++ b/src/moonpool.mli
@@ -31,6 +31,11 @@ module Pool : sig
       in one of the threads. *)
 end
 
+val start_thread_on_some_domain : ('a -> unit) -> 'a -> Thread.t
+(** Similar to {!Thread.create}, but it picks a background domain at random
+    to run the thread. This ensures that we don't always pick the same domain
+    to run all the various threads needed in an application (timers, event loops, etc.) *)
+
 (** Futures *)
 module Fut : sig
   type 'a t