Re: [Haskell-cafe] Re: GHC threads and SMP

ninegua:

replying to my own message... the behavior is only when -O is used during compilation, otherwise they both run on 2 cores but at a much lower (1/100) speed.

Hmm, any change with -O2? Is the optimiser changing the code such that the scheduler doesn't get to switch threads as often? If you change the thread scheduler switching rate does that change anything? See the GHC user's guide for more details: 7.12.1.3.�Scheduling policy for concurrent threads Runnable threads are scheduled in round-robin fashion. Context switches are signalled by the generation of new sparks or by the expiry of a virtual timer (the timer interval is configurable with the -C[<num>] RTS option). However, a context switch doesn't really happen until the current heap block is full. You can't get any faster context switching than this. When a context switch occurs, pending sparks which have not already been reduced to weak head normal form are turned into new threads. However, there is a limit to the number of active threads (runnable or blocked) which are allowed at any given time. This limit can be adjusted with the -t <num> RTS option (the default is 32). Once the thread limit is reached, any remaining sparks are deferred until some of the currently active threads are completed. Perhaps SimonM can shed some light here?

On 7/6/07, Paul L wrote:

...

I have two parallel algorithms that use the lightweight GHC thread and forkIO. I compile them using the -threaded (or -smp) option, and run both with +RTS -N2 -RTS command line option.

QSort is able to make use of the dual cores on my laptop -- "top" shows that two threads show up and both CPUs are utilized, and "time" it will give something like this:

real 0m0.502s user 0m0.872s sys 0m0.004s

But Prime can only make use of one core, as shown by "top". "time" gives

real 0m9.112s user 0m9.093s sys 0m0.028s

Because forkOS is not used anywhere, the decision of running them on 1 or 2 OS threads seem rather arbitary. Why?

Regards, Paul L

...

import Control.Concurrent import System.Random import Data.Array.MArray import Data.Array.IO import System.IO.Unsafe import Control.Exception

1. Quick Sort

...

testQSort' n verbose = do let b = (0, n - 1) arr <- newArray b 0 :: IO (IOUArray Int Int) initM' (mkStdGen 0) b arr waitForChildren qsortM' b arr waitForChildren if verbose then getElems arr >>= putStrLn . show else return ()

Initialize an array with random numbers.

...

initM' g (i, j) arr | j - i < 10000 = fillArr g i j where fillArr g i j = if i > j then return () else do let (v, g') = next g writeArray arr i v >> fillArr g' (i + 1) j initM' g (i, j) arr = do let k = (i + j) `div` 2 (g1, g2) = split g forkChild $ initM' g1 (i, k) arr forkChild $ initM' g2 (k + 1, j) arr return ()

...

qsortM' (i, j) arr = qsort' (i, j) where qsort' (i, j) = if j <= i then return () else do k <- split i j if j - i > 10000 then (forkChild $ qsort' (i, k - 1)) >> return () else qsort' (i, k - 1) qsort' (k + 1, j) split left right = do v <- readArray arr right let split' i j = if j == right then swap i right v >> return i else do b <- readArray arr j if b <= v then (swap i j b) >> split' (i + 1) (j + 1) else split' i (j + 1) split' left left swap i j b = do a <- readArray arr i writeArray arr i b writeArray arr j a

2. Prime

...

testPrime' n verbose = do arr <- newArray (0, n) True :: IO (IOUArray Int Bool) primeM' arr n waitForChildren if verbose then getElems arr >>= putStrLn . show . map fst . filter snd . zip [0..] else return ()

...

primeM' arr n = do let p = truncate $ sqrt (fromIntegral n) + 1 remove i = if i > p then return () else do spawnRemover (i + 1) remove' (i + i) where remove' j = if j > n then return () else do writeArray arr j False remove' (j + i) spawnRemover j = if j > n then return () else do t <- readArray arr j if t then forkChild (remove j) else spawnRemover (j + 1) remove 2

Manage thread termination

...

children :: MVar [MVar ()] children = unsafePerformIO (newMVar [])

...

waitForChildren :: IO () waitForChildren = do cs <- takeMVar children case cs of [] -> putMVar children cs m:ms -> do putMVar children ms takeMVar m waitForChildren

forkChild :: IO () -> IO () forkChild io = do mvar <- newEmptyMVar childs <- takeMVar children putMVar children (mvar:childs) forkIO (io `finally` putMVar mvar ()) return ()

_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe