| ... |
... |
@@ -462,10 +462,9 @@ whereFrom interp ref = |
|
462
|
462
|
seqHValue :: Interp -> UnitEnv -> Logger -> ForeignHValue -> IO (EvalResult ())
|
|
463
|
463
|
seqHValue interp unit_env logger ref =
|
|
464
|
464
|
withForeignRef ref $ \hval -> do
|
|
465
|
|
- rtid <- interpCmd interp (Seq hval)
|
|
466
|
|
- status <- -- TODO redirectInterrupts interp rtid $
|
|
467
|
|
- interpCmd interp (WaitThreadResult rtid)
|
|
468
|
|
- freeHValueRefs interp [castRemoteRef rtid]
|
|
|
465
|
+ rtid <- interpCmd interp (Seq hval) >>= mkFinalizedHValue interp
|
|
|
466
|
+ status <- redirectInterrupts interp rtid $
|
|
|
467
|
+ waitThreadResult interp rtid
|
|
469
|
468
|
handleSeqHValueStatus interp unit_env logger (clearEvalStatus status)
|
|
470
|
469
|
|
|
471
|
470
|
evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
|
| ... |
... |
@@ -483,10 +482,10 @@ evalBreakpointToId eval_break = |
|
483
|
482
|
handleSeqHValueStatus :: Interp -> UnitEnv -> Logger -> EvalStatus () -> IO (EvalResult ())
|
|
484
|
483
|
handleSeqHValueStatus interp unit_env logger eval_status =
|
|
485
|
484
|
case eval_status of
|
|
486
|
|
- (EvalBreak _ maybe_break resume_ctxt _) -> do
|
|
|
485
|
+ (EvalBreak _ maybe_break resume_thread _) -> do
|
|
487
|
486
|
-- A breakpoint was hit; inform the user and tell them
|
|
488
|
487
|
-- which breakpoint was hit.
|
|
489
|
|
- resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
|
|
|
488
|
+ resume_thread <- liftIO $ mkFinalizedHValue interp resume_thread
|
|
490
|
489
|
let put loc = logMsg logger MCOutput loc ("*** Ignoring breakpoint" <+> brackets (ppr loc))
|
|
491
|
490
|
let nothing_case = put noSrcSpan
|
|
492
|
491
|
case maybe_break of
|
| ... |
... |
@@ -508,11 +507,10 @@ handleSeqHValueStatus interp unit_env logger eval_status = |
|
508
|
507
|
Just modbreaks -> put =<< getBreakLoc (readIModModBreaks hug) ibi modbreaks
|
|
509
|
508
|
|
|
510
|
509
|
-- resume the seq (:force) processing in the iserv process
|
|
511
|
|
- withForeignRef resume_ctxt_fhv $ \rtid -> do
|
|
512
|
|
- interpCmd interp (ResumeSeq rtid)
|
|
513
|
|
- status <- -- TODO: redirectInterrupts interp rtid $
|
|
514
|
|
- interpCmd interp (WaitThreadResult rtid)
|
|
515
|
|
- handleSeqHValueStatus interp unit_env logger (clearEvalStatus status)
|
|
|
510
|
+ withForeignRef resume_thread $ \rtid -> interpCmd interp (ResumeSeq rtid)
|
|
|
511
|
+ status <- redirectInterrupts interp resume_thread $
|
|
|
512
|
+ waitThreadResult interp resume_thread
|
|
|
513
|
+ handleSeqHValueStatus interp unit_env logger (clearEvalStatus status)
|
|
516
|
514
|
(EvalComplete _ r) -> return r
|
|
517
|
515
|
|
|
518
|
516
|
-- | While we're waiting for the target thread to return a result, if the
|
| ... |
... |
@@ -842,7 +840,7 @@ fromEvalResult :: EvalResult a -> IO a |
|
842
|
840
|
fromEvalResult (EvalException e) = throwIO (fromSerializableException e)
|
|
843
|
841
|
fromEvalResult (EvalSuccess a) = return a
|
|
844
|
842
|
|
|
845
|
|
-clearEvalStatus :: EvalStatus a -> EvalStatus ()
|
|
|
843
|
+clearEvalStatus :: EvalStatus_ a b -> EvalStatus ()
|
|
846
|
844
|
clearEvalStatus = \case
|
|
847
|
845
|
EvalComplete w (EvalException se) -> EvalComplete w (EvalException se)
|
|
848
|
846
|
EvalComplete w (EvalSuccess _) -> EvalComplete w (EvalSuccess ())
|