This commit is contained in:
Simon Cruanes 2025-10-30 13:09:04 +01:00 committed by GitHub
commit 7c64ad9400
No known key found for this signature in database
GPG key ID: B5690EEEBB952194

View file

@ -15,19 +15,23 @@ module Bb_queue = struct
if was_empty then Condition.broadcast self.cond; if was_empty then Condition.broadcast self.cond;
Mutex.unlock self.mutex Mutex.unlock self.mutex
let pop (self : 'a t) : 'a = let pop (type a) (self : a t) : a =
Mutex.lock self.mutex; let module M = struct
let rec loop () = exception Found of a
if Queue.is_empty self.q then ( end in
Condition.wait self.cond self.mutex; try
(loop [@tailcall]) () Mutex.lock self.mutex;
) else ( while true do
let x = Queue.pop self.q in if Queue.is_empty self.q then
Mutex.unlock self.mutex; Condition.wait self.cond self.mutex
x else (
) let x = Queue.pop self.q in
in Mutex.unlock self.mutex;
loop () raise (M.Found x)
)
done;
assert false
with M.Found x -> x
end end
module Lock = struct module Lock = struct
@ -95,6 +99,11 @@ let domains_ : (worker_state option * Domain_.t option) Lock.t array =
a [Pool.with_] or [Pool.create() Pool.shutdown()] in a tight loop), and a [Pool.with_] or [Pool.create() Pool.shutdown()] in a tight loop), and
if nothing happens it tries to stop to free resources. *) if nothing happens it tries to stop to free resources. *)
let work_ idx (st : worker_state) : unit = let work_ idx (st : worker_state) : unit =
Thread.sigmask SIG_BLOCK
[
Sys.sigpipe; Sys.sigbus; Sys.sigterm; Sys.sigint; Sys.sigusr1; Sys.sigusr2;
]
|> ignore;
let main_loop () = let main_loop () =
let continue = ref true in let continue = ref true in
while !continue do while !continue do