From bf60bbfb2e76a88265c60a1e9b4f7c2dd1bbfa11 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Fri, 15 Oct 2010 17:27:46 +0000 Subject: [PATCH] Add a -fghci-sandbox flag so that we can en/disable the ghci sandbox It's on by default (which matches the previous behaviour). Motivation: GLUT on OS X needs to run on the main thread. If you try to use it from another thread then you just get a white rectangle rendered. For this, or anything else with such restrictions, you can turn the GHCi sandbox off and things will be run in the main thread. --- compiler/main/DynFlags.hs | 5 ++++- compiler/main/InteractiveEval.hs | 19 +++++++++++++------ docs/users_guide/flags.xml | 6 ++++++ 3 files changed, 23 insertions(+), 7 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 056f367..ad68ed4 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -270,6 +270,7 @@ data DynFlag | Opt_SharedImplib | Opt_BuildingCabalPackage | Opt_SSE2 + | Opt_GhciSandbox -- temporary flags | Opt_RunCPS @@ -1491,6 +1492,7 @@ fFlags = [ ( "embed-manifest", Opt_EmbedManifest, nop ), ( "ext-core", Opt_EmitExternalCore, nop ), ( "shared-implib", Opt_SharedImplib, nop ), + ( "ghci-sandbox", Opt_GhciSandbox, nop ), ( "building-cabal-package", Opt_BuildingCabalPackage, nop ), ( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ) ] @@ -1644,7 +1646,8 @@ defaultFlags Opt_GenManifest, Opt_EmbedManifest, - Opt_PrintBindContents + Opt_PrintBindContents, + Opt_GhciSandbox ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 13267bd..687c63c 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -357,18 +357,25 @@ foreign import ccall "&rts_breakpoint_io_action" -- thread. ToDo: we might want a way to continue even if the target -- thread doesn't die when it receives the exception... "this thread -- is not responding". --- +-- -- Careful here: there may be ^C exceptions flying around, so we start the new -- 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 = - 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 - + mask $ \restore -> -- fork starts blocked + let runIt = liftM Complete $ try (restore $ rethrow dflags thing) + in if dopt Opt_GhciSandbox dflags + then do tid <- forkIO $ do res <- runIt + putMVar statusMVar res -- empty: can't block + withInterruptsSentTo tid $ takeMVar statusMVar + else -- GLUT on OS X needs to run on the main thread. If you + -- try to use it from another thread then you just get a + -- white rectangle rendered. For this, or anything else + -- with such restrictions, you can turn the GHCi sandbox off + -- and things will be run in the main thread. + runIt -- We want to turn ^C into a break when -fbreak-on-exception is on, -- but it's an async exception and we only break for sync exceptions. diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 5a3458a..e10e76a 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -2538,6 +2538,12 @@ phase n dynamic - + + + Turn off the GHCi sandbox. Means computations are run in teh main thread, rather than a forked thread. + dynamic + - + -- 1.7.10.4