X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FInteractiveEval.hs;h=9afd1ac90f1b174211ed60b5245bb832c186f966;hb=997c87bcdca78ad60c129a0da29a425bc5bac638;hp=db1fd418c6a52ea82ed2579ee1a91853514f0854;hpb=de1a1f9f882cf1a5c81c4a152edc001aafd3f8a3;p=ghc-hetmet.git diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index db1fd41..9afd1ac 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -359,13 +359,13 @@ foreign import ccall "&rts_breakpoint_io_action" -- is not responding". -- -- Careful here: there may be ^C exceptions flying around, so we start the new --- thread blocked (forkIO inherits block from the parent, #1048), and unblock +-- thread blocked (forkIO inherits mask from the parent, #1048), and unblock -- only while we execute the user's code. We can't afford to lose the final -- putMVar, otherwise deadlock ensues. (#1583, #1922, #1946) sandboxIO :: DynFlags -> MVar Status -> IO [HValue] -> IO Status sandboxIO dflags statusMVar thing = - block $ do -- fork starts blocked - id <- forkIO $ do res <- Exception.try (unblock $ rethrow dflags thing) + mask $ \restore -> do -- fork starts blocked + id <- forkIO $ do res <- Exception.try (restore $ rethrow dflags thing) putMVar statusMVar (Complete res) -- empty: can't block withInterruptsSentTo id $ takeMVar statusMVar