[Shootout-list] Process for OCaml

[William Douglas Neumann]

On Fri, 17 Dec 2004, William Douglas Neumann wrote:

> Below is the OCaml submission for the process benchmark.  As with the message 
> benchmark

Meh... it seems as if that previous version would occasionally fail to 
terminate (plus it had an unused function I forgot to cut out).  The 
version below *seems* to work properly (reread my caveat regarding 
concurrent programming).

(* process.ml :
   Requires the threads and unix libraries, so compile with something like
     ocamlopt  -I +threads unix.cmxa threads.cmxa process.ml -o process
*)

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 run =
   if not run then (print_int (take th); print_newline (); endLink th 
true);;

let _ =
   let n = int_of_string Sys.argv.(1) in
   let thEnd = makeThread () in
   let chainEnd = Thread.create (endLink thEnd) false 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 n) thEnd in
   put firstLink 0;
   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.