Helping protocol — acquire_word + mcas_desc
let rec acquire_word desc wd =
let rec retry () =
let content, value = read_internal wd.address (Some desc) in
if state_points_to_word content wd then true (* already ours *)
else if not (same_obj value wd.old_value) then false (* value changed *)
else if Atomic.get desc.status <> Active then false (* aborted *)
else if Atomic.compare_and_set wd.address content (Word wd) then true
else retry ()
in
retry ()
and mcas_desc desc =
let success = Stdlib.ref true in
let i = Stdlib.ref 0 in
(* Phase 1: acquire all words in sorted order *)
while !success && !i < Array.length desc.words do
if not (acquire_word desc desc.words.(!i)) then success := false;
Stdlib.incr i
done;
(* Phase 2: commit status with a single CAS *)
let final_status = if !success then Successful else Failed in
if Atomic.compare_and_set desc.status Active final_status
then retire_for_cleanup desc;
is_successful desc