Skip to content

Rewrite Bounded_q bench using Sem #346

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 2 commits into from
Closed

Rewrite Bounded_q bench using Sem #346

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
5ab98f1
Rewrite `Bounded_q` bench using two `Sem`s
polytypic Jan 26, 2025
e83ad57
Inline more
polytypic May 1, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
73 changes: 31 additions & 42 deletions bench/bench_bounded_q.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,75 +17,64 @@ end = struct
type 'a t = {
lock : Lock.t;
queue : 'a Queue.t;
capacity : int;
not_empty : Lock.Condition.t;
not_full : Lock.Condition.t;
capacity : Sem.t;
length : Sem.t;
}

let create ?(capacity = Int.max_int) () =
let create ?(capacity = Sem.max_value) () =
if capacity < 0 then invalid_arg "negative capacity"
else
let lock = Lock.create ~padded:true ()
and queue = Queue.create () |> Multicore_magic.copy_as_padded
and not_empty = Lock.Condition.create ~padded:true ()
and not_full = Lock.Condition.create ~padded:true () in
{ lock; queue; capacity; not_empty; not_full }
|> Multicore_magic.copy_as_padded
and capacity = Sem.create ~padded:true capacity
and length = Sem.create ~padded:true 0 in
{ lock; queue; capacity; length } |> Multicore_magic.copy_as_padded

let is_empty t =
Lock.acquire t.lock;
let result = Queue.is_empty t.queue in
Lock.release t.lock;
result

let is_full_unsafe t = t.capacity <= Queue.length t.queue

let push t x =
let was_full = ref false in
Lock.acquire t.lock;
match
while is_full_unsafe t do
was_full := true;
Lock.Condition.wait t.not_full t.lock
done
with
Sem.acquire t.capacity;
match Lock.acquire t.lock with
| () ->
Queue.push x t.queue;
let n = Queue.length t.queue in
Lock.release t.lock;
if n = 1 then Lock.Condition.signal t.not_empty;
if !was_full && n < t.capacity then Lock.Condition.signal t.not_full
Sem.release t.length
| exception exn ->
Lock.release t.lock;
raise exn
let bt = Printexc.get_raw_backtrace () in
Sem.release t.capacity;
Printexc.raise_with_backtrace exn bt

let pop t =
let was_empty = ref false in
Lock.acquire t.lock;
match
while Queue.length t.queue = 0 do
was_empty := true;
Lock.Condition.wait t.not_empty t.lock
done
with
Sem.acquire t.length;
match Lock.acquire t.lock with
| () ->
let n = Queue.length t.queue in
let elem = Queue.pop t.queue in
Lock.release t.lock;
if n = t.capacity then Lock.Condition.signal t.not_full;
if !was_empty && 1 < n then Lock.Condition.signal t.not_empty;
Sem.release t.capacity;
elem
| exception exn ->
Lock.release t.lock;
raise exn
let bt = Printexc.get_raw_backtrace () in
Sem.release t.length;
Printexc.raise_with_backtrace exn bt

let pop_opt t =
Lock.acquire t.lock;
let n = Queue.length t.queue in
let elem_opt = Queue.take_opt t.queue in
Lock.release t.lock;
if n = t.capacity then Lock.Condition.signal t.not_full;
elem_opt
if Sem.try_acquire t.length then begin
match Lock.acquire t.lock with
| () ->
let elem_opt = Queue.take_opt t.queue in
Lock.release t.lock;
Sem.release t.capacity;
elem_opt
| exception exn ->
let bt = Printexc.get_raw_backtrace () in
Sem.release t.length;
Printexc.raise_with_backtrace exn bt
end
else None
end

let run_one_domain ~budgetf ?(n_msgs = 25 * Util.iter_factor) () =
Expand Down
32 changes: 16 additions & 16 deletions lib/picos_std.sync/lock.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,27 +17,27 @@ let rec poison t =
Awaitable.broadcast t
else poison t

let acquire t =
let[@inline] acquire t =
let prior = Awaitable.fetch_and_add t locked in
if locked <= prior then
let rec acquire_awaiting t before =
if before < locked then begin
(* We know [before] is [0] or [no_awaiters]. *)
let after = locked land lnot no_awaiters in
if not (Awaitable.compare_and_set t before after) then
acquire_awaiting t (Awaitable.get t)
end
else if locked_permanently / 2 <= before then raise Poisoned
else
let after = before land lnot no_awaiters in
if before = after || Awaitable.compare_and_set t before after then
Awaitable.await t after;
acquire_awaiting t (Awaitable.get t)
in
let rec acquire_contended t before =
let[@inline never] rec acquire_contended t before =
if locked * 2 <= before then
let after = (before - locked) land lnot no_awaiters in
if Awaitable.compare_and_set t before after then
let rec acquire_awaiting t before =
if before < locked then begin
(* We know [before] is [0] or [no_awaiters]. *)
let after = locked land lnot no_awaiters in
if not (Awaitable.compare_and_set t before after) then
acquire_awaiting t (Awaitable.get t)
end
else if locked_permanently / 2 <= before then raise Poisoned
else
let after = before land lnot no_awaiters in
if before = after || Awaitable.compare_and_set t before after then
Awaitable.await t after;
acquire_awaiting t (Awaitable.get t)
in
acquire_awaiting t after
else acquire_contended t (Awaitable.get t)
in
Expand Down
34 changes: 17 additions & 17 deletions lib/picos_std.sync/sem.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,28 +36,28 @@ let release t =
in
signal_awaiter t (prior + one)

let acquire t =
let[@inline] acquire t =
let prior = Awaitable.fetch_and_add t (-one) in
if prior < one then
let rec acquire_awaiting t before =
if one <= before then begin
let after = (before - one) land lnot no_awaiters in
if Awaitable.compare_and_set t before after then begin
if one <= after then Awaitable.signal t
end
else acquire_awaiting t (Awaitable.get t)
end
else if before < -poisoned / 2 then raise Poisoned
else
let after = before land lnot no_awaiters in
if before = after || Awaitable.compare_and_set t before after then
Awaitable.await t after;
acquire_awaiting t (Awaitable.get t)
in
let rec acquire_contended t before =
let[@inline never] rec acquire_contended t before =
if before <= -one lor no_awaiters then
let after = (before + one) land lnot no_awaiters in
if Awaitable.compare_and_set t before after then
let rec acquire_awaiting t before =
if one <= before then begin
let after = (before - one) land lnot no_awaiters in
if Awaitable.compare_and_set t before after then begin
if one <= after then Awaitable.signal t
end
else acquire_awaiting t (Awaitable.get t)
end
else if before < -poisoned / 2 then raise Poisoned
else
let after = before land lnot no_awaiters in
if before = after || Awaitable.compare_and_set t before after then
Awaitable.await t after;
acquire_awaiting t (Awaitable.get t)
in
acquire_awaiting t after
else acquire_contended t (Awaitable.get t)
in
Expand Down