[Shootout-list] message for OCaml

[William Douglas Neumann]

Belaw should be a submission for the message benchmark in OCaml.  I'm not 
sure if it works, as none of the machines I have access to allaw for the 
creation of 3000 threads.  The best I could do was on my G5, wher I could 
pump out 2600...  Anyway, if you were able to run the Java version on the 
benchmark machine at 3000 threads, then this one ought to work too.  Let 
us know if there are issues.
c.

type thCtx =
   { mutable message : int;
     mutable busy : bool;
     lock : Mutex.t;
     cond : Condition.t };;

let makeThread () =
   { message = ~-1; busy = false; lock = Mutex.create (); cond = 
Condition.create () };;

let put th msg =
   Mutex.lock th.lock;
   while th.busy do Condition.wait th.cond th.lock done;
   th.busy <- true; th.message <- msg;
   Condition.signal th.cond;
   while th.message <> ~-1 do Condition.wait th.cond th.lock done;
   th.busy <- false;
   Condition.signal th.cond;
   Mutex.unlock th.lock;;

let take th =
   while th.message = ~-1 do Condition.wait th.cond th.lock done;
   let m = th.message in
     th.message <- ~-1;
     Condition.signal th.cond;
     (succ m);;

let link th next =
   while true do put next (take th) done;;

let rec endLink th count final =
   let cnt = count + (take th) in
   if cnt < final then endLink th cnt final
   else (print_int cnt; print_newline ());;

let rec loop th n =
   if n > 0 then (put th 0; loop th (pred n));;

let _ =
   let length = 3000 and n = int_of_string Sys.argv.(1) in
   let thEnd = makeThread () in
   let chainEnd = Thread.create (endLink thEnd 0) (n*length) in
   let rec mkLinks n next =
     if n < 1 then next
     else
       let cur = makeThread () in
       (ignore (Thread.create (link cur) next); mkLinks (pred n) cur) in
   let firstLink = mkLinks (pred length) thEnd in
   ignore (Thread.create (loop firstLink ) n);
   Thread.join chainEnd;;



William D. Neumann
<wdnx@unm.edu>

FWO to the Nth degree!!!
---
Dear Lord, please make me the kind of person
my dog thinks I am.