add numSparks :: IO Int (#4167)
[ghc-base.git] / GHC / Conc.lhs
index f86c205..0d17457 100644 (file)
@@ -29,8 +29,11 @@ module GHC.Conc
 
         -- * Forking and suchlike
         , forkIO        -- :: IO a -> IO ThreadId
+        , forkIOUnmasked
         , forkOnIO      -- :: Int -> IO a -> IO ThreadId
+        , forkOnIOUnmasked
         , numCapabilities -- :: Int
+        , numSparks      -- :: IO Int
         , childHandler  -- :: Exception -> IO ()
         , myThreadId    -- :: IO ThreadId
         , killThread    -- :: ThreadId -> IO ()
@@ -211,8 +214,8 @@ thread.
 The new thread will be a lightweight thread; if you want to use a foreign
 library that uses thread-local storage, use 'Control.Concurrent.forkOS' instead.
 
-GHC note: the new thread inherits the /blocked/ state of the parent 
-(see 'Control.Exception.block').
+GHC note: the new thread inherits the /masked/ state of the parent 
+(see 'Control.Exception.mask').
 
 The newly created thread has an exception handler that discards the
 exceptions 'BlockedIndefinitelyOnMVar', 'BlockedIndefinitelyOnSTM', and
@@ -225,6 +228,11 @@ forkIO action = IO $ \ s ->
  where
   action_plus = catchException action childHandler
 
+-- | Like 'forkIO', but the child thread is created with asynchronous exceptions
+-- unmasked (see 'Control.Exception.mask').
+forkIOUnmasked :: IO () -> IO ThreadId
+forkIOUnmasked io = forkIO (unsafeUnmask io)
+
 {- |
 Like 'forkIO', but lets you specify on which CPU the thread is
 created.  Unlike a `forkIO` thread, a thread created by `forkOnIO`
@@ -244,6 +252,11 @@ forkOnIO (I# cpu) action = IO $ \ s ->
  where
   action_plus = catchException action childHandler
 
+-- | Like 'forkOnIO', but the child thread is created with
+-- asynchronous exceptions unmasked (see 'Control.Exception.mask').
+forkOnIOUnmasked :: Int -> IO () -> IO ThreadId
+forkOnIOUnmasked cpu io = forkOnIO cpu (unsafeUnmask io)
+
 -- | the value passed to the @+RTS -N@ flag.  This is the number of
 -- Haskell threads that can run truly simultaneously at any given
 -- time, and is typically set to the number of physical CPU cores on
@@ -253,6 +266,10 @@ numCapabilities = unsafePerformIO $  do
                     n <- peek n_capabilities
                     return (fromIntegral n)
 
+-- | Returns the number of sparks currently in the local spark pool
+numSparks :: IO Int
+numSparks = IO $ \s -> case numSparks# s of (# s', n #) -> (# s', I# n #)
+
 #if defined(mingw32_HOST_OS) && defined(__PIC__)
 foreign import ccall "_imp__n_capabilities" n_capabilities :: Ptr CInt
 #else
@@ -275,16 +292,11 @@ real_handler se@(SomeException ex) =
                  Just StackOverflow     -> reportStackOverflow
                  _                      -> reportError se
 
-{- | 'killThread' terminates the given thread (GHC only).
-Any work already done by the thread isn\'t
-lost: the computation is suspended until required by another thread.
-The memory used by the thread will be garbage collected if it isn\'t
-referenced from anywhere.  The 'killThread' function is defined in
-terms of 'throwTo':
+{- | 'killThread' raises the 'ThreadKilled' exception in the given
+thread (GHC only). 
 
 > killThread tid = throwTo tid ThreadKilled
 
-Killthread is a no-op if the target thread has already completed.
 -}
 killThread :: ThreadId -> IO ()
 killThread tid = throwTo tid ThreadKilled
@@ -299,10 +311,14 @@ when dealing with race conditions: eg. if there are two threads that
 can kill each other, it is guaranteed that only one of the threads
 will get to kill the other.
 
+Whatever work the target thread was doing when the exception was
+raised is not lost: the computation is suspended until required by
+another thread.
+
 If the target thread is currently making a foreign call, then the
 exception will not be raised (and hence 'throwTo' will not return)
 until the call has completed.  This is the case regardless of whether
-the call is inside a 'block' or not.
+the call is inside a 'mask' or not.
 
 Important note: the behaviour of 'throwTo' differs from that described in
 the paper \"Asynchronous exceptions in Haskell\"
@@ -311,14 +327,20 @@ In the paper, 'throwTo' is non-blocking; but the library implementation adopts
 a more synchronous design in which 'throwTo' does not return until the exception
 is received by the target thread.  The trade-off is discussed in Section 9 of the paper.
 Like any blocking operation, 'throwTo' is therefore interruptible (see Section 5.3 of
-the paper).
+the paper).  Unlike other interruptible operations, however, 'throwTo'
+is /always/ interruptible, even if it does not actually block.
+
+There is no guarantee that the exception will be delivered promptly,
+although the runtime will endeavour to ensure that arbitrary
+delays don't occur.  In GHC, an exception can only be raised when a
+thread reaches a /safe point/, where a safe point is where memory
+allocation occurs.  Some loops do not perform any memory allocation
+inside the loop and therefore cannot be interrupted by a 'throwTo'.
 
-There is currently no guarantee that the exception delivered by 'throwTo' will be
-delivered at the first possible opportunity.  In particular, a thread may 
-unblock and then re-block exceptions (using 'unblock' and 'block') without receiving
-a pending 'throwTo'.  This is arguably undesirable behaviour.
+Blocked 'throwTo' is fair: if multiple threads are trying to throw an
+exception to the same target thread, they will succeed in FIFO order.
 
- -}
+  -}
 throwTo :: Exception e => ThreadId -> e -> IO ()
 throwTo (ThreadId tid) ex = IO $ \ s ->
    case (killThread# tid (toException ex) s) of s1 -> (# s1, () #)
@@ -472,6 +494,10 @@ thenSTM (STM m) k = STM ( \s ->
 returnSTM :: a -> STM a
 returnSTM x = STM (\s -> (# s, x #))
 
+instance MonadPlus STM where
+  mzero = retry
+  mplus = orElse
+
 -- | Unsafely performs IO in the STM monad.  Beware: this is a highly
 -- dangerous thing to do.  
 --
@@ -602,18 +628,18 @@ MVar utilities
 \begin{code}
 withMVar :: MVar a -> (a -> IO b) -> IO b
 withMVar m io = 
-  block $ do
+  mask $ \restore -> do
     a <- takeMVar m
-    b <- catchAny (unblock (io a))
+    b <- catchAny (restore (io a))
             (\e -> do putMVar m a; throw e)
     putMVar m a
     return b
 
 modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
 modifyMVar_ m io =
-  block $ do
+  mask $ \restore -> do
     a <- takeMVar m
-    a' <- catchAny (unblock (io a))
+    a' <- catchAny (restore (io a))
             (\e -> do putMVar m a; throw e)
     putMVar m a'
     return ()
@@ -852,7 +878,7 @@ prodServiceThread = do
 --
 sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a
 sharedCAF a get_or_set =
-   block $ do
+   mask_ $ do
      stable_ref <- newStablePtr a
      let ref = castPtr (castStablePtrToPtr stable_ref)
      ref2 <- get_or_set ref