GitLab

Rodrigo Mesquita pushed to branch wip/romes/set-break-flags at Glasgow Haskell Compiler / GHC

Commits:

97087c12

by Rodrigo Mesquita at 2026-11-03T18:33:35+00:00

interp: Set per-thread break flags consistently on eval/resume

Currently, the per-thread flags are:
- Single-step: Stop at the immediate next breakpoint in this thread
- Step-out: Stop at the next continuation with a breakpoint this thread
  returns to.
- Break-on-exception: Stop the next time a synchronous exception is
  raised in this thread.

Originally, these flags were all set globally across all threads. More
recently, these flags are set per-thread when `resume`ing that thread,
but globally when starting the evaluation of a new expression
(`evalStmt`).

With this commit, we now use per-TSO flags in both scenarios evaluating
expressions in the interpreter (`evalStmt` and `resumeStmt`).
- In `resumeStmt` we set the `EvalOpts` specifically in the `ThreadId`
  being resumed.
- In `evalStmt`, we set the `EvalOpts` exclusively on the sandbox thread
  we fork to evaluate the given expression
    - When not using the sandbox thread (i.e. -fno-ghci-sandbox), we
      don't support the debugger anyway, so the break flags are
      irrelevant.

We do this by consistently calling `setBreakFlags` when starting,
resuming, or killing the evaluation.
See Note [Always setBreakFlags on running thread].

This slightly changes the behavior of evaluating a new expression in
the debugger (resuming a thread behaves the same as before). Namely,

`:step <expr>`, where <expr> forks a thread, will stop at the immediate
next breakpoint in the <expr> main thread, not on a breakpoint of any
forked thread.

NB: the forked thread may still stop at breakpoint, if it is enabled by
index specifically, and then :step-ing from that thread's breakpoint
will toggle per-thread stepping for that forked thread.

We will want to control stepping in "all threads, regardless of whether
we control them or if they were spawned by the debuggee" separately from
the commands which trigger evaluation of just an expression. Namely,
we'll likely want a "break at the next immediate breakpoint hit on ANY
thread" command that the user can execute before launching a debuggee
which is multi-threaded. This may even be the default for GHCi.

Towards #26064

Fixes #28080

6 changed files:

+ changelog.d/28080
libraries/ghci/GHCi/Run.hs
testsuite/tests/ghci.debugger/scripts/all.T
+ testsuite/tests/ghci.debugger/scripts/break037.hs
+ testsuite/tests/ghci.debugger/scripts/break037.script
+ testsuite/tests/ghci.debugger/scripts/break037.stdout

Changes:

changelog.d/28080

 +section: ghci
 +synopsis: ``evalStmt <expr>`` break flags apply only to the main expression thread
 +issues: #28080 #26064
 +mrs: !16922
++
 +description: {
 +  The per-thread debugger flags (single-step, step-out and break-on-exception)
 +  are now set only on the sandbox thread forked to evaluate a new expression,
 +  rather than globally on all threads.
++
 +  As a consequence, ``:step <expr>``, where ``<expr>`` forks a thread, now stops
 +  at the next breakpoint in the thread evaluating ``<expr>``, not at a
 +  breakpoint in any forked thread. A forked thread may still stop at a
 +  breakpoint that was explicitly enabled, and ``:step``-ing from there enables
 +  stepping for that thread.
 +}

libraries/ghci/GHCi/Run.hs

@@ -204,7 +204,8 @@ doSeq ref = do
  resumeSeq :: RemoteRef (ResumeContext ()) -> IO (EvalStatus ())
  resumeSeq hvref = do
      ResumeContext{..} <- localRef hvref
 -    withBreakAction evalOptsSeq resumeBreakMVar resumeStatusMVar (Just resumeThreadId) $
 +    setBreakFlags evalOptsSeq resumeThreadId
 +    withBreakAction resumeBreakMVar resumeStatusMVar $
        mask_ $ do
          putMVar resumeBreakMVar () -- this awakens the stopped thread...
          redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar
