Fut.wait_block: a bit of spinning before blocking

src/gen/gen.ml

@@ -55,6 +55,8 @@ let get_id (self:t) : int = Thread.id self
 
 let spawn f : t =
   Thread.create f ()
+
+let relax () = Thread.yield ()
 |}
 
 let domain_post_5 =
@@ -65,8 +67,9 @@ type t = unit Domain.t
 
 let get_id (self:t) : int = (Domain.get_id self :> int)
 
-let spawn f : t =
+let spawn : _ -> t = Domain.spawn
-  Domain.spawn f
+
+let relax = Domain.cpu_relax
 |}
 
 let p_version s = Scanf.sscanf s "%d.%d" (fun x y -> x, y)

src/moonpool.ml

@@ -346,15 +346,29 @@ module Fut = struct
   (* ### blocking ### *)
 
   let wait_block (self : 'a t) : 'a or_error =
-    match peek self with
+    match A.get self.st with
-    | Some x ->
+    | Done x -> x (* fast path *)
-      (* fast path *)
+    | Waiting _ ->
-      x
+      let real_block () =
-    | None ->
+        (* use queue only once *)
-      (* use queue only once *)
+        let q = S_queue.create () in
-      let q = S_queue.create () in
+        on_result self (fun r -> S_queue.push q r);
-      on_result self (fun r -> S_queue.push q r);
+        S_queue.pop q
-      S_queue.pop q
+      in
+
+      (* a bit of spinlock *)
+      let rec loop i =
+        if i = 0 then
+          real_block ()
+        else (
+          match A.get self.st with
+          | Done x -> x
+          | Waiting _ ->
+            Domain_.relax ();
+            (loop [@tailcall]) (i - 1)
+        )
+      in
+      loop 50
 
   let wait_block_exn self =
     match wait_block self with