Commit bf60bbfb authored by Ian Lynagh's avatar Ian Lynagh

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.
parent 1be165c9
......@@ -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]
......
......@@ -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.
......
......@@ -2538,6 +2538,12 @@ phase <replaceable>n</replaceable></entry>
<entry>dynamic</entry>
<entry>-</entry>
</row>
<row>
<entry><option>-fno-ghci-sandbox</option></entry>
<entry>Turn off the GHCi sandbox. Means computations are run in teh main thread, rather than a forked thread.</entry>
<entry>dynamic</entry>
<entry>-</entry>
</row>
</tbody>
</tgroup>
</informaltable>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment