(* $Id: netplex_mutex.ml 1460 2010-06-03 12:12:02Z gerd $ *)

open Netplex_types

let plugin = Netplex_semaphore.plugin

type mutex = string

(* The #s semaphore reflects the state: 
     0 = unlocked, 1 = locked

   The #w semaphore reflects the locking resource:
     0 = cannot be locked, 1 = can be locked
 *)

let access name =
  let _ = Netplex_semaphore.create ~protected:true (name ^ "#w") 1L in
  let _ = Netplex_semaphore.create ~protected:true (name ^ "#s") 0L in
     (* The second [create] is superflous - this would implicitly happen 
        at first access time
      *)
  name

let lock name =
  let w = Netplex_semaphore.decrement ~wait:true (name ^ "#w") in
  (* Netlog.logf `Debug "lock: w=%Ld" w; *)
  assert(w = 0L);
  let s = Netplex_semaphore.increment (name ^ "#s") in
  (* Netlog.logf `Debug "lock: s=%Ld" s; *)
  assert(s = 1L)

let unlock name =
  let s = Netplex_semaphore.decrement (name ^ "#s") in  (* no wait! *)
  (* Netlog.logf `Debug "unlock: s=%Ld" s; *)
  if (s >= 0L) then (
    assert(s = 0L);
    let w = Netplex_semaphore.increment (name ^ "#w") in
    (* Netlog.logf `Debug "unlock: w=%Ld" w; *)
    assert(w = 1L)
  )