Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 71 lines (59 sloc) 1.977 kb
6d591e2 @tibbe Added a new benchmark for threadDelay
authored
1 {-# LANGUAGE CPP #-}
2
3 -- Benchmark 'threadDelay' by forking N threads which sleep for a
4 -- number of milliseconds and wait for them all to finish.
5
ef6ec77 @tibbe Take the number of threads from the command line
authored
6 import Args (ljust, parseArgs, positive, theLast)
6d591e2 @tibbe Added a new benchmark for threadDelay
authored
7 import Control.Concurrent (forkIO)
8 import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
9 import Control.Monad (when)
ef6ec77 @tibbe Take the number of threads from the command line
authored
10 import Data.Function (on)
11 import Data.Monoid (Monoid(..), Last(..))
6d591e2 @tibbe Added a new benchmark for threadDelay
authored
12 import Data.IORef (atomicModifyIORef, newIORef)
ef6ec77 @tibbe Take the number of threads from the command line
authored
13 import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(..))
14 import System.Environment (getArgs)
6d591e2 @tibbe Added a new benchmark for threadDelay
authored
15 import System.Event.Thread (ensureIOManagerIsRunning)
16
c399be7 @tibbe Make it easier to compare the old and the new I/O manager in benchmarks
authored
17 #ifdef USE_GHC_IO_MANAGER
6d591e2 @tibbe Added a new benchmark for threadDelay
authored
18 import Control.Concurrent (threadDelay)
c399be7 @tibbe Make it easier to compare the old and the new I/O manager in benchmarks
authored
19 #else
20 import System.Event.Thread (threadDelay)
6d591e2 @tibbe Added a new benchmark for threadDelay
authored
21 #endif
22
23 main = do
ef6ec77 @tibbe Take the number of threads from the command line
authored
24 (cfg, _) <- parseArgs defaultConfig defaultOptions =<< getArgs
25 let numThreads = theLast cfgNumThreads cfg
26
6d591e2 @tibbe Added a new benchmark for threadDelay
authored
27 ensureIOManagerIsRunning
28 done <- newEmptyMVar
29 ref <- newIORef 0
30 let loop :: Int -> IO ()
31 loop i = do
32 when (i < numThreads) $ do
8c18842 @tibbe Minor clean-ups
authored
33 _ <- forkIO $ do
34 threadDelay 1000
35 a <- atomicModifyIORef ref $ \a ->
36 let !b = a+1 in (b,b)
37 when (a == numThreads) $ putMVar done ()
6d591e2 @tibbe Added a new benchmark for threadDelay
authored
38 loop (i + 1)
39 loop 0
40 takeMVar done
ef6ec77 @tibbe Take the number of threads from the command line
authored
41
42 ------------------------------------------------------------------------
43 -- Configuration
44
45 data Config = Config {
46 cfgNumThreads :: Last Int
47 }
48
49 defaultConfig :: Config
50 defaultConfig = Config
51 { cfgNumThreads = ljust 1000
52 }
53
54 instance Monoid Config where
55 mempty = Config
56 { cfgNumThreads = mempty
57 }
58
59 mappend a b = Config
60 { cfgNumThreads = app cfgNumThreads a b
61 }
62 where app = on mappend
63
64 defaultOptions :: [OptDescr (IO Config)]
65 defaultOptions = [
66 Option ['n'] ["threads"]
67 (ReqArg (positive "number of threads" $ \n ->
68 mempty { cfgNumThreads = n }) "N")
69 "number of threads"
70 ]
Something went wrong with that request. Please try again.