X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent.hs;h=a99bc37a0c05424489fb906e6cdedc306e709bc8;hb=d71aee821935e29a3569bc4b401f695536209c85;hp=e354c43bfa55cd2263c1e4acb9a9ae092f7b7d6b;hpb=e7ddb1da757db6a5898d252e9aead0282965b405;p=haskell-directory.git diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index e354c43..a99bc37 100644 --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -62,13 +62,14 @@ module Control.Concurrent ( #endif -- $merge +#ifdef __GLASGOW_HASKELL__ -- * Bound Threads -- $boundthreads -#ifdef __GLASGOW_HASKELL__ rtsSupportsBoundThreads, forkOS, isCurrentThreadBound, - runInBoundThread + runInBoundThread, + runInUnboundThread #endif -- * GHC's implementation of concurrency @@ -76,6 +77,10 @@ module Control.Concurrent ( -- |This section describes features specific to GHC's -- implementation of Concurrent Haskell. + -- ** Haskell threads and Operating System threads + + -- $osthreads + -- ** Terminating the program -- $termination @@ -90,11 +95,13 @@ import Prelude import Control.Exception as Exception #ifdef __GLASGOW_HASKELL__ -import GHC.Conc +import GHC.Conc ( ThreadId(..), myThreadId, killThread, yield, + threadDelay, threadWaitRead, threadWaitWrite, + forkIO, childHandler ) import GHC.TopHandler ( reportStackOverflow, reportError ) import GHC.IOBase ( IO(..) ) import GHC.IOBase ( unsafeInterleaveIO ) -import GHC.IOBase ( newIORef, readIORef, writeIORef ) +import GHC.IOBase ( newIORef, readIORef, writeIORef ) import GHC.Base import Foreign.StablePtr @@ -142,7 +149,7 @@ In GHC, threads may also communicate via exceptions. 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 + for information 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: @@ -166,73 +173,6 @@ 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. - --- Rather than define a new primitve, we use a little helper function --- cmp_thread in the RTS. - -#ifdef __GLASGOW_HASKELL__ -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 t1 t2 = - case cmp_thread (id2TSO t1) (id2TSO t2) of - -1 -> LT - 0 -> EQ - _ -> GT -- must be 1 - -instance Eq ThreadId where - t1 == t2 = - case t1 `cmpThread` t2 of - EQ -> True - _ -> False - -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. - -The new thread will be a lightweight thread; if you want to use a foreign -library that uses thread-local storage, use 'forkOS' instead. --} -forkIO :: IO () -> IO ThreadId -forkIO action = IO $ \ s -> - case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #) - where - action_plus = Exception.catch action childHandler - -childHandler :: Exception -> IO () -childHandler err = Exception.catch (real_handler err) childHandler - -real_handler :: Exception -> IO () -real_handler ex = - case ex of - -- ignore thread GC and killThread exceptions: - BlockedOnDeadMVar -> return () - AsyncException ThreadKilled -> return () - - -- report all others: - AsyncException StackOverflow -> reportStackOverflow False - ErrorCall s -> reportError False s - other -> reportError False (showsPrec 0 other "\n") - -#endif /* __GLASGOW_HASKELL__ */ - #ifndef __HUGS__ max_buff_size :: Int max_buff_size = 1 @@ -307,18 +247,15 @@ nmergeIO lss mapIO f xs = sequence (map f xs) #endif /* __HUGS__ */ +#ifdef __GLASGOW_HASKELL__ -- --------------------------------------------------------------------------- -- Bound Threads {- $boundthreads Support for multiple operating system threads and bound threads as described -below is currently only available in the GHC runtime system when the runtime system -has been compiled using a special option. - -When recompiling GHC, use ./configure --enable-threaded-rts to enable this. -To find your GHC has already been compiled that way, use -'rtsSupportsBoundThreads' from GHCi. +below is currently only available in the GHC runtime system if you use the +/-threaded/ option when linking. Other Haskell systems do not currently support multiple operating system threads. @@ -345,9 +282,6 @@ libraries (OpenGL, for example) will not work from a thread created using from @main@ or from a @foreign export@. -} -#ifdef - __GLASGOW_HASKELL__ - -- | 'True' if bound threads are supported. -- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentThreadBound' -- will always return 'False' and both 'forkOS' and 'runInBoundThread' will @@ -368,6 +302,11 @@ used for any other foreign calls. This means that you can use all kinds of foreign libraries from this thread (even those that rely on thread-local state), without the limitations of 'forkIO'. + +Just to clarify, 'forkOS' is /only/ necessary if you need to associate +a Haskell thread with a particular OS thread. It is not necessary if +you only need to make non-blocking foreign calls (see "Control.Concurrent#osthreads"). + -} forkOS :: IO () -> IO ThreadId @@ -384,6 +323,9 @@ forkOS_entry stableAction = do foreign import ccall forkOS_createThread :: StablePtr (IO ()) -> IO CInt +failNonThreaded = fail $ "RTS doesn't support multiple OS threads " + ++"(use ghc -threaded when linking)" + forkOS action | rtsSupportsBoundThreads = do mv <- newEmptyMVar @@ -394,7 +336,7 @@ forkOS action tid <- takeMVar mv freeStablePtr entry return tid - | otherwise = fail "RTS not built to support multiple OS threads." + | otherwise = failNonThreaded -- | Returns 'True' if the calling thread is /bound/, that is, if it is -- safe to use foreign libraries that rely on thread-local state from the @@ -431,7 +373,7 @@ runInBoundThread action case resultOrException of Left exception -> Exception.throw exception Right result -> return result - | otherwise = fail "RTS not built to support multiple OS threads." + | otherwise = failNonThreaded {- | Run the 'IO' computation passed as the first argument. If the calling thread @@ -447,21 +389,62 @@ doesn't need it's main thread to be bound and makes /heavy/ use of concurrency runInUnboundThread :: IO a -> IO a runInUnboundThread action = do - bound <- isCurrentThreadBound - if bound - then do - mv <- newEmptyMVar - forkIO (E.try action >>= putMVar mv) - takeMVar mv >>= \either -> case either of - Left exception -> E.throw exception - Right result -> return result - else action + bound <- isCurrentThreadBound + if bound + then do + mv <- newEmptyMVar + forkIO (Exception.try action >>= putMVar mv) + takeMVar mv >>= \either -> case either of + Left exception -> Exception.throw exception + Right result -> return result + else action -#endif +#endif /* __GLASGOW_HASKELL__ */ -- --------------------------------------------------------------------------- -- More docs +{- $osthreads + + #osthreads# In GHC, threads created by 'forkIO' are lightweight threads, and + are managed entirely by the GHC runtime. Typically Haskell + threads are an order of magnitude or two more efficient (in + terms of both time and space) than operating system threads. + + The downside of having lightweight threads is that only one can + run at a time, so if one thread blocks in a foreign call, for + example, the other threads cannot continue. The GHC runtime + works around this by making use of full OS threads where + necessary. When the program is built with the @-threaded@ + option (to link against the multithreaded version of the + runtime), a thread making a @safe@ foreign call will not block + the other threads in the system; another OS thread will take + over running Haskell threads until the original call returns. + The runtime maintains a pool of these /worker/ threads so that + multiple Haskell threads can be involved in external calls + simultaneously. + + The "System.IO" library manages multiplexing in its own way. On + Windows systems it uses @safe@ foreign calls to ensure that + threads doing I\/O operations don't block the whole runtime, + whereas on Unix systems all the currently blocked I\/O reqwests + are managed by a single thread (the /IO manager thread/) using + @select@. + + The runtime will run a Haskell thread using any of the available + worker OS threads. If you need control over which particular OS + thread is used to run a given Haskell thread, perhaps because + you need to call a foreign library that uses OS-thread-local + state, then you need "bound threads" (see above). + + If you don't use the @-threaded@ option, then the runtime does + not make use of multiple OS threads. Foreign calls will block + all other running Haskell threads until the call returns. The + "System.IO" library still does multiplexing, so there can be multiple + threads doing I\/O, and this is handled internally by the runtime using + @select@. +-} + {- $termination In a standalone GHC program, only the main thread is @@ -479,8 +462,8 @@ runInUnboundThread action = do > myForkIO :: IO () -> IO (MVar ()) > myForkIO io = do -> mvar \<- newEmptyMVar -> forkIO (io \`finally\` putMVar mvar ()) +> mvar <- newEmptyMVar +> forkIO (io `finally` putMVar mvar ()) > return mvar Note that we use 'finally' from the @@ -491,25 +474,26 @@ runInUnboundThread action = do 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 -> +> children :: MVar [MVar ()] +> children = unsafePerformIO (newMVar []) +> +> waitForChildren :: IO () +> waitForChildren = do +> cs <- takeMVar children +> case cs of +> [] -> return () +> m:ms -> do +> putMVar children ms +> takeMVar m +> waitForChildren +> +> forkChild :: IO () -> IO () +> forkChild io = do +> mvar <- newEmptyMVar +> childs <- takeMVar children +> putMVar children (mvar:childs) +> forkIO (io `finally` putMVar mvar ()) +> > main = > later waitForChildren $ > ... @@ -529,7 +513,7 @@ runInUnboundThread action = do 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). + happen with pathological benchmark-style code, however). The rescheduling timer runs on a 20ms granularity by default, but this may be altered using the