1 -----------------------------------------------------------------------------
3 -- Module : Control.Concurrent
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (concurrency)
11 -- A common interface to a collection of useful concurrency
14 -----------------------------------------------------------------------------
16 module Control.Concurrent (
17 -- * Concurrent Haskell
21 -- * Basic concurrency operations
24 #ifdef __GLASGOW_HASKELL__
29 #ifdef __GLASGOW_HASKELL__
43 #ifdef __GLASGOW_HASKELL__
45 threadDelay, -- :: Int -> IO ()
46 threadWaitRead, -- :: Int -> IO ()
47 threadWaitWrite, -- :: Int -> IO ()
50 -- * Communication abstractions
52 module Control.Concurrent.MVar,
53 module Control.Concurrent.Chan,
54 module Control.Concurrent.QSem,
55 module Control.Concurrent.QSemN,
56 module Control.Concurrent.SampleVar,
58 -- * Merging of streams
60 mergeIO, -- :: [a] -> [a] -> IO [a]
61 nmergeIO, -- :: [[a]] -> IO [a]
65 #ifdef __GLASGOW_HASKELL__
68 rtsSupportsBoundThreads,
75 -- * GHC's implementation of concurrency
77 -- |This section describes features specific to GHC's
78 -- implementation of Concurrent Haskell.
80 -- ** Terminating the program
91 import Control.Exception as Exception
93 #ifdef __GLASGOW_HASKELL__
95 import GHC.TopHandler ( reportStackOverflow, reportError )
96 import GHC.IOBase ( IO(..) )
97 import GHC.IOBase ( unsafeInterleaveIO )
98 import GHC.IOBase ( newIORef, readIORef, writeIORef )
101 import Foreign.StablePtr
102 import Foreign.C.Types ( CInt )
103 import Control.Monad ( when )
110 import Control.Concurrent.MVar
111 import Control.Concurrent.Chan
112 import Control.Concurrent.QSem
113 import Control.Concurrent.QSemN
114 import Control.Concurrent.SampleVar
122 The concurrency extension for Haskell is described in the paper
124 <http://www.haskell.org/ghc/docs/papers/concurrent-haskell.ps.gz>.
126 Concurrency is \"lightweight\", which means that both thread creation
127 and context switching overheads are extremely low. Scheduling of
128 Haskell threads is done internally in the Haskell runtime system, and
129 doesn't make use of any operating system-supplied thread packages.
131 However, if you want to interact with a foreign library that expects your
132 program to use the operating system-supplied thread package, you can do so
133 by using 'forkOS' instead of 'forkIO'.
135 Haskell threads can communicate via 'MVar's, a kind of synchronised
136 mutable variable (see "Control.Concurrent.MVar"). Several common
137 concurrency abstractions can be built from 'MVar's, and these are
138 provided by the "Control.Concurrent" library.
139 In GHC, threads may also communicate via exceptions.
144 Scheduling may be either pre-emptive or co-operative,
145 depending on the implementation of Concurrent Haskell (see below
146 for imformation related to specific compilers). In a co-operative
147 system, context switches only occur when you use one of the
148 primitives defined in this module. This means that programs such
152 > main = forkIO (write 'a') >> write 'b'
153 > where write c = putChar c >> write c
155 will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@,
156 instead of some random interleaving of @a@s and @b@s. In
157 practice, cooperative multitasking is sufficient for writing
158 simple graphical user interfaces.
162 Calling a foreign C procedure (such as @getchar@) that blocks waiting
163 for input will block /all/ threads, unless the @threadsafe@ attribute
164 is used on the foreign call (and your compiler \/ operating system
165 supports it). GHC's I\/O system uses non-blocking I\/O internally to
166 implement thread-friendly I\/O, so calling standard Haskell I\/O
167 functions blocks only the thread making the call.
170 -- Thread Ids, specifically the instances of Eq and Ord for these things.
171 -- The ThreadId type itself is defined in std/PrelConc.lhs.
173 -- Rather than define a new primitve, we use a little helper function
174 -- cmp_thread in the RTS.
176 #ifdef __GLASGOW_HASKELL__
177 id2TSO :: ThreadId -> ThreadId#
178 id2TSO (ThreadId t) = t
180 foreign import ccall unsafe "cmp_thread" cmp_thread :: ThreadId# -> ThreadId# -> Int
183 cmpThread :: ThreadId -> ThreadId -> Ordering
185 case cmp_thread (id2TSO t1) (id2TSO t2) of
190 instance Eq ThreadId where
192 case t1 `cmpThread` t2 of
196 instance Ord ThreadId where
199 foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> Int
201 instance Show ThreadId where
203 showString "ThreadId " .
204 showsPrec d (getThreadId (id2TSO t))
207 This sparks off a new thread to run the 'IO' computation passed as the
208 first argument, and returns the 'ThreadId' of the newly created
211 The new thread will be a lightweight thread; if you want to use a foreign
212 library that uses thread-local storage, use 'forkOS' instead.
214 forkIO :: IO () -> IO ThreadId
215 forkIO action = IO $ \ s ->
216 case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)
218 action_plus = Exception.catch action childHandler
220 childHandler :: Exception -> IO ()
221 childHandler err = Exception.catch (real_handler err) childHandler
223 real_handler :: Exception -> IO ()
226 -- ignore thread GC and killThread exceptions:
227 BlockedOnDeadMVar -> return ()
228 AsyncException ThreadKilled -> return ()
230 -- report all others:
231 AsyncException StackOverflow -> reportStackOverflow False
232 other -> reportError False other
234 #endif /* __GLASGOW_HASKELL__ */
240 mergeIO :: [a] -> [a] -> IO [a]
241 nmergeIO :: [[a]] -> IO [a]
244 -- The 'mergeIO' and 'nmergeIO' functions fork one thread for each
245 -- input list that concurrently evaluates that list; the results are
246 -- merged into a single output list.
248 -- Note: Hugs does not provide these functions, since they require
249 -- preemptive multitasking.
252 = newEmptyMVar >>= \ tail_node ->
253 newMVar tail_node >>= \ tail_list ->
254 newQSem max_buff_size >>= \ e ->
255 newMVar 2 >>= \ branches_running ->
259 forkIO (suckIO branches_running buff ls) >>
260 forkIO (suckIO branches_running buff rs) >>
261 takeMVar tail_node >>= \ val ->
266 = (MVar (MVar [a]), QSem)
268 suckIO :: MVar Int -> Buffer a -> [a] -> IO ()
270 suckIO branches_running buff@(tail_list,e) vs
272 [] -> takeMVar branches_running >>= \ val ->
274 takeMVar tail_list >>= \ node ->
276 putMVar tail_list node
278 putMVar branches_running (val-1)
281 takeMVar tail_list >>= \ node ->
282 newEmptyMVar >>= \ next_node ->
284 takeMVar next_node >>= \ y ->
286 return y) >>= \ next_node_val ->
287 putMVar node (x:next_node_val) >>
288 putMVar tail_list next_node >>
289 suckIO branches_running buff xs
295 newEmptyMVar >>= \ tail_node ->
296 newMVar tail_node >>= \ tail_list ->
297 newQSem max_buff_size >>= \ e ->
298 newMVar len >>= \ branches_running ->
302 mapIO (\ x -> forkIO (suckIO branches_running buff x)) lss >>
303 takeMVar tail_node >>= \ val ->
307 mapIO f xs = sequence (map f xs)
308 #endif /* __HUGS__ */
310 #ifdef __GLASGOW_HASKELL__
311 -- ---------------------------------------------------------------------------
316 Support for multiple operating system threads and bound threads as described
317 below is currently only available in the GHC runtime system if you use the
318 /-threaded/ option when linking.
320 Other Haskell systems do not currently support multiple operating system threads.
322 A bound thread is a haskell thread that is /bound/ to an operating system
323 thread. While the bound thread is still scheduled by the Haskell run-time
324 system, the operating system thread takes care of all the foreign calls made
327 To a foreign library, the bound thread will look exactly like an ordinary
328 operating system thread created using OS functions like @pthread_create@
331 Bound threads can be created using the 'forkOS' function below. All foreign
332 exported functions are run in a bound thread (bound to the OS thread that
333 called the function). Also, the @main@ action of every Haskell program is
334 run in a bound thread.
336 Why do we need this? Because if a foreign library is called from a thread
337 created using 'forkIO', it won't have access to any /thread-local state/ -
338 state variables that have specific values for each OS thread
339 (see POSIX's @pthread_key_create@ or Win32's @TlsAlloc@). Therefore, some
340 libraries (OpenGL, for example) will not work from a thread created using
341 'forkIO'. They work fine in threads created using 'forkOS' or when called
342 from @main@ or from a @foreign export@.
345 -- | 'True' if bound threads are supported.
346 -- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentThreadBound'
347 -- will always return 'False' and both 'forkOS' and 'runInBoundThread' will
349 foreign import ccall rtsSupportsBoundThreads :: Bool
353 Like 'forkIO', this sparks off a new thread to run the 'IO' computation passed as the
354 first argument, and returns the 'ThreadId' of the newly created
357 However, @forkOS@ uses operating system-supplied multithreading support to create
358 a new operating system thread. The new thread is /bound/, which means that
359 all foreign calls made by the 'IO' computation are guaranteed to be executed
360 in this new operating system thread; also, the operating system thread is not
361 used for any other foreign calls.
363 This means that you can use all kinds of foreign libraries from this thread
364 (even those that rely on thread-local state), without the limitations of 'forkIO'.
366 forkOS :: IO () -> IO ThreadId
368 foreign export ccall forkOS_entry
369 :: StablePtr (IO ()) -> IO ()
371 foreign import ccall "forkOS_entry" forkOS_entry_reimported
372 :: StablePtr (IO ()) -> IO ()
374 forkOS_entry stableAction = do
375 action <- deRefStablePtr stableAction
378 foreign import ccall forkOS_createThread
379 :: StablePtr (IO ()) -> IO CInt
381 failNonThreaded = fail $ "RTS doesn't support multiple OS threads "
382 ++"(use ghc -threaded when linking)"
385 | rtsSupportsBoundThreads = do
387 let action_plus = Exception.catch action childHandler
388 entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus)
389 err <- forkOS_createThread entry
390 when (err /= 0) $ fail "Cannot create OS thread."
394 | otherwise = failNonThreaded
396 -- | Returns 'True' if the calling thread is /bound/, that is, if it is
397 -- safe to use foreign libraries that rely on thread-local state from the
399 isCurrentThreadBound :: IO Bool
400 isCurrentThreadBound = IO $ \ s# ->
401 case isCurrentThreadBound# s# of
402 (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
406 Run the 'IO' computation passed as the first argument. If the calling thread
407 is not /bound/, a bound thread is created temporarily. @runInBoundThread@
408 doesn't finish until the 'IO' computation finishes.
410 You can wrap a series of foreign function calls that rely on thread-local state
411 with @runInBoundThread@ so that you can use them without knowing whether the
412 current thread is /bound/.
414 runInBoundThread :: IO a -> IO a
416 runInBoundThread action
417 | rtsSupportsBoundThreads = do
418 bound <- isCurrentThreadBound
422 ref <- newIORef undefined
423 let action_plus = Exception.try action >>= writeIORef ref
425 bracket (newStablePtr action_plus)
427 (\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref)
428 case resultOrException of
429 Left exception -> Exception.throw exception
430 Right result -> return result
431 | otherwise = failNonThreaded
434 Run the 'IO' computation passed as the first argument. If the calling thread
435 is /bound/, an unbound thread is created temporarily using 'forkIO'.
436 @runInBoundThread@ doesn't finish until the 'IO' computation finishes.
438 Use this function /only/ in the rare case that you have actually observed a
439 performance loss due to the use of bound threads. A program that
440 doesn't need it's main thread to be bound and makes /heavy/ use of concurrency
441 (e.g. a web server), might want to wrap it's @main@ action in
442 @runInUnboundThread@.
444 runInUnboundThread :: IO a -> IO a
446 runInUnboundThread action = do
447 bound <- isCurrentThreadBound
451 forkIO (Exception.try action >>= putMVar mv)
452 takeMVar mv >>= \either -> case either of
453 Left exception -> Exception.throw exception
454 Right result -> return result
457 #endif /* __GLASGOW_HASKELL__ */
459 -- ---------------------------------------------------------------------------
464 In a standalone GHC program, only the main thread is
465 required to terminate in order for the process to terminate.
466 Thus all other forked threads will simply terminate at the same
467 time as the main thread (the terminology for this kind of
468 behaviour is \"daemonic threads\").
470 If you want the program to wait for child threads to
471 finish before exiting, you need to program this yourself. A
472 simple mechanism is to have each child thread write to an
473 'MVar' when it completes, and have the main
474 thread wait on all the 'MVar's before
477 > myForkIO :: IO () -> IO (MVar ())
479 > mvar \<- newEmptyMVar
480 > forkIO (io \`finally\` putMVar mvar ())
483 Note that we use 'finally' from the
484 "Control.Exception" module to make sure that the
485 'MVar' is written to even if the thread dies or
486 is killed for some reason.
488 A better method is to keep a global list of all child
489 threads which we should wait for at the end of the program:
491 > children :: MVar [MVar ()]
492 > children = unsafePerformIO (newMVar [])
494 > waitForChildren :: IO ()
495 > waitForChildren = do
496 > (mvar:mvars) \<- takeMVar children
497 > putMVar children mvars
501 > forkChild :: IO () -> IO ()
503 > mvar \<- newEmptyMVar
504 > forkIO (p \`finally\` putMVar mvar ())
505 > childs \<- takeMVar children
506 > putMVar children (mvar:childs)
508 > later = flip finally
511 > later waitForChildren $
514 The main thread principle also applies to calls to Haskell from
515 outside, using @foreign export@. When the @foreign export@ed
516 function is invoked, it starts a new main thread, and it returns
517 when this main thread terminates. If the call causes new
518 threads to be forked, they may remain in the system after the
519 @foreign export@ed function has returned.
524 GHC implements pre-emptive multitasking: the execution of
525 threads are interleaved in a random fashion. More specifically,
526 a thread may be pre-empted whenever it allocates some memory,
527 which unfortunately means that tight loops which do no
528 allocation tend to lock out other threads (this only seems to
529 happen with pathalogical benchmark-style code, however).
531 The rescheduling timer runs on a 20ms granularity by
532 default, but this may be altered using the
533 @-i\<n\>@ RTS option. After a rescheduling
534 \"tick\" the running thread is pre-empted as soon as
538 @aaaa@ @bbbb@ example may not
539 work too well on GHC (see Scheduling, above), due
540 to the locking on a 'System.IO.Handle'. Only one thread
541 may hold the lock on a 'System.IO.Handle' at any one
542 time, so if a reschedule happens while a thread is holding the
543 lock, the other thread won't be able to run. The upshot is that
544 the switch from @aaaa@ to
545 @bbbbb@ happens infrequently. It can be
546 improved by lowering the reschedule tick period. We also have a
547 patch that causes a reschedule whenever a thread waiting on a
548 lock is woken up, but haven't found it to be useful for anything
549 other than this example :-)