(* remember to compile with ocamlc -vmthread threads.cma 
   with any other options between the -vmthread and the threads.cma 
   CSE505 Fall 2007, lec14.ml *)
open Thread 

(* equivalence example *)

let x, y = ref 0, ref 0
let _ = create (fun () -> if (!y)=1 then x:=(!x)+1) ()
let _ = create (fun () -> if (!x)=1 then y:=(!y)+1) () (* 1 *)
let _ = create (fun () -> y:=(!y)+1; if (!x)<>1 then y:=(!y)-1) ()

(* fork-join pattern *)

(* val fork_join :
  ('a -> 'b array) -> ('b -> 'c) -> ('c array -> 'd) -> 'a -> 'd *)
let fork_join chunker processor merger data =
  let input_array  = chunker data in
  let len          = Array.length input_array in
  let output_array = Array.make len None in
  let thread_array = 
    Array.mapi (fun index chunk ->
                 Thread.create (fun () -> 
		   Array.set output_array index (Some(processor chunk))) ())
               input_array in
  let _ = Array.iter join thread_array in (* must wait! *)
  merger (Array.map (fun (Some x) -> x) output_array)

type acct = { lk : Mutex.t;
              bal : float ref;
              avail : float ref}
let mkAcct () =
  {lk=Mutex.create(); bal=ref 0.0; avail=ref 0.0}

let get a f = 
  Mutex.lock a.lk;
  (if(!(a.avail) > f)
  then (a.bal := !(a.bal) -. f; 
        a.avail := !(a.avail) -.f));
  Mutex.unlock a.lk

let put a f =
  Mutex.lock a.lk;
  a.bal := !(a.bal) +. f;
  a.avail := !(a.avail) +.(if f < 500. then f else 500.);
  Mutex.unlock a.lk

let xferRace1 a1 a2 f =
  get a1 f;
  put a2 f

let xferRace2 a1 a2 f =
  put a2 f;
  get a1 f

let xferDeadlock a1 a2 f =
  Mutex.lock a1.lk;
  Mutex.lock a2.lk;
  a1.bal   := !(a1.bal)   -. f; 
  a1.avail := !(a1.avail) -. f;
  a2.bal   := !(a2.bal)   +. f;
  Mutex.unlock a2.lk;
  Mutex.unlock a1.lk