Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/4b523bc139a05a52a58811623d638c43d398f245 >--------------------------------------------------------------- commit 4b523bc139a05a52a58811623d638c43d398f245 Author: Simon Marlow <marlo...@gmail.com> Date: Tue May 22 11:39:03 2012 +0100 Don't remove the thread from interruptTargetThread on ^C (#6116) >--------------------------------------------------------------- compiler/utils/Panic.lhs | 33 ++++++++++++++++++--------------- 1 files changed, 18 insertions(+), 15 deletions(-) diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index faaa628..38ee6fc 100644 --- a/compiler/utils/Panic.lhs +++ b/compiler/utils/Panic.lhs @@ -243,7 +243,7 @@ installSignalHandlers = do interrupt_exn = (toException UserInterrupt) interrupt = do - mt <- popInterruptTargetThread + mt <- peekInterruptTargetThread case mt of Nothing -> return () Just t -> throwTo t interrupt_exn @@ -280,19 +280,18 @@ interruptTargetThread = unsafePerformIO (newMVar []) pushInterruptTargetThread :: ThreadId -> IO () pushInterruptTargetThread tid = do wtid <- mkWeakThreadId tid - modifyMVar_ interruptTargetThread $ - return . (wtid :) + modifyMVar_ interruptTargetThread $ return . (wtid :) -popInterruptTargetThread :: IO (Maybe ThreadId) -popInterruptTargetThread = - modifyMVar interruptTargetThread $ loop +peekInterruptTargetThread :: IO (Maybe ThreadId) +peekInterruptTargetThread = + withMVar interruptTargetThread $ loop where - loop [] = return ([], Nothing) + loop [] = return Nothing loop (t:ts) = do r <- deRefWeak t case r of Nothing -> loop ts - Just t -> return (ts, Just t) + Just t -> return (Just t) #else {-# NOINLINE interruptTargetThread #-} interruptTargetThread :: MVar [ThreadId] @@ -300,13 +299,17 @@ interruptTargetThread = unsafePerformIO (newMVar []) pushInterruptTargetThread :: ThreadId -> IO () pushInterruptTargetThread tid = do - modifyMVar_ interruptTargetThread $ - return . (tid :) + modifyMVar_ interruptTargetThread $ return . (tid :) -popInterruptTargetThread :: IO (Maybe ThreadId) -popInterruptTargetThread = - modifyMVar interruptTargetThread $ - \tids -> return $! case tids of [] -> ([], Nothing) - (t:ts) -> (ts, Just t) +peekInterruptTargetThread :: IO (Maybe ThreadId) +peekInterruptTargetThread = + withMVar interruptTargetThread $ return . listToMaybe #endif + +popInterruptTargetThread :: IO () +popInterruptTargetThread = + modifyMVar_ interruptTargetThread $ + \tids -> return $! case tids of [] -> [] + (t:ts) -> ts + \end{code} _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