@@ -233,15 +234,23 @@ sandboxIO opts io = do
    -- We are running in uninterruptibleMask
    breakMVar <- newEmptyMVar
    statusMVar <- newEmptyMVar
 -  withBreakAction opts breakMVar statusMVar Nothing $ do
 +  withBreakAction breakMVar statusMVar $ do
      let runIt = measureAlloc $ tryEval $ rethrow opts $ clearCCS io
      if useSandboxThread opts
         then do
 +         wait <- newEmptyMVar
           tid <- forkIO $ do
++
 +           takeMVar wait -- don't run anything in this thread before
 +                         -- `setBreakFlags` sets up.
++
             tid <- myThreadId
             labelThread tid "GHCi sandbox"
             unsafeUnmask runIt >>= putMVar statusMVar
                                  -- empty: can't block
++
 +         setBreakFlags opts tid -- set flags on the sandbox thread
 +         putMVar wait ()
           redirectInterrupts tid $ unsafeUnmask $ takeMVar statusMVar
         else
            -- GLUT on OS X needs to run on the main thread. If you
@@ -328,34 +337,19 @@ tryEval io = do
      Right a -> return (EvalSuccess a)
  -- This function sets up the interpreter for catching breakpoints, and
 --- resets everything when the computation has stopped running.  This
 --- is a not-very-good way to ensure that only the interactive
 +-- resets the breakpoint action when the computation has stopped running.
 +-- This is a not-very-good way to ensure that only the interactive
  -- evaluation should generate breakpoints.
 -withBreakAction :: EvalOpts -> MVar ()
 +withBreakAction :: MVar ()
                  -> MVar (EvalStatus b)
 -                -> Maybe ThreadId -- ^ If resuming, the current threadId
                  -> IO a -> IO a
 -withBreakAction opts breakMVar statusMVar mtid act
 +withBreakAction breakMVar statusMVar act
   = bracket setBreakAction resetBreakAction (\_ -> act)
   where
     setBreakAction = do
       stablePtr <- newStablePtr onBreak
       poke breakPointIOAction stablePtr
 -     when (breakOnException opts) $ do
 -      case mtid of
 -        Nothing -> rts_enableStopOnExceptionAll
 -        Just (ThreadId tid) -> do
 -          rts_enableStopOnException tid
 -     when (singleStep opts) rts_enableStopNextBreakpointAll
 -     when (stepOut opts) $ do
 -      case mtid of
 -        Nothing -> rts_enableStopNextBreakpointAll -- just enable single-step when no thread is stopped
 -        Just (ThreadId tid) -> do
 -          rts_enableStopAfterReturn tid
       return stablePtr
 -        -- Breaking on exceptions is not enabled by default, since it
 -        -- might be a bit surprising.  The exception flag is turned off
 -        -- as soon as it is hit, or in resetBreakAction below.
     onBreak :: BreakpointCallback
     onBreak info_mod# info_mod_uid# infox# is_exception apStack = do
@@ -387,21 +381,56 @@ withBreakAction opts breakMVar statusMVar mtid act
     resetBreakAction stablePtr = do
       poke breakPointIOAction noBreakStablePtr
 -     case mtid of
 -      Just (ThreadId tid) -> rts_disableStopOnException tid
 -      _                   -> rts_disableStopOnExceptionAll
 -     rts_disableStopNextBreakpointAll
 -     case mtid of
 -      Just (ThreadId tid) -> rts_disableStopAfterReturn tid
 -      _                   -> pure ()
       freeStablePtr stablePtr
 +-- | Set the single-step, step-out, and break-on-exception flags on the target
 +-- thread based on the given 'EvalOpts'.
 +--
 +-- Breaking on exceptions is not enabled by default, since it might be a
 +-- bit surprising. The exception flag is turned off as soon as it is hit.
 +--
 +-- See Note [Always setBreakFlags on running thread]
 +setBreakFlags :: EvalOpts -> ThreadId -> IO ()
 +setBreakFlags opts (ThreadId tid#) = do
 +  setFlag# breakOnException rts_enableStopOnException    rts_disableStopOnException
 +  setFlag# singleStep       rts_enableStopNextBreakpoint rts_disableStopNextBreakpoint
 +  setFlag# stepOut          rts_enableStopAfterReturn    rts_disableStopAfterReturn
 +  where
 +    setFlag# pred on off = if pred opts then on tid# else off tid#
++
 +{-
 +Note [Always setBreakFlags on running thread]
 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 +Whenever we run a expression in the interpreter or unblock a paused thread we
 +must make sure all breakpoint-flags for that thread are set according to the
 +given options. There are three scenarios in which we set something running:
++
 +- `evalStmt`, forks a thread to evaluate the given expression
 +- `resumeStmt`, unblocks a given thread to resume execution
 +- `abandonStmt`, kills a given thread to terminate execution (but the thread
 +- will resume to handle the exception)
++
 +In these three cases, if we musn't forget to set all breakpoint flags,
 +since otherwise we'd resume execution with whatever stale state we had of the
 +previous run command. A trivial example would be (tested by break037):
++
 +1. `evalStmt` with { singleStep = True, breakOnError = True } would e.g. stop on
 +  an exception and clear TSO_STOP_ON_EXCEPTION, but TSO_STOP_NEXT_BREAKPOINT
 +  would still be active.
 +2. `abandonStmt` if we didn't setBreakFlags again would kill the thread but
 +  hit the next breakpoint bc TSO_STOP_NEXT_BREAKPOINT would still be active.
++
 +Likewise for other interactions between eval/resume/abandon.
 +TL;DR: always `setBreakFlags` when running/resuming a thread
 +-}
++
  resumeStmt
    :: EvalOpts -> RemoteRef (ResumeContext [HValueRef])
    -> IO (EvalStatus [HValueRef])
  resumeStmt opts hvref = do
    ResumeContext{..} <- localRef hvref
 -  withBreakAction opts resumeBreakMVar resumeStatusMVar (Just resumeThreadId) $
 +  setBreakFlags opts resumeThreadId
 +  withBreakAction resumeBreakMVar resumeStatusMVar $
      mask_ $ do
        putMVar resumeBreakMVar () -- this awakens the stopped thread...
        redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar
@@ -421,10 +450,20 @@ resumeStmt opts hvref = do
  abandonStmt :: RemoteRef (ResumeContext [HValueRef]) -> IO ()
  abandonStmt hvref = do
    ResumeContext{..} <- localRef hvref
 +  setBreakFlags evalOptsAbandon resumeThreadId
    killThread resumeThreadId
    putMVar resumeBreakMVar ()
    _ <- takeMVar resumeStatusMVar
    return ()
 +  where
 +    -- Don't stop anywhere on abandon
 +    evalOptsAbandon = EvalOpts
 +      { useSandboxThread = True
 +      , singleStep = False
 +      , stepOut    = False
 +      , breakOnException = False
 +      , breakOnError = False
 +      }
  noBreakStablePtr :: StablePtr BreakpointCallback
  noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction

testsuite/tests/ghci.debugger/scripts/all.T

@@ -157,3 +157,4 @@ test('T26042g', extra_files(['T26042g.hs']), ghci_script, ['T26042g.script'])
  test('T27633c', extra_files(['T27633c_obj.hs']), ghci_script, ['T27633c.script'])
  test('RttiSharedTyVar', extra_files(['RttiSharedTyVar.hs']), ghci_script, ['RttiSharedTyVar.script'])
 +test('break037', extra_files(['break037.hs']), ghci_script, ['break037.script'])

testsuite/tests/ghci.debugger/scripts/break037.hs

 +module Main where
++
 +import Control.Exception
++
 +f :: () -> IO ()
 +f () = throwIO (ErrorCall "boom") `finally` g ()
++
 +g :: () -> IO ()
 +g () = putStrLn "cleanup"
++
 +main :: IO ()
 +main = f ()

testsuite/tests/ghci.debugger/scripts/break037.script

 +:l break037
 +:set -fbreak-on-exception
 +:step f ()
 +:step
 +-- Stepping into throwIO stops on the exception rather than at a breakpoint
 +:step
 +-- Running the cleanup in g while abandoning must not hit a breakpoint
 +:abandon
 +putStrLn "after abandon"

testsuite/tests/ghci.debugger/scripts/break037.stdout

 +Stopped in Main.f, break037.hs:6:8-48
 +_result :: IO () = _
 +Stopped in Main.f, break037.hs:6:8-33
 +_result :: IO () = _
 +Stopped in <exception thrown>, <unknown>
 +_exception :: e = _
 +cleanup
 +after abandon