X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent.hs;h=514e2e9adf6b01f9faadf1804910b9260d0eeb8b;hb=41e8fba828acbae1751628af50849f5352b27873;hp=626831143821625213d6b889968296c67e87adb5;hpb=8e9892cd14b7558649fcd9ba0597805eb57505b3;p=ghc-base.git diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index 6268311..514e2e9 100644 --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -1,3 +1,11 @@ +{-# LANGUAGE CPP + , ForeignFunctionInterface + , MagicHash + , UnboxedTuples + , ScopedTypeVariables + #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + ----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent @@ -27,6 +35,7 @@ module Control.Concurrent ( forkIO, #ifdef __GLASGOW_HASKELL__ + forkIOUnmasked, killThread, throwTo, #endif @@ -92,17 +101,15 @@ module Control.Concurrent ( import Prelude -import Control.Exception as Exception +import Control.Exception.Base as Exception #ifdef __GLASGOW_HASKELL__ import GHC.Exception import GHC.Conc ( ThreadId(..), myThreadId, killThread, yield, - threadDelay, forkIO, childHandler ) + threadDelay, forkIO, forkIOUnmasked, childHandler ) import qualified GHC.Conc -import GHC.TopHandler ( reportStackOverflow, reportError ) -import GHC.IOBase ( IO(..) ) -import GHC.IOBase ( unsafeInterleaveIO ) -import GHC.IOBase ( newIORef, readIORef, writeIORef ) +import GHC.IO ( IO(..), unsafeInterleaveIO, unsafeUnmask ) +import GHC.IORef ( newIORef, readIORef, writeIORef ) import GHC.Base import System.Posix.Types ( Fd ) @@ -113,7 +120,6 @@ import Control.Monad ( when ) #ifdef mingw32_HOST_OS import Foreign.C import System.IO -import GHC.Handle #endif #endif @@ -293,6 +299,21 @@ state variables that have specific values for each OS thread libraries (OpenGL, for example) will not work from a thread created using 'forkIO'. They work fine in threads created using 'forkOS' or when called from @main@ or from a @foreign export@. + +In terms of performance, 'forkOS' (aka bound) threads are much more +expensive than 'forkIO' (aka unbound) threads, because a 'forkOS' +thread is tied to a particular OS thread, whereas a 'forkIO' thread +can be run by any OS thread. Context-switching between a 'forkOS' +thread and a 'forkIO' thread is many times more expensive than between +two 'forkIO' threads. + +Note in particular that the main program thread (the thread running +@Main.main@) is always a bound thread, so for good concurrency +performance you should ensure that the main thread is not doing +repeated communication with other threads in the system. Typically +this means forking subthreads to do the work using 'forkIO', and +waiting for the results in the main thread. + -} -- | 'True' if bound threads are supported. @@ -302,29 +323,25 @@ from @main@ or from a @foreign export@. foreign import ccall rtsSupportsBoundThreads :: Bool -{- | -Like 'forkIO', 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. - -However, @forkOS@ uses operating system-supplied multithreading support to create -a new operating system thread. The new thread is /bound/, which means that -all foreign calls made by the 'IO' computation are guaranteed to be executed -in this new operating system thread; also, the operating system thread is not -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"). Neither is it necessary if you want -to run threads in parallel on a multiprocessor: threads created with -'forkIO' will be shared out amongst the running CPUs (using GHC, -@-threaded@, and the @+RTS -N@ runtime option). - +{- | +Like 'forkIO', 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. + +However, 'forkOS' creates a /bound/ thread, which is necessary if you +need to call foreign (non-Haskell) libraries that make use of +thread-local state, such as OpenGL (see "Control.Concurrent#boundthreads"). + +Using 'forkOS' instead of 'forkIO' makes no difference at all to the +scheduling behaviour of the Haskell runtime system. It is a common +misconception that you need to use 'forkOS' instead of 'forkIO' to +avoid blocking all the Haskell threads when making a foreign call; +this isn't the case. To allow foreign calls to be made without +blocking all the Haskell threads (with GHC), it is only necessary to +use the @-threaded@ option when linking your program, and to make sure +the foreign import is not marked @unsafe@. -} + forkOS :: IO () -> IO ThreadId foreign export ccall forkOS_entry @@ -333,6 +350,7 @@ foreign export ccall forkOS_entry foreign import ccall "forkOS_entry" forkOS_entry_reimported :: StablePtr (IO ()) -> IO () +forkOS_entry :: StablePtr (IO ()) -> IO () forkOS_entry stableAction = do action <- deRefStablePtr stableAction action @@ -340,19 +358,22 @@ forkOS_entry stableAction = do foreign import ccall forkOS_createThread :: StablePtr (IO ()) -> IO CInt +failNonThreaded :: IO a failNonThreaded = fail $ "RTS doesn't support multiple OS threads " ++"(use ghc -threaded when linking)" forkOS action0 | rtsSupportsBoundThreads = do mv <- newEmptyMVar - b <- Exception.blocked + b <- Exception.getMaskingState let - -- async exceptions are blocked in the child if they are blocked + -- async exceptions are masked in the child if they are masked -- in the parent, as for forkIO (see #1048). forkOS_createThread - -- creates a thread with exceptions blocked by default. - action1 | b = action0 - | otherwise = unblock action0 + -- creates a thread with exceptions masked by default. + action1 = case b of + Unmasked -> unsafeUnmask action0 + MaskedInterruptible -> action0 + MaskedUninterruptible -> uninterruptibleMask_ action0 action_plus = Exception.catch action1 childHandler @@ -392,13 +413,10 @@ runInBoundThread action else do ref <- newIORef undefined let action_plus = Exception.try action >>= writeIORef ref - resultOrException <- - bracket (newStablePtr action_plus) - freeStablePtr - (\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref) - case resultOrException of - Left exception -> Exception.throw (exception :: SomeException) - Right result -> return result + bracket (newStablePtr action_plus) + freeStablePtr + (\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref) >>= + unsafeResult | otherwise = failNonThreaded {- | @@ -411,27 +429,40 @@ performance loss due to the use of bound threads. A program that doesn't need it's main thread to be bound and makes /heavy/ use of concurrency (e.g. a web server), might want to wrap it's @main@ action in @runInUnboundThread@. + +Note that exceptions which are thrown to the current thread are thrown in turn +to the thread that is executing the given computation. This ensures there's +always a way of killing the forked thread. -} runInUnboundThread :: IO a -> IO a runInUnboundThread action = do - 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 :: SomeException) - Right result -> return result - else action - + bound <- isCurrentThreadBound + if bound + then do + mv <- newEmptyMVar + mask $ \restore -> do + tid <- forkIO $ Exception.try (restore action) >>= putMVar mv + let wait = takeMVar mv `Exception.catch` \(e :: SomeException) -> + Exception.throwTo tid e >> wait + wait >>= unsafeResult + else action + +unsafeResult :: Either SomeException a -> IO a +unsafeResult = either Exception.throwIO return #endif /* __GLASGOW_HASKELL__ */ +#ifdef __GLASGOW_HASKELL__ -- --------------------------------------------------------------------------- -- threadWaitRead/threadWaitWrite -- | Block the current thread until data is available to read on the -- given file descriptor (GHC only). +-- +-- This will throw an 'IOError' if the file descriptor was closed +-- while this thread was blocked. To safely close a file descriptor +-- that has been used with 'threadWaitRead', use +-- 'GHC.Conc.closeFdWith'. threadWaitRead :: Fd -> IO () threadWaitRead fd #ifdef mingw32_HOST_OS @@ -441,7 +472,8 @@ threadWaitRead fd -- and this only works with -threaded. | threaded = withThread (waitFd fd 0) | otherwise = case fd of - 0 -> do hWaitForInput stdin (-1); return () + 0 -> do _ <- hWaitForInput stdin (-1) + return () -- hWaitForInput does work properly, but we can only -- do this for stdin since we know its FD. _ -> error "threadWaitRead requires -threaded on Windows, or use System.IO.hWaitForInput" @@ -451,6 +483,11 @@ threadWaitRead fd -- | Block the current thread until data can be written to the -- given file descriptor (GHC only). +-- +-- This will throw an 'IOError' if the file descriptor was closed +-- while this thread was blocked. To safely close a file descriptor +-- that has been used with 'threadWaitWrite', use +-- 'GHC.Conc.closeFdWith'. threadWaitWrite :: Fd -> IO () threadWaitWrite fd #ifdef mingw32_HOST_OS @@ -466,19 +503,19 @@ foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool withThread :: IO a -> IO a withThread io = do m <- newEmptyMVar - forkIO $ try io >>= putMVar m + _ <- mask_ $ forkIO $ try io >>= putMVar m x <- takeMVar m case x of Right a -> return a - Left e -> throwIO e + Left e -> throwIO (e :: IOException) waitFd :: Fd -> CInt -> IO () waitFd fd write = do - throwErrnoIfMinus1 "fdReady" $ - fdReady (fromIntegral fd) write (fromIntegral iNFINITE) 0 - return () + throwErrnoIfMinus1_ "fdReady" $ + fdReady (fromIntegral fd) write iNFINITE 0 -iNFINITE = 0xFFFFFFFF :: CInt -- urgh +iNFINITE :: CInt +iNFINITE = 0xFFFFFFFF -- urgh foreign import ccall safe "fdReady" fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt @@ -510,7 +547,7 @@ foreign import ccall safe "fdReady" 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 + whereas on Unix systems all the currently blocked I\/O requests are managed by a single thread (the /IO manager thread/) using @select@. @@ -618,3 +655,4 @@ foreign import ccall safe "fdReady" lock is woken up, but haven't found it to be useful for anything other than this example :-) -} +#endif /* __GLASGOW_HASKELL__ */