Benchmarks Game/Parallel/ThreadRing

ThreadRing

http://shootout.alioth.debian.org/u64q/benchmark.php?test=threadring&lang=all

This benchmark measure how effectively you can schedule threads. A parallel version partitions the ring of threads over the cpus equally, and prevents redundant migrations.

Current entry

Submitted: http://alioth.debian.org/tracker/index.php?func=detail&aid=311058&group_id=30402&atid=411646

Compile flags: ghc -O2 -threaded A.hs --make Runtime flags: +RTS -N4 -qm -qw

-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
-- Contributed by Jed Brown with improvements by Spencer Janssen and Don Stewart
--
-- 503 threads are created with forkOnIO, with each thread
-- creating one synchronised mutable variable (MVar) shared with the
-- next thread in the ring. The last thread created returns an MVar to
-- share with the first thread. Each thread reads from the MVar to its
-- left, and writes to the MVar to its right.
--
-- Each thread then waits on a token to be passed from its neighbour.
-- Tokens are then passed around the threads via the MVar chain N times, 
-- and the thread id of the final thread to receive a token is printed.
--
-- More information on Haskell concurrency and parallelism:
--   http://www.haskell.org/ghc/dist/current/docs/users_guide/lang-parallel.html
--
-- SMP parallelisation strategy is to partition the ring equally over each capability.
--

import Control.Monad
import Control.Concurrent
import System.Environment
import GHC.Conc

ring = 503

new l i = do
  r <- newEmptyMVar
  forkOnIO n (thread i l r)
  return r
 where
  n | i < 125   = 0
    | i < 250   = 1
    | i < 375   = 2
    | otherwise = 3


thread :: Int -> MVar Int -> MVar Int -> IO ()
thread i l r = go
  where go = do
          m <- takeMVar l
          when (m == 1) (print i)
          putMVar r $! m - 1
          when (m > 0) go

main = do
  a <- newMVar . read . head =<< getArgs
  z <- foldM new a [2..ring]
  thread 1 z a