X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent.hs;h=451e4f9393032a7e07eabba3249ac2c63c97ec55;hb=6be5e3277137f11000e7eb145d53009e157e7c90;hp=db570bf09612a9ff15a9b38cc838a3be026ce338;hpb=260e7f2ed9a43c6ecf5a556d77817f39ed2893ab;p=ghc-base.git diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index db570bf..451e4f9 100644 --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -1,14 +1,12 @@ ----------------------------------------------------------------------------- --- +-- | -- Module : Control.Concurrent -- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental --- Portability : non-portable --- --- $Id: Concurrent.hs,v 1.3 2001/12/21 15:07:21 simonmar Exp $ +-- Portability : non-portable (concurrency) -- -- A common interface to a collection of useful concurrency -- abstractions. @@ -16,32 +14,67 @@ ----------------------------------------------------------------------------- module Control.Concurrent ( - module Control.Concurrent.Chan, - module Control.Concurrent.CVar, - module Control.Concurrent.MVar, - module Control.Concurrent.QSem, - module Control.Concurrent.QSemN, - module Control.Concurrent.SampleVar, + -- * Concurrent Haskell - forkIO, -- :: IO () -> IO () - yield, -- :: IO () + -- $conc_intro + + -- * Basic concurrency operations -#ifdef __GLASGOW_HASKELL__ ThreadId, +#ifdef __GLASGOW_HASKELL__ + myThreadId, +#endif + + forkIO, +#ifdef __GLASGOW_HASKELL__ + killThread, + throwTo, +#endif - -- Forking and suchlike - myThreadId, -- :: IO ThreadId - killThread, -- :: ThreadId -> IO () - throwTo, -- :: ThreadId -> Exception -> IO () + -- * Scheduling + + -- $conc_scheduling + yield, -- :: IO () + -- ** Blocking + + -- $blocking + +#ifdef __GLASGOW_HASKELL__ + -- ** Waiting threadDelay, -- :: Int -> IO () threadWaitRead, -- :: Int -> IO () threadWaitWrite, -- :: Int -> IO () #endif - -- merging of streams + -- * Communication abstractions + + module Control.Concurrent.MVar, + module Control.Concurrent.Chan, + module Control.Concurrent.QSem, + module Control.Concurrent.QSemN, + module Control.Concurrent.SampleVar, + + -- * Merging of streams +#ifndef __HUGS__ mergeIO, -- :: [a] -> [a] -> IO [a] - nmergeIO -- :: [[a]] -> IO [a] + nmergeIO, -- :: [[a]] -> IO [a] +#endif + -- $merge + + -- * GHC's implementation of concurrency + + -- |This section describes features specific to GHC's + -- implementation of Concurrent Haskell. + + -- ** Terminating the program + + -- $termination + + -- ** Pre-emption + + -- $preemption + ) where import Prelude @@ -57,17 +90,65 @@ import GHC.Base #endif #ifdef __HUGS__ -import IOExts ( unsafeInterleaveIO ) -import ConcBase +import Hugs.ConcBase #endif import Control.Concurrent.MVar -import Control.Concurrent.CVar import Control.Concurrent.Chan import Control.Concurrent.QSem import Control.Concurrent.QSemN import Control.Concurrent.SampleVar +#ifdef __HUGS__ +type ThreadId = () +#endif + +{- $conc_intro + +The concurrency extension for Haskell is described in the paper +/Concurrent Haskell/ +. + +Concurrency is \"lightweight\", which means that both thread creation +and context switching overheads are extremely low. Scheduling of +Haskell threads is done internally in the Haskell runtime system, and +doesn't make use of any operating system-supplied thread packages. + +Haskell threads can communicate via 'MVar's, a kind of synchronised +mutable variable (see "Control.Concurrent.MVar"). Several common +concurrency abstractions can be built from 'MVar's, and these are +provided by the "Control.Concurrent" library. +In GHC, threads may also communicate via exceptions. +-} + +{- $conc_scheduling + + Scheduling may be either pre-emptive or co-operative, + depending on the implementation of Concurrent Haskell (see below + for imformation related to specific compilers). In a co-operative + system, context switches only occur when you use one of the + primitives defined in this module. This means that programs such + as: + + +> main = forkIO (write 'a') >> write 'b' +> where write c = putChar c >> write c + + will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@, + instead of some random interleaving of @a@s and @b@s. In + practice, cooperative multitasking is sufficient for writing + simple graphical user interfaces. +-} + +{- $blocking +Calling a foreign C procedure (such as @getchar@) that blocks waiting +for input will block /all/ threads, unless the @threadsafe@ attribute +is used on the foreign call (and your compiler \/ operating system +supports it). GHC's I\/O system uses non-blocking I\/O internally to +implement thread-friendly I\/O, so calling standard Haskell I\/O +functions blocks only the thread making the call. +-} + -- Thread Ids, specifically the instances of Eq and Ord for these things. -- The ThreadId type itself is defined in std/PrelConc.lhs. @@ -75,12 +156,15 @@ import Control.Concurrent.SampleVar -- cmp_thread in the RTS. #ifdef __GLASGOW_HASKELL__ -foreign import ccall "cmp_thread" unsafe cmp_thread :: Addr# -> Addr# -> Int +id2TSO :: ThreadId -> ThreadId# +id2TSO (ThreadId t) = t + +foreign import ccall unsafe "cmp_thread" cmp_thread :: ThreadId# -> ThreadId# -> Int -- Returns -1, 0, 1 cmpThread :: ThreadId -> ThreadId -> Ordering -cmpThread (ThreadId t1) (ThreadId t2) = - case cmp_thread (unsafeCoerce# t1) (unsafeCoerce# t2) of +cmpThread t1 t2 = + case cmp_thread (id2TSO t1) (id2TSO t2) of -1 -> LT 0 -> EQ _ -> GT -- must be 1 @@ -94,6 +178,18 @@ instance Eq ThreadId where instance Ord ThreadId where compare = cmpThread +foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> Int + +instance Show ThreadId where + showsPrec d t = + showString "ThreadId " . + showsPrec d (getThreadId (id2TSO t)) + +{- | +This sparks off a new thread to run the 'IO' computation passed as the +first argument, and returns the 'ThreadId' of the newly created +thread. +-} forkIO :: IO () -> IO ThreadId forkIO action = IO $ \ s -> case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #) @@ -117,13 +213,21 @@ real_handler ex = #endif /* __GLASGOW_HASKELL__ */ - +#ifndef __HUGS__ max_buff_size :: Int max_buff_size = 1 mergeIO :: [a] -> [a] -> IO [a] nmergeIO :: [[a]] -> IO [a] +-- $merge +-- The 'mergeIO' and 'nmergeIO' functions fork one thread for each +-- input list that concurrently evaluates that list; the results are +-- merged into a single output list. +-- +-- Note: Hugs does not provide these functions, since they require +-- preemptive multitasking. + mergeIO ls rs = newEmptyMVar >>= \ tail_node -> newMVar tail_node >>= \ tail_list -> @@ -181,3 +285,97 @@ nmergeIO lss return val where mapIO f xs = sequence (map f xs) +#endif /* __HUGS__ */ + +-- --------------------------------------------------------------------------- +-- More docs + +{- $termination + + In a standalone GHC program, only the main thread is + required to terminate in order for the process to terminate. + Thus all other forked threads will simply terminate at the same + time as the main thread (the terminology for this kind of + behaviour is \"daemonic threads\"). + + If you want the program to wait for child threads to + finish before exiting, you need to program this yourself. A + simple mechanism is to have each child thread write to an + 'MVar' when it completes, and have the main + thread wait on all the 'MVar's before + exiting: + +> myForkIO :: IO () -> IO (MVar ()) +> myForkIO io = do +> mvar \<- newEmptyMVar +> forkIO (io \`finally\` putMVar mvar ()) +> return mvar + + Note that we use 'finally' from the + "Control.Exception" module to make sure that the + 'MVar' is written to even if the thread dies or + is killed for some reason. + + A better method is to keep a global list of all child + threads which we should wait for at the end of the program: + +> children :: MVar [MVar ()] +> children = unsafePerformIO (newMVar []) +> +> waitForChildren :: IO () +> waitForChildren = do +> (mvar:mvars) \<- takeMVar children +> putMVar children mvars +> takeMVar mvar +> waitForChildren +> +> forkChild :: IO () -> IO () +> forkChild io = do +> mvar \<- newEmptyMVar +> forkIO (p \`finally\` putMVar mvar ()) +> childs \<- takeMVar children +> putMVar children (mvar:childs) +> +> later = flip finally +> +> main = +> later waitForChildren $ +> ... + + The main thread principle also applies to calls to Haskell from + outside, using @foreign export@. When the @foreign export@ed + function is invoked, it starts a new main thread, and it returns + when this main thread terminates. If the call causes new + threads to be forked, they may remain in the system after the + @foreign export@ed function has returned. +-} + +{- $preemption + + GHC implements pre-emptive multitasking: the execution of + threads are interleaved in a random fashion. More specifically, + a thread may be pre-empted whenever it allocates some memory, + which unfortunately means that tight loops which do no + allocation tend to lock out other threads (this only seems to + happen with pathalogical benchmark-style code, however). + + The rescheduling timer runs on a 20ms granularity by + default, but this may be altered using the + @-i\@ RTS option. After a rescheduling + \"tick\" the running thread is pre-empted as soon as + possible. + + One final note: the + @aaaa@ @bbbb@ example may not + work too well on GHC (see Scheduling, above), due + to the locking on a 'System.IO.Handle'. Only one thread + may hold the lock on a 'System.IO.Handle' at any one + time, so if a reschedule happens while a thread is holding the + lock, the other thread won't be able to run. The upshot is that + the switch from @aaaa@ to + @bbbbb@ happens infrequently. It can be + improved by lowering the reschedule tick period. We also have a + patch that causes a reschedule whenever a thread waiting on a + lock is woken up, but haven't found it to be useful for anything + other than this example :-) +-}