mcas_volatile.ml MCAS Algorithm Core
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