import Control.Exception
import Data.Maybe
+import Data.Dynamic (toDyn)
import Foreign
import Foreign.C
-- isn't available here.
install_interrupt_handler handler = do
let sig = CONST_SIGINT :: CInt
- 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 ()
+ setHandler sig (Just (const handler, toDyn handler))
+ stg_sig_install sig STG_SIG_RST nullPtr
+ -- STG_SIG_RST: the second ^C kills us for real, just in case the
+ -- RTS or program is unresponsive.
+ return ()
foreign import ccall unsafe
stg_sig_install
:: CInt -- sig no.
-> CInt -- action code (STG_SIG_HAN etc.)
- -> Ptr (StablePtr (IO ())) -- (in, out) Haskell handler
-> Ptr () -- (in, out) blocked
- -> IO CInt -- (ret) action code
+ -> IO CInt -- (ret) old action code
#endif
-- make a weak pointer to a ThreadId: holding the weak pointer doesn't