Skip to content

Commit

Permalink
More performance tweaks
Browse files Browse the repository at this point in the history
  • Loading branch information
polytypic committed Nov 28, 2024
1 parent 84d5428 commit 31147a2
Showing 1 changed file with 14 additions and 10 deletions.
24 changes: 14 additions & 10 deletions lib/picos/picos.ocaml5.ml
Original file line number Diff line number Diff line change
Expand Up @@ -10,21 +10,25 @@ module Trigger = struct

and t = state Atomic.t

let finish t ~allow_awaiting =
let finish t ~run_action =
match Atomic.get t with
| Signaled -> ()
| Awaiting r as before ->
if allow_awaiting then begin
if Atomic.compare_and_set t before Signaled then r.action t r.x r.y
end
else error_awaiting before
if
Bool.to_int (Atomic.compare_and_set t before Signaled)
land Bool.to_int run_action
!= 0
then r.action t r.x r.y
| Initial ->
if not (Atomic.compare_and_set t Initial Signaled) then begin
match Atomic.get t with
| Signaled | Initial -> ()
| Awaiting r as before ->
if allow_awaiting && Atomic.compare_and_set t before Signaled then
r.action t r.x r.y
if
Bool.to_int (Atomic.compare_and_set t before Signaled)
land Bool.to_int run_action
!= 0
then r.action t r.x r.y
end

let on_signal t x y action =
Expand Down Expand Up @@ -52,8 +56,8 @@ module Trigger = struct

let[@inline] from_action x y action = Atomic.make (Awaiting { action; x; y })
let[@inline] is_signaled t = Atomic.get t == Signaled
let[@inline] signal t = finish t ~allow_awaiting:true
let[@inline] dispose t = finish t ~allow_awaiting:false
let[@inline] signal t = finish t ~run_action:true
let[@inline] dispose t = finish t ~run_action:false

(* END TRIGGER BOOTSTRAP *)

Expand Down Expand Up @@ -293,7 +297,7 @@ module Computation = struct
end

let detach t trigger =
Trigger.signal trigger;
Trigger.dispose trigger;
unsafe_unsuspend t Backoff.default |> ignore

(** This cannot be [@@unboxed] because [Atomic.t] is opaque *)
Expand Down

0 comments on commit 31147a2

Please sign in to comment.