Checkpoint synchronization: Difference between revisions

Added Haskell version with concurrency
(Added BBC BASIC)
(Added Haskell version with concurrency)
Line 633:
main = workshop sum tasks
</lang>
<p>This other example works using the concurrent model of the module Control.Concurrent.</p>
<p>A workshop is a list of actions. Each action is carried out by one worker. In this example, every action is simply repeated forever, but actions could also consist of a list of different actions that are to be carried out by the same worker.</p>
<p>The workers communicate with each other using an MVar, which holds in this case the number of active workers, the number of workers that have finished and the total number of workers.</p>
<p>The function "shop" sets the MVar up and forks a thread for each worker (forkIO). It returns the unique ID number of each thread (a ThreadId), so that the threads can be killed easily.</p>
<p>The function "worker" represents a worker. For each of the worker's actions, the following steps are taken:</p>
<ul>
<li>First, the worker joins the workshop. The counters are updated.</li>
<li>Then, the worker performs one action.</li>
<li>After that, the worker leaves the workshop. The counters are updated.</li>
<li>Finally, the worker calls "checkPoint". The worker returns from "checkPoint" when the other workers have finished. Only then the (next) action is started/repeated.</li>
</ul>
<p>The functions "joinWorkshop" and "leaveWorkshop" update the MVar that counts the number of workers. They also take a ThreadId number in order to put on the screen what worker has just joined or left, but this is not necessary.</p>
<p>The function "checkPoint" is called from each worker. It checks the values of the MVar:</p>
<ul>
<li>If no workers are active and all have already left the workshop, that means that all of them are ready to carry out the next action. A message is shown on the screen and the counters are set to the initial state. The function returns, so the worker can resume operation.</li>
<li>If the number of active and waiting workers is zero, this means that the worker can join the workshop to resume operation, so the function returns immediately because there is nobody to wait for.</li>
<li>Otherwise, there must be workers that haven't finished yet, so the function loops (checking/waiting state).</li>
</ul>
<p>It is important to notice that:</p>
<ul>
<li>This code only works on GHC due to the use of some functions from the module Control.Concurrent.</li>
<li>The entire program runs in the IO Monad, so side effects like, for instance, accessing the hardware, are possible.</li>
<li>The MVar can be extended so that it contains a field where the results of the actions are stored. However, the actions can't return values themselves (their type must be IO () ).</li>
</ul>
<lang Haskell>import Control.Concurrent
import Control.Monad -- needed for "forever", "forM", "forM_"
 
-- (workers working, workers done, workers total)
type Workshop = MVar (Int, Int, Int)
 
-- check point: workers wait here for the other workers to
-- finish, before resuming execution/restarting
checkPoint :: Workshop -> IO ()
checkPoint w = do
(working, done, count) <- takeMVar w
-- all workers are done: reset counters and return (threads
-- resume execution or restart)
if working <= 0 && done == count
then do
putStrLn "---- Check Point"
putMVar w (0, 0, count)
-- mvar was just initialized: do nothing, just return.
-- otherwise, a race condition may arise
else if working == 0 && done == 0
then putMVar w (working, done, count)
-- workers are still working: wait for them (loop)
else do
putMVar w (working, done, count)
checkPoint w
 
-- increase the number of workers doing something.
-- optionally, print a message using the thread's ID
joinWorkshop :: Workshop -> ThreadId -> IO ()
joinWorkshop w i = do
(working, done, count) <- takeMVar w
putStrLn $ "Worker " ++ show i ++ " has joined."
putMVar w (working + 1, done, count)
 
-- decrease the number of workers doing something and increase the
-- number of workers done. optionally, print a message using
-- the thread's ID
leaveWorkshop :: Workshop -> ThreadId -> IO ()
leaveWorkshop w i = do
(working, done, count) <- takeMVar w
putStrLn $ "Worker " ++ show i ++ " has left."
putMVar w (working - 1, done + 1, count)
 
-- put a worker to do an action forever. the steps are:
-- 1. join the workshop
-- 2. perform the action
-- 3. leave the workshop
-- 4. wait for the other workers to finish
-- 5. go to 1
worker :: Workshop -> IO () -> IO ()
worker w action = forever $ do
i <- myThreadId
joinWorkshop w i
action
leaveWorkshop w i
checkPoint w
 
-- launch several worker threads. their thread ID's are returned
shop :: [IO ()] -> IO [ThreadId]
shop actions = do
-- set up a workshop for a given number of workers.
-- each action will be carried out by one worker, so
-- length of the action list = total number of workers
w <- newMVar (0, 0, length actions)
forM actions $ \x -> forkIO (worker w x)
 
main = do
-- the workers won't be doing anything special, just wait for
-- regular intervals. pids gathers the ID's of the threads
pids <- shop [threadDelay 1000000, threadDelay 400000,
threadDelay 1300000, threadDelay 759191, threadDelay 965300]
-- wait for a key press
getChar
-- kill all worker threads before exit
forM_ pids killThread</lang>
<p><b>Output:</b></p>
<pre>
Worker ThreadId 55 has joined.
Worker ThreadId 56 has joined.
Worker ThreadId 57 has joined.
Worker ThreadId 58 has joined.
Worker ThreadId 59 has joined.
Worker ThreadId 56 has left.
Worker ThreadId 58 has left.
Worker ThreadId 59 has left.
Worker ThreadId 55 has left.
Worker ThreadId 57 has left.
---- Check Point
Worker ThreadId 55 has joined.
Worker ThreadId 58 has joined.
Worker ThreadId 56 has joined.
Worker ThreadId 59 has joined.
Worker ThreadId 57 has joined.
Worker ThreadId 56 has left.
Worker ThreadId 58 has left.
Worker ThreadId 59 has left.
Worker ThreadId 55 has left.
Worker ThreadId 57 has left.
---- Check Point
Worker ThreadId 58 has joined.
Worker ThreadId 59 has joined.
Worker ThreadId 55 has joined.
Worker ThreadId 56 has joined.
Worker ThreadId 57 has joined.
Worker ThreadId 56 has left.
Worker ThreadId 58 has left.
Worker ThreadId 59 has left.
Worker ThreadId 55 has left.
Worker ThreadId 57 has left.
---- Check Point
</pre>
 
=={{header|J}}==
 
Anonymous user