From: Ian Lynagh <igloo@earth.li>
Date: Fri, 1 Aug 2008 20:01:23 +0000 (+0000)
Subject: Don't import Control.Concurrent.MVar in GHC.TopHandler
X-Git-Tag: 6_10_branch_has_been_forked~111
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=510ea89038fd81452a841691fb9aa10382725d7b;p=ghc-base.git

Don't import Control.Concurrent.MVar in GHC.TopHandler
---

diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs
index 236f5ff..ac6523b 100644
--- a/GHC/TopHandler.lhs
+++ b/GHC/TopHandler.lhs
@@ -27,7 +27,6 @@ module GHC.TopHandler (
 
 import Control.Exception
 import Data.Maybe
-import Control.Concurrent.MVar
 
 import Foreign
 import Foreign.C
@@ -77,13 +76,20 @@ install_interrupt_handler handler = do
 -- isn't available here.
 install_interrupt_handler handler = do
    let sig = CONST_SIGINT :: CInt
-   withMVar signalHandlerLock $ \_ ->
+   withSignalHandlerLock $
      alloca $ \p_sp -> do
        sptr <- newStablePtr handler
        poke p_sp sptr
        stg_sig_install sig STG_SIG_RST p_sp nullPtr
        return ()
 
+withSignalHandlerLock :: IO () -> IO ()
+withSignalHandlerLock io
+ = block $ do
+       takeMVar signalHandlerLock
+       catchAny (unblock io) (\e -> do putMVar signalHandlerLock (); throw e)
+       putMVar signalHandlerLock ()
+
 foreign import ccall unsafe
   stg_sig_install
 	:: CInt				-- sig no.