Synchronized threads, part II

Submitted by mrd on Fri, 01/05/2007 - 6:34pm.
::

For comparison, here is an implementation of multiple threads of which each attempt to perform as many steps as possible in 1 second.


> import Control.Monad > import Control.Concurrent > import Control.Concurrent.STM > import Data.List > import Data.IORef > import System.Time > import System.Environment > import System.IO > import System.Random > import Text.Printf > import Ratio

oneThread greedily attempts to loop through as many steps as possible until one second has elapsed. Then it blocks while it waits for the main thread to collect the previous result, so it can put the new result in the TMVar. Every step it takes, it executes the supplied function parameter f.

> oneThread :: TMVar Int -> Int -> a -> (a -> a) -> IO () > oneThread mvar n v f = do > TOD s ps <- getClockTime > loop (fromIntegral s + ps%(10^12)) n n v > where > loop prevTime prevN n v = do > TOD s ps <- getClockTime > let now = fromIntegral s + ps%(10^12) > tdiff = now - prevTime > ndiff = fromIntegral $ n - prevN > sps = floor (ndiff / tdiff) > v' = f v > if tdiff >= 1 then > do atomically $ putTMVar mvar sps > loop now n n v > else v' `seq` loop prevTime prevN (n + 1) v'

nosync is akin to sync in that it is an STM action which collects results from all the threads via the TMVars. Again, the key portion is easy: mapM takeTMVar mvars.

> nosync :: (Num a, Ord a) => [TMVar a] -> STM (a, a) > nosync mvars = do > vals <- mapM takeTMVar mvars > return $ (maximum vals, sum vals)
> initialize :: Int -> a -> (a -> a) -> IO ([ThreadId], [TMVar Int]) > initialize k v f = do > mvars <- atomically (forM [1..k] > (\_ -> newEmptyTMVar)) > thds <- forM (zip mvars [1..k]) > (\(ch, n) -> forkIO (oneThread ch 0 v f)) > return (thds, mvars)

nosyncLoop waits for all the threads to place a value into their TMVar, which will happen after one second.

> nosyncLoop :: [TMVar Int] -> IO () > nosyncLoop mvars = do > (best, sum) <- atomically $ nosync mvars > printf "Best steps / second = %d; Sum steps / second = %d\n" best sum > hFlush stdout > nosyncLoop mvars

A computational time-waster to simulate "real work".

> computation l = let (v:l') = l > in fact v `seq` l' > > fact n = product [1..n]
> main :: IO () > main = do > args <- getArgs > let n = case args of > [] -> 10 > a:_ -> read a > g <- newStdGen > (_,mvars) <- initialize n (randomRs (500,600) g) computation > nosyncLoop mvars

System is a 4-way Xeon 3.6GHz.


[mrd@system ~]$ ghc --make -O2 -threaded Unsync.lhs

[mrd@system ~]$ ./Unsync 1 +RTS -N1 Best steps / second = 3179; Sum steps / second = 3179 Best steps / second = 3181; Sum steps / second = 3181 Best steps / second = 3178; Sum steps / second = 3178 Best steps / second = 3175; Sum steps / second = 3175 Best steps / second = 3174; Sum steps / second = 3174 [mrd@system ~]$ ./Unsync 1 +RTS -N2 Best steps / second = 3142; Sum steps / second = 3142 Best steps / second = 3168; Sum steps / second = 3168 Best steps / second = 3174; Sum steps / second = 3174 Best steps / second = 3177; Sum steps / second = 3177 Best steps / second = 3172; Sum steps / second = 3172

[mrd@system ~]$ ./Unsync 5 +RTS -N1 Best steps / second = 635; Sum steps / second = 3071 Best steps / second = 638; Sum steps / second = 3094 Best steps / second = 668; Sum steps / second = 3080 Best steps / second = 669; Sum steps / second = 3184 Best steps / second = 751; Sum steps / second = 3181 [mrd@system ~]$ ./Unsync 5 +RTS -N2 Best steps / second = 1429; Sum steps / second = 5601 Best steps / second = 1434; Sum steps / second = 5647 Best steps / second = 1446; Sum steps / second = 5647 Best steps / second = 1413; Sum steps / second = 5647 Best steps / second = 1502; Sum steps / second = 5639 [mrd@system ~]$ ./Unsync 5 +RTS -N3 Best steps / second = 1912; Sum steps / second = 5792 Best steps / second = 2092; Sum steps / second = 5934 Best steps / second = 2107; Sum steps / second = 5938 Best steps / second = 1959; Sum steps / second = 5922 Best steps / second = 2068; Sum steps / second = 5960 [mrd@system ~]$ ./Unsync 5 +RTS -N4 Best steps / second = 1876; Sum steps / second = 7428 Best steps / second = 1865; Sum steps / second = 7402 Best steps / second = 1891; Sum steps / second = 7420 Best steps / second = 1895; Sum steps / second = 7581 Best steps / second = 1899; Sum steps / second = 7602

[mrd@system ~]$ ./Unsync 10 +RTS -N1 Best steps / second = 334; Sum steps / second = 2852 Best steps / second = 332; Sum steps / second = 3100 Best steps / second = 334; Sum steps / second = 3082 Best steps / second = 335; Sum steps / second = 3176 Best steps / second = 335; Sum steps / second = 3186 [mrd@system ~]$ ./Unsync 10 +RTS -N2 Best steps / second = 594; Sum steps / second = 5577 Best steps / second = 669; Sum steps / second = 5631 Best steps / second = 588; Sum steps / second = 5641 Best steps / second = 622; Sum steps / second = 5657 Best steps / second = 604; Sum steps / second = 5639 [mrd@system ~]$ ./Unsync 10 +RTS -N3 Best steps / second = 702; Sum steps / second = 5846 Best steps / second = 692; Sum steps / second = 5865 Best steps / second = 717; Sum steps / second = 5884 Best steps / second = 679; Sum steps / second = 5893 Best steps / second = 745; Sum steps / second = 5913 [mrd@system ~]$ ./Unsync 10 +RTS -N4 Best steps / second = 949; Sum steps / second = 7133 Best steps / second = 958; Sum steps / second = 7198 Best steps / second = 989; Sum steps / second = 7189 Best steps / second = 906; Sum steps / second = 7155 Best steps / second = 964; Sum steps / second = 7181

Observations

Number of steps is proportional to number of processors, and inversely proportional to number of threads.