GitLab

Rodrigo Mesquita pushed to branch wip/romes/multi-threaded-debugger at Glasgow Haskell Compiler / GHC

Commits:

9d82db82
by Rodrigo Mesquita at 2026-09-03T18:44:53+01:00
```
ThreadBreaksIsolationMode
```

4 changed files:

compiler/GHC.hs
compiler/GHC/Runtime/Eval.hs
compiler/GHC/Runtime/Eval/Types.hs
ghc/GHCi/UI/Monad.hs

Changes:

@@ -198,7 +198,7 @@ module GHC (
          isStmt, hasImport, isImport, isDecl,
          -- ** The debugger
 -        SingleStep(..),
 +        SingleStep(..), ThreadBreaksIsolationMode(..),
          Resume(..),
          History(historyBreakpointId, historyEnclosingDecls),
          GHC.getHistorySpan, getHistoryModule,

compiler/GHC/Runtime/Eval.hs

@@ -13,7 +13,7 @@ module GHC.Runtime.Eval (
          Resume(..), History(..),
          execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec,
          runDecls, runDeclsWithLocation, runParsedDecls,
 -        parseImportDecl, SingleStep(..),
 +        parseImportDecl, SingleStep(..), ThreadBreaksIsolationMode(..),
          abandon, abandonAll,
          getResumeContext,
          getHistorySpan,
@@ -184,8 +184,8 @@ execOptions = ExecOptions
    , execSourceFile = "<interactive>"
    , execLineNumber = 1
    , execWrap = EvalThis -- just run the statement, don't wrap it in anything
 -  , execIsolateBreaks = True
 -    -- by default we just care about breakpoints hit in this "main" thread
 +  , execIsolateMode = SingleThreadedBreaks
 +    -- by default we just care about breakpoints hit in this eval thread
+   }
  -- | Run a statement in the current interactive context.
@@ -211,7 +211,7 @@ execStmt input exec_opts@ExecOptions{..} = do
  -- doing preprocessing on the AST before execution, e.g. in GHCi (see
  -- GHCi.UI.runStmt).
  execStmt' :: GhcMonad m => GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult
 -execStmt' stmt stmt_text opts@ExecOptions{..} = do
 +execStmt' stmt stmt_text ExecOptions{..} = do
      hsc_env <- getSession
      let interp = hscInterp hsc_env
@@ -232,8 +232,8 @@ execStmt' stmt stmt_text opts@ExecOptions{..} = do
          status <-
            liftIO $ do
 -            let eval_opts = initEvalOpts idflags' (enableGhcStepMode execSingleStep)
 -                              { isolateThreadBreaks = execIsolateThreadBreaks }
 +            let eval_opts = (initEvalOpts idflags' (enableGhcStepMode execSingleStep))
 +                              { isolateThreadBreaks = enableIsolateThreadBreaks execIsolateMode }
              evalStmt interp eval_opts (execWrap hval)
          let ic = hsc_IC hsc_env
@@ -241,7 +241,7 @@ execStmt' stmt stmt_text opts@ExecOptions{..} = do
              size = ghciHistSize idflags'
 -        handleRunStatus opts stmt_text bindings ids
 +        handleRunStatus execSingleStep execIsolateMode stmt_text bindings ids
                          status (emptyHistory size)
  runDecls :: GhcMonad m => String -> m [Name]
@@ -293,15 +293,15 @@ emptyHistory size = nilBL size
  -- breakpoint if we don't care about that breakpoint (e.g. if using :steplocal
  -- or :stepmodule, rather than :step, we only care about certain breakpoints).
  handleRunStatus :: GhcMonad m
 -                => ExecOptions
 +                => SingleStep
 +                -> ThreadBreaksIsolationMode
                  -> String
                  -> ResumeBindings
                  -> [Id]
                  -> EvalStatus_ [ForeignHValue] [HValueRef]
                  -> BoundedList History
                  -> m ExecResult
 -handleRunStatus ExecOptions{execSingleStep = step, execIsolateThreadBreaks}
 -                expr bindings final_ids status history0 = do
 +handleRunStatus step isolateMode expr bindings final_ids status history0 = do
    hsc_env <- getSession
    let
      interp = hscInterp hsc_env
@@ -395,22 +395,25 @@ handleRunStatus ExecOptions{execSingleStep = step, execIsolateThreadBreaks}
          return (ExecBreak names (Just ibi))
        else do
          -- resume with the same step type
 -        let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
 -                          { isolateThreadBreaks = execIsolateThreadBreaks }
 +        let eval_opts = (initEvalOpts dflags (enableGhcStepMode step))
 +                          { isolateThreadBreaks = enableIsolateThreadBreaks isolateMode }
          status <- liftIO $ GHCi.resumeStmt interp eval_opts resume_ctxt_fhv
          history <- if not tracing then pure history0 else do
            history1 <- liftIO $ mkHistory hug apStack_fhv ibi
            let !history' = history1 `consBL` history0
                  -- history is strict, otherwise our BoundedList is pointless.
            return history'
 -        handleRunStatus step expr bindings final_ids status history
 +        handleRunStatus step isolateMode expr bindings final_ids status history
   where
    tracing | RunAndLogSteps <- step = True
            | otherwise              = False
 -resumeExec :: GhcMonad m => SingleStep -> Maybe Int
 +resumeExec :: GhcMonad m
 +           => SingleStep
 +           -> ThreadBreaksIsolationMode
 +           -> Maybe Int
             -> m ExecResult
 -resumeExec step mbCnt
 +resumeExec step isolateMode mbCnt
   = do
     hsc_env <- getSession
     let ic = hsc_IC hsc_env
@@ -455,7 +458,8 @@ resumeExec step mbCnt
                    (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt
                    _ -> return ()
 -                let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
 +                let eval_opts = (initEvalOpts dflags (enableGhcStepMode step))
 +                                  { isolateThreadBreaks = enableIsolateThreadBreaks isolateMode }
                  status <- liftIO $ GHCi.resumeStmt interp eval_opts fhv
                  let prevHistoryLst = fromListBL 50 hist
                      hug = hsc_HUG hsc_env
@@ -466,7 +470,7 @@ resumeExec step mbCnt
                              hist1 <- liftIO (mkHistory hug apStack bi)
                              return $ hist1 `consBL` fromListBL 50 hist
                           | otherwise -> pure prevHistoryLst
 -                handleRunStatus step expr bindings final_ids status =<< hist'
 +                handleRunStatus step isolateMode expr bindings final_ids status =<< hist'
  setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m ()   -- #19157
  setupBreakpoint interp ibi cnt = do

compiler/GHC/Runtime/Eval/Types.hs

@@ -10,6 +10,7 @@ module GHC.Runtime.Eval.Types (
          Resume(..), ResumeBindings, IcGlobalRdrEnv(..),
          History(..), ExecResult(..),
          SingleStep(..), enableGhcStepMode, breakHere,
 +        ThreadBreaksIsolationMode(..), enableIsolateThreadBreaks,
          ExecOptions(..)
          ) where
@@ -36,7 +37,8 @@ data ExecOptions
       , execSourceFile :: String             -- ^ filename (for errors)
       , execLineNumber :: Int                -- ^ line number (for errors)
       , execWrap :: ForeignHValue -> EvalExpr ForeignHValue
 -     , execIsolateThreadBreaks :: Bool      -- ^ just like @'isolateThreadBreaks'@
 +     , execIsolateMode :: ThreadBreaksIsolationMode
 +                                            -- ^ like @'isolateThreadBreaks'@
+      }
  -- | What kind of stepping are we doing?
@@ -65,6 +67,17 @@ data SingleStep
     | ModuleStep
        { breakAt :: SrcSpan }
 +-- | Just like @'isolateThreadBreaks'@, determining whether the
 +-- execution/resuming execution of an expression should stop whenever any
 +-- non-isolated thread hits a breakpoint, or only when the thread executing
 +-- that expression specifically stops.
 +data ThreadBreaksIsolationMode
 +  -- | Stop exclusively on the breakpoints in this thread
 +  = SingleThreadedBreaks
 +  -- | Stop whenever any thread that is not running in 'SingleThreadedBreaks'
 +  -- isolation mode hits a breakpoint
 +  | MultiThreadedBreaks
++
  -- | Whether this 'SingleStep' mode requires instructing the interpreter to
  -- step at every breakpoint or after every return (see @'EvalStep'@).
  enableGhcStepMode :: SingleStep -> EvalStep
@@ -73,6 +86,10 @@ enableGhcStepMode StepOut{}       = EvalStepOut
  -- for the remaining step modes we need to stop at every single breakpoint.
  enableGhcStepMode _               = EvalStepSingle
 +enableIsolateThreadBreaks :: ThreadBreaksIsolationMode -> Bool
 +enableIsolateThreadBreaks SingleThreadedBreaks = True
 +enableIsolateThreadBreaks MultiThreadedBreaks  = False
++
  -- | Given a 'SingleStep' mode, whether the breakpoint was explicitly active,
  -- and the SrcSpan of a breakpoint we hit, return @True@ if we should stop at
  -- this breakpoint.

ghc/GHCi/UI/Monad.hs

@@ -412,7 +412,7 @@ resume step mbIgnoreCnt = do
      withProgName (progname st) $
      withArgs (args st) $
        reflectGHCi x $ do
 -        GHC.resumeExec step mbIgnoreCnt
 +        GHC.resumeExec step GHC.SingleThreadedBreaks mbIgnoreCnt
  -- --------------------------------------------------------------------------
  -- timing & statistics