Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 70 lines (58 sloc) 2.017 kb
6d591e2 Johan Tibell 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 Johan Tibell Take the number of threads from the command line
authored
6 import Args (ljust, parseArgs, positive, theLast)
a804823 Bryan O'Sullivan A simple static HTTP server.
bos authored
7 import Control.Concurrent (forkIO, runInUnboundThread)
6d591e2 Johan Tibell Added a new benchmark for threadDelay
authored
8 import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
9 import Control.Monad (when)
ef6ec77 Johan Tibell Take the number of threads from the command line
authored
10 import Data.Function (on)
11 import Data.Monoid (Monoid(..), Last(..))
6d591e2 Johan Tibell Added a new benchmark for threadDelay
authored
12 import Data.IORef (atomicModifyIORef, newIORef)
ef6ec77 Johan Tibell Take the number of threads from the command line
authored
13 import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(..))
14 import System.Environment (getArgs)
6d591e2 Johan Tibell Added a new benchmark for threadDelay
authored
15 import System.Event.Thread (ensureIOManagerIsRunning)
16
c399be7 Johan Tibell Make it easier to compare the old and the new I/O manager in benchmarks
authored
17 #ifdef USE_GHC_IO_MANAGER
6d591e2 Johan Tibell Added a new benchmark for threadDelay
authored
18 import Control.Concurrent (threadDelay)
c399be7 Johan Tibell 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 Johan Tibell Added a new benchmark for threadDelay
authored
21 #endif
22
23 main = do
ef6ec77 Johan Tibell Take the number of threads from the command line
authored
24 (cfg, _) <- parseArgs defaultConfig defaultOptions =<< getArgs
25 let numThreads = theLast cfgNumThreads cfg
26
6d591e2 Johan Tibell 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 Johan Tibell 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 Johan Tibell Added a new benchmark for threadDelay
authored
38 loop (i + 1)
a804823 Bryan O'Sullivan A simple static HTTP server.
bos authored
39 runInUnboundThread $ loop 0 >> takeMVar done
ef6ec77 Johan Tibell Take the number of threads from the command line
authored
40
41 ------------------------------------------------------------------------
42 -- Configuration
43
44 data Config = Config {
45 cfgNumThreads :: Last Int
46 }
47
48 defaultConfig :: Config
49 defaultConfig = Config
50 { cfgNumThreads = ljust 1000
51 }
52
53 instance Monoid Config where
54 mempty = Config
55 { cfgNumThreads = mempty
56 }
57
58 mappend a b = Config
59 { cfgNumThreads = app cfgNumThreads a b
60 }
61 where app = on mappend
62
63 defaultOptions :: [OptDescr (IO Config)]
64 defaultOptions = [
65 Option ['n'] ["threads"]
66 (ReqArg (positive "number of threads" $ \n ->
67 mempty { cfgNumThreads = n }) "N")
68 "number of threads"
69 ]
Something went wrong with that request. Please try again.