| ... |
... |
@@ -211,7 +211,7 @@ resumeSeq hvref = clearEvalStatus <$> do |
|
211
|
211
|
mask_ $ do
|
|
212
|
212
|
putMVar resumeBreakMVar () -- this awakens the stopped thread...
|
|
213
|
213
|
redirectInterrupts resumeThreadId $ do
|
|
214
|
|
- takeMVar resumeStatusMVar
|
|
|
214
|
+ takeMVar globalDbgStatusMVar
|
|
215
|
215
|
|
|
216
|
216
|
evalOptsSeq :: EvalOpts
|
|
217
|
217
|
evalOptsSeq = EvalOpts
|
| ... |
... |
@@ -241,12 +241,12 @@ sandboxIO opts io = do |
|
241
|
241
|
then do
|
|
242
|
242
|
tid <- forkIO $ do
|
|
243
|
243
|
tid <- myThreadId
|
|
244
|
|
- ResumeContext{..} <- getThreadResumeContext tid
|
|
245
|
244
|
labelThread tid "GHCi sandbox"
|
|
246
|
|
- unsafeUnmask runIt >>= putMVar resumeStatusMVar
|
|
|
245
|
+ unsafeUnmask runIt >>= putMVar globalDbgStatusMVar -- TODO: see IDEA in 'globalDbgStatusMVar'
|
|
247
|
246
|
-- empty: can't block
|
|
248
|
|
- ResumeContext{..} <- getThreadResumeContext tid
|
|
249
|
|
- redirectInterrupts tid $ unsafeUnmask $ takeMVar resumeStatusMVar
|
|
|
247
|
+ redirectInterrupts tid $ unsafeUnmask $
|
|
|
248
|
+ takeMVar globalDbgStatusMVar -- TODO: following IDEA, here we should block
|
|
|
249
|
+ -- on either the globalDbgStatusVar or on the per-call EvalSuccess mvar (written above, needs diff var).
|
|
250
|
250
|
else
|
|
251
|
251
|
-- GLUT on OS X needs to run on the main thread. If you
|
|
252
|
252
|
-- try to use it from another thread then you just get a
|
| ... |
... |
@@ -375,7 +375,8 @@ resumeStmt opts rtid = do |
|
375
|
375
|
withBreakAction opts (Just resumeThreadId) $
|
|
376
|
376
|
mask_ $ do
|
|
377
|
377
|
putMVar resumeBreakMVar () -- this awakens the stopped thread...
|
|
378
|
|
- redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar
|
|
|
378
|
+ redirectInterrupts resumeThreadId $
|
|
|
379
|
+ takeMVar globalDbgStatusMVar -- TODO: See IDEA. This here is wrongish
|
|
379
|
380
|
|
|
380
|
381
|
-- when abandoning a computation we have to
|
|
381
|
382
|
-- (a) kill the thread with an async exception, so that the
|
| ... |
... |
@@ -395,7 +396,7 @@ abandonStmt hvref = do |
|
395
|
396
|
ResumeContext{..} <- getThreadResumeContext tid
|
|
396
|
397
|
killThread tid
|
|
397
|
398
|
putMVar resumeBreakMVar ()
|
|
398
|
|
- _ <- takeMVar resumeStatusMVar
|
|
|
399
|
+ _ <- takeMVar globalDbgStatusMVar -- TODO: See IDEA: this here is wrongish
|
|
399
|
400
|
return ()
|
|
400
|
401
|
|
|
401
|
402
|
globalBreakStablePtr :: StablePtr BreakpointCallback
|
| ... |
... |
@@ -415,7 +416,7 @@ globalBreakAction info_mod# info_mod_uid# infox# is_exception apStack = do |
|
415
|
416
|
info_mod <- BS.packCString (Ptr info_mod#)
|
|
416
|
417
|
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
|
|
417
|
418
|
pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
|
|
418
|
|
- putMVar resumeStatusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
|
|
|
419
|
+ putMVar globalDbgStatusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
|
|
419
|
420
|
|
|
420
|
421
|
-- Block until this thread is resumed (by the thread which took the
|
|
421
|
422
|
-- `ResumeContext` from the `statusMVar`).
|
| ... |
... |
@@ -476,21 +477,40 @@ clearEvalStatus = \case |
|
476
|
477
|
-- Global Debugger Per-Thread Context
|
|
477
|
478
|
-- TODO: when to clean?
|
|
478
|
479
|
|
|
479
|
|
-getThreadResumeContext :: ThreadId -> IO (ResumeContext [HValueRef])
|
|
|
480
|
+getThreadResumeContext :: ThreadId -> IO ResumeContext
|
|
480
|
481
|
getThreadResumeContext tid = modifyMVar globalBreakActionMap $ \gbm0 -> do
|
|
481
|
482
|
case Map.lookup tid gbm0 of
|
|
482
|
483
|
Nothing -> do
|
|
483
|
|
- r <- ResumeContext <$> newEmptyMVar <*> newEmptyMVar
|
|
|
484
|
+ r <- ResumeContext <$> newEmptyMVar
|
|
484
|
485
|
let !gbm1 = Map.insert tid r gbm0
|
|
485
|
486
|
pure (gbm1, r)
|
|
486
|
487
|
Just ctx -> do
|
|
487
|
488
|
pure (gbm0, ctx)
|
|
488
|
489
|
|
|
489
|
|
-globalBreakActionMap :: MVar (Map.Map ThreadId (ResumeContext [HValueRef]))
|
|
|
490
|
+-- | A global mapping from thread ids to the MVars on which they block when stopped.
|
|
|
491
|
+globalBreakActionMap :: MVar (Map.Map ThreadId ResumeContext)
|
|
490
|
492
|
globalBreakActionMap = unsafePerformIO $ newMVar Map.empty
|
|
491
|
493
|
{-# NOINLINE globalBreakActionMap #-}
|
|
492
|
494
|
|
|
493
|
|
-data ResumeContext a = ResumeContext
|
|
|
495
|
+newtype ResumeContext = ResumeContext
|
|
494
|
496
|
{ resumeBreakMVar :: MVar ()
|
|
495
|
|
- , resumeStatusMVar :: MVar (EvalStatus a)
|
|
|
497
|
+ -- ^ A thread that hits a breakpoint blocks reading its corresponding MVar
|
|
|
498
|
+ -- (gotten from the 'globalBreakActionMap').
|
|
|
499
|
+ -- The debugger can unblock that thread by signaling its MVar.
|
|
496
|
500
|
}
|
|
|
501
|
+
|
|
|
502
|
+-- | A global synchronization variable which a thread writes an 'EvalBreak' to
|
|
|
503
|
+-- when it hits a breakpoint. This variable is shared across all threads, and
|
|
|
504
|
+-- the debugger can read the threads which hit breakpoints by reading from this
|
|
|
505
|
+-- variable. It will also be written with 'EvalSuccess' when a `sandboxIO`
|
|
|
506
|
+-- action finishes (TODO: wait what? that is a bit weird. so what if we run two
|
|
|
507
|
+-- evalStmt? they will both race to write a result? but then how do we tell
|
|
|
508
|
+-- which result we got from where? this won't do in general, but let's see if
|
|
|
509
|
+-- it can solve some problems first)
|
|
|
510
|
+--
|
|
|
511
|
+-- IDEA: maybe `sandboxIO` and friends receive as an argument the var on which
|
|
|
512
|
+-- to expect the result specifically? And distinguish that from the global break var?
|
|
|
513
|
+-- Then we split the EvalSuccess and EvalBreak into two datatypes.
|
|
|
514
|
+globalDbgStatusMVar :: MVar (EvalStatus [HValueRef])
|
|
|
515
|
+globalDbgStatusMVar = unsafePerformIO $ newEmptyMVar
|
|
|
516
|
+{-# NOINLINE globalDbgStatusMVar #-} |