Add a -fghci-sandbox flag so that we can en/disable the ghci sandbox
authorIan Lynagh <igloo@earth.li>
Fri, 15 Oct 2010 17:27:46 +0000 (17:27 +0000)
committerIan Lynagh <igloo@earth.li>
Fri, 15 Oct 2010 17:27:46 +0000 (17:27 +0000)
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
compiler/main/InteractiveEval.hs
docs/users_guide/flags.xml

index 056f367..ad68ed4 100644 (file)
@@ -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]
index 13267bd..687c63c 100644 (file)
@@ -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.
index 5a3458a..e10e76a 100644 (file)
@@ -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>