
On 12/16/05, Peter Eriksen
Greeting,
Something is not working for me, and I could use some more eyes on this. What I'm trying to accomplish is to implement a simpel barrier for ten worker threads (id = 0..9) using STM. With or without the barrier, the program produces an unordered interleaving of the output from the workers. Here's what I get with the program below:
$ ghc --make Main.lhs $ a.out 0134568027913457896012579026813423904671238455702468159367839684012570279134685049137825901642375689134057892610462578903156012389473268457910267801345923924567801304689235714013679458256702465913878...
And here's what I get without the line "atomically $ barrier tv id":
$ a.out 1249056782934567210845619720538461975203698469175203469850123485076912348579406123894625738942106381592740631859274163841092315768491302578416930728254169302785693024917853029640217390856490...
The first run should've been something like: 012345678901234567890123456789012345... since each worker thread 0..9 should write its id out once per iteration, and the workers should iterate in sync.
Here's the code:
module Main where
import Control.Concurrent import Control.Concurrent.STM import System.Random
worker :: Int -> TVar Int -> IO () worker id tv = do sleepingTime <- randomRIO (0, 50000) threadDelay sleepingTime putStr $ show id
You're printing the ID after a random sleep. Shouldn't be a big surprise that the output will be shuffled.
atomically $ barrier tv id
If you move 'putStr $ show id' down below the barrier then it'll behave like you want it to.
worker id tv
Each worker sleeps for some time, then outputs its id and waits at the barrier for all the other workers to finish their sleep+output.
barrier :: TVar Int -> Int -> STM () barrier tv id = do passed <- readTVar tv if (passed `mod` 10 == id) then writeTVar tv (passed+1) else retry
The barrier is simply a global variable, tv, which holds the number of times any worker passed the barrier. Now, a worker may only pass the barrier iff the worker with an id one less just passed, or else it should block.
main :: IO () main = do tv <- atomically $ newTVar 0 for [0..9] $ \i -> forkIO $ worker i tv threadDelay (10*10^6)
for = flip mapM_
-- Friendly, Lemmih