The Computer Language
Benchmarks Game

thread-ring OCaml #2 program

(* The Computer Language Benchmarks Game
 * http://benchmarksgame.alioth.debian.org/
   contributed by Tomasz bla Fortuna *)

let size = 503
and n = int_of_string Sys.argv.(1)

type channel = { m : Mutex.t; d : int ref }
let channel () =
  let mx = Mutex.create () in Mutex.lock mx;
  { m = mx; d = ref 0}

let rec spawn id i o loop () =
  let rec thread () =
    Mutex.lock i.m;
    if !(i.d) = n then (
      print_int (size-id+1); print_newline (); exit 0;
    );
    o.d := !(i.d) + 1;  (* Forward token *)
    Mutex.unlock o.m;
    thread ()
  in
  if id > 1 then (
    let new_o = if id = 2 then loop else channel () in
    let f = spawn (id-1) o new_o loop in
    ignore (Thread.create f ())
  );
  thread ()

let _ =
  let loop, o = channel (), channel () in
  Mutex.unlock loop.m;
  Thread.join (Thread.create (spawn size loop o loop) ())
    

NOTES:
64-bit Ubuntu quad core
The OCaml native-code compiler, version 4.06.0


Sun, 05 Nov 2017 22:29:45 GMT

MAKE:
mv threadring.ocaml-2.ocaml threadring.ocaml-2.ml
/opt/src/ocaml-4.06.0/bin/ocamlopt -noassert -unsafe -fPIC -nodynlink -inline 100 -O3 -thread unix.cmxa threads.cmxa threadring.ocaml-2.ml -o threadring.ocaml-2.ocaml_run
rm threadring.ocaml-2.ml

0.23s to complete and log all make actions

COMMAND LINE:
./threadring.ocaml-2.ocaml_run 50000000

PROGRAM OUTPUT:
292