X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent.hs;h=bd05cdc081b529d52ab6191881c15457d9774e88;hb=015f7b630e7c970b0cf311d06d9472e4dfa417b6;hp=aa40b81e40195d0adcc239768fe53235ea14c82a;hpb=ea7f925de8c7bd879d20dcb9ce9dd8da9e6e8855;p=ghc-base.git diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index aa40b81..bd05cdc 100644 --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent @@ -27,6 +28,7 @@ module Control.Concurrent ( forkIO, #ifdef __GLASGOW_HASKELL__ + forkIOUnmasked, killThread, throwTo, #endif @@ -92,16 +94,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 ) @@ -112,7 +113,6 @@ import Control.Monad ( when ) #ifdef mingw32_HOST_OS import Foreign.C import System.IO -import GHC.Handle #endif #endif @@ -292,6 +292,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. @@ -301,29 +316,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 @@ -332,6 +343,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 @@ -339,13 +351,25 @@ 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 action +forkOS action0 | rtsSupportsBoundThreads = do mv <- newEmptyMVar - let action_plus = Exception.catch action childHandler + b <- Exception.getMaskingState + let + -- 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 masked by default. + action1 = case b of + Unmasked -> unsafeUnmask action0 + MaskedInterruptible -> action0 + MaskedUninterruptible -> uninterruptibleMask_ action0 + + action_plus = Exception.catch action1 childHandler + entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus) err <- forkOS_createThread entry when (err /= 0) $ fail "Cannot create OS thread." @@ -382,13 +406,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 - Right result -> return result + bracket (newStablePtr action_plus) + freeStablePtr + (\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref) >>= + unsafeResult | otherwise = failNonThreaded {- | @@ -409,14 +430,16 @@ runInUnboundThread action = do 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 + _ <- mask $ \restore -> forkIO $ + Exception.try (restore action) >>= putMVar mv + takeMVar mv >>= unsafeResult else action +unsafeResult :: Either SomeException a -> IO a +unsafeResult = either Exception.throwIO return #endif /* __GLASGOW_HASKELL__ */ +#ifdef __GLASGOW_HASKELL__ -- --------------------------------------------------------------------------- -- threadWaitRead/threadWaitWrite @@ -431,7 +454,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" @@ -456,19 +480,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" $ + throwErrnoIfMinus1_ "fdReady" $ fdReady (fromIntegral fd) write (fromIntegral iNFINITE) 0 - return () -iNFINITE = 0xFFFFFFFF :: CInt -- urgh +iNFINITE :: CInt +iNFINITE = 0xFFFFFFFF -- urgh foreign import ccall safe "fdReady" fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt @@ -500,7 +524,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@. @@ -608,3 +632,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__ */