Main.hs 2.24 KB
Newer Older
1
{-# OPTIONS_GHC -O2 #-}
2
import System.IO
3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
import System.Environment
import System.CPUTime
import Text.Printf
import Control.Monad
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Exception

{-
This test creates a number of threads in blocked mode, and then calls
killThread on each one in turn.  Since the threads are in blocked
mode, none of the killThreads can complete until the target thread has
exited, so this tests thread creation/completion as well as throwTo
blocking/unblocking performance.

On a 1.86GHz Intel Xeon, with GHC 6.10.1 -threaded

./Main 300000 +RTS -s 
     338,144,560 bytes allocated in the heap
   1,232,944,856 bytes copied during GC
     307,446,192 bytes maximum residency (9 sample(s))
     109,796,160 bytes maximum slop
             786 MB total memory in use (12 MB lost due to fragmentation)

  Generation 0:   640 collections,     0 parallel,  2.42s,  2.44s elapsed
  Generation 1:     9 collections,     0 parallel,  0.63s,  1.22s elapsed

  INIT  time    0.00s  (  0.00s elapsed)
  MUT   time    7.64s  (  7.75s elapsed)
  GC    time    3.05s  (  3.65s elapsed)
  EXIT  time    0.04s  (  0.04s elapsed)
  Total time   10.73s  ( 11.44s elapsed)

HEAD 7/1/2009 + patch to use HpLim for context-switching:

./Main 300000 +RTS -s 
     354,865,480 bytes allocated in the heap
   1,229,475,576 bytes copied during GC
     306,480,832 bytes maximum residency (9 sample(s))
     109,806,448 bytes maximum slop
             780 MB total memory in use (13 MB lost due to fragmentation)

  Generation 0:   643 collections,     0 parallel,  2.53s,  2.56s elapsed
  Generation 1:     9 collections,     0 parallel,  0.66s,  1.27s elapsed

  INIT  time    0.00s  (  0.00s elapsed)
  MUT   time    1.06s  (  1.06s elapsed)
  GC    time    3.19s  (  3.83s elapsed)
  EXIT  time    0.04s  (  0.04s elapsed)
  Total time    4.28s  (  4.93s elapsed)

(probably this is mostly due to not context-switching after forkIO)

-}

main :: IO ()
main = do
    hSetBuffering stdout NoBuffering
    [nthreads] <- fmap (map read) getArgs
duog's avatar
duog committed
62
    tids <- replicateM nthreads . mask_ $ forkIO $ return ()
63 64 65 66 67
    m <- newEmptyMVar
    -- do it in a subthread to avoid bound-thread overhead
    forkIO $ do mapM_ killThread tids; putMVar m ()
    takeMVar m
    return ()