Commit 1e70478c authored by Simon Marlow's avatar Simon Marlow
Browse files

outside of runStmt, if a breakpoint is hit then just print a message

parent 53c9c9f6
...@@ -257,6 +257,7 @@ import HaddockParse ...@@ -257,6 +257,7 @@ import HaddockParse
import HaddockLex ( tokenise ) import HaddockLex ( tokenise )
import Unique import Unique
import System.IO.Unsafe
import Data.Array import Data.Array
import Control.Concurrent import Control.Concurrent
import System.Directory ( getModificationTime, doesFileExist ) import System.Directory ( getModificationTime, doesFileExist )
...@@ -2196,11 +2197,10 @@ runStmt (Session ref) expr ...@@ -2196,11 +2197,10 @@ runStmt (Session ref) expr
-- breakpoint this is visible in the Byte Code -- breakpoint this is visible in the Byte Code
-- Interpreter, thus it is a global variable, -- Interpreter, thus it is a global variable,
-- implemented with stable pointers -- implemented with stable pointers
stablePtr <- setBreakAction breakMVar statusMVar withBreakAction breakMVar statusMVar $ do
let thing_to_run = unsafeCoerce# hval :: IO [HValue] let thing_to_run = unsafeCoerce# hval :: IO [HValue]
status <- sandboxIO statusMVar thing_to_run status <- sandboxIO statusMVar thing_to_run
freeStablePtr stablePtr -- be careful not to leak stable pointers!
handleRunStatus ref new_IC names (hsc_IC hsc_env) handleRunStatus ref new_IC names (hsc_IC hsc_env)
breakMVar statusMVar status breakMVar statusMVar status
...@@ -2245,14 +2245,25 @@ sandboxIO statusMVar thing = do ...@@ -2245,14 +2245,25 @@ sandboxIO statusMVar thing = do
putMVar interruptTargetThread (child:ts) putMVar interruptTargetThread (child:ts)
takeMVar statusMVar `finally` modifyMVar_ interruptTargetThread (return.tail) takeMVar statusMVar `finally` modifyMVar_ interruptTargetThread (return.tail)
setBreakAction breakMVar statusMVar = do withBreakAction breakMVar statusMVar io
stablePtr <- newStablePtr onBreak = bracket setBreakAction resetBreakAction (\_ -> io)
poke breakPointIOAction stablePtr where
return stablePtr setBreakAction = do
where onBreak ids apStack = do stablePtr <- newStablePtr onBreak
tid <- myThreadId poke breakPointIOAction stablePtr
putMVar statusMVar (Break apStack ids tid) return stablePtr
takeMVar breakMVar
onBreak info apStack = do
tid <- myThreadId
putMVar statusMVar (Break apStack info tid)
takeMVar breakMVar
resetBreakAction stablePtr = do
poke breakPointIOAction noBreakStablePtr
freeStablePtr stablePtr
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction info apStack = putStrLn "*** Ignoring breakpoint"
resume :: Session -> ResumeHandle -> IO RunResult resume :: Session -> ResumeHandle -> IO RunResult
resume (Session ref) res@(ResumeHandle breakMVar statusMVar resume (Session ref) res@(ResumeHandle breakMVar statusMVar
...@@ -2266,10 +2277,9 @@ resume (Session ref) res@(ResumeHandle breakMVar statusMVar ...@@ -2266,10 +2277,9 @@ resume (Session ref) res@(ResumeHandle breakMVar statusMVar
writeIORef ref hsc_env{ hsc_IC = resume_ic } writeIORef ref hsc_env{ hsc_IC = resume_ic }
Linker.deleteFromLinkEnv names Linker.deleteFromLinkEnv names
stablePtr <- setBreakAction breakMVar statusMVar withBreakAction breakMVar statusMVar $ do
putMVar breakMVar () -- this awakens the stopped thread... putMVar breakMVar () -- this awakens the stopped thread...
status <- takeMVar statusMVar -- and wait for the result status <- takeMVar statusMVar -- and wait for the result
freeStablePtr stablePtr -- be careful not to leak stable pointers!
handleRunStatus ref final_ic final_names resume_ic handleRunStatus ref final_ic final_names resume_ic
breakMVar statusMVar status breakMVar statusMVar status
......
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