GitLab

Rodrigo Mesquita pushed to branch wip/romes/per-thread-step-in at Glasgow Haskell Compiler / GHC

Commits:

695b5398

by Rodrigo Mesquita at 2025-05-19T13:59:05+01:00

debugger: Toggle step-in per thread, not globally

The RTS global flag `rts_stop_next_breakpoint` used to tell the
interpreter to stop at the immediate next breakpoint.

Now, this flag is definited per thread in the TSO flag (TSO_STOP_NEXT_BREAKPOINT).
Being able to toggle "stop at next breakpoint" per thread is an
important requirement for implementing "stepping out" of a function in a
multi-threaded context.

More generally, having a per-thread flag for single-stepping paves the
way for multi-threaded debugging.

That said, when we want to enable "single step" mode for the whole
interpreted program we still want to stop at the immediate next
breakpoint, whichever thread it belongs to.
Therefore, use `rts_enableStopNextBreakpointAll` and
`rts_disableStopNextBreakpointAll` for the exisiting single-step
commands.

Preparation for #26042

6 changed files:

libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
libraries/ghci/GHCi/Run.hs
rts/Interpreter.c
rts/RtsSymbols.c
rts/include/rts/Constants.h

Changes:

libraries/ghc-heap/GHC/Exts/Heap/Closures.hs

@@ -624,6 +624,7 @@ data TsoFlags
    | TsoMarked
    | TsoSqueezed
    | TsoAllocLimit
 +  | TsoStopNextBreakpoint
    | TsoFlagsUnknownValue Word32 -- ^ Please report this as a bug
    deriving (Eq, Show, Generic, Ord)

libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc

@@ -87,6 +87,7 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset
                  | isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w)
                  | isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w)
                  | isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w)
 +                | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w)
  parseTsoFlags 0 = []
  parseTsoFlags w = [TsoFlagsUnknownValue w]

libraries/ghci/GHCi/Run.hs

  {-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP,
 -    UnboxedTuples, LambdaCase #-}
 +    UnboxedTuples, LambdaCase, UnliftedFFITypes #-}
  {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  -- |
@@ -396,13 +396,21 @@ abandonStmt hvref = do
    _ <- takeMVar resumeStatusMVar
    return ()
 -foreign import ccall "&rts_stop_next_breakpoint" stepFlag      :: Ptr CInt
 +foreign import ccall unsafe "rts_enableStopNextBreakpointAll"
 +  rts_enableStopNextBreakpointAll :: IO ()
++
 +foreign import ccall unsafe "rts_disableStopNextBreakpointAll"
 +  rts_disableStopNextBreakpointAll :: IO ()
++
  foreign import ccall "&rts_stop_on_exception"    exceptionFlag :: Ptr CInt
 +-- | Enables the single step mode for all threads, thus stopping at any
 +-- existing breakpoint.
  setStepFlag :: IO ()
 -setStepFlag = poke stepFlag 1
 +setStepFlag = rts_enableStopNextBreakpointAll
++
  resetStepFlag :: IO ()
 -resetStepFlag = poke stepFlag 0
 +resetStepFlag = rts_disableStopNextBreakpointAll
  type BreakpointCallback
       = Addr#   -- pointer to the breakpoint tick module name

rts/Interpreter.c

@@ -243,9 +243,25 @@ allocate_NONUPD (Capability *cap, int n_words)
      return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
+ }
 +// A global toggle for single-step mode.
 +// Unlike `TSO_STOP_NEXT_BREAKPOINT`, which sets single-step mode per-thread,
 +// `rts_stop_next_breakpoint` globally enables single-step mode. If enabled, we
 +// will stop at the immediate next breakpoint regardless of what thread it is in.
  int rts_stop_next_breakpoint = 0;
  int rts_stop_on_exception = 0;
 +// Enable "TSO_STOP_NEXT_BREAKPOINT" on all TSOs
 +void rts_enableStopNextBreakpointAll()
 +{
 +  rts_stop_next_breakpoint = 1;
 +}
++
 +// Disable "TSO_STOP_NEXT_BREAKPOINT" on all TSOs
 +void rts_disableStopNextBreakpointAll()
 +{
 +  rts_stop_next_breakpoint = 0;
 +}
++
  #if defined(INTERP_STATS)
  #define N_CODES 128
@@ -1250,7 +1266,7 @@ run_BCO:
              int arg8_cc;
  #endif
              StgArrBytes *breakPoints;
 -            int returning_from_break;
 +            int returning_from_break, stop_next_breakpoint;
              // the io action to run at a breakpoint
              StgClosure *ioAction;
@@ -1280,6 +1296,13 @@ run_BCO:
              returning_from_break =
                  cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT;
 +            // check whether this thread is set to stop at the immediate next
 +            // breakpoint -- either by the global `rts_stop_next_breakpoint`
 +            // flag, or by the local `TSO_STOP_NEXT_BREAKPOINT`
 +            stop_next_breakpoint =
 +              rts_stop_next_breakpoint ||
 +                cap->r.rCurrentTSO->flags & TSO_STOP_NEXT_BREAKPOINT;
++
  #if defined(PROFILING)
              cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
                                            (CostCentre*)BCO_LIT(arg8_cc));
@@ -1290,21 +1313,23 @@ run_BCO:
              if (!returning_from_break)
+             {
                 breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
++
                 // stop the current thread if either the
 -               // "rts_stop_next_breakpoint" flag is true OR if the
 +               // "TSO_STOP_NEXT_BREAKPOINT" flag is true OR if the
                 // ignore count for this particular breakpoint is zero
                 StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
 -               if (rts_stop_next_breakpoint == false && ignore_count > 0)
 +               if (stop_next_breakpoint == false && ignore_count > 0)
+                {
                    // decrement and write back ignore count
                    ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
+                }
 -               else if (rts_stop_next_breakpoint == true || ignore_count == 0)
 +               else if (stop_next_breakpoint == true || ignore_count == 0)
+                {
                    // make sure we don't automatically stop at the
                    // next breakpoint
 -                  rts_stop_next_breakpoint = false;
 +                  rts_stop_next_breakpoint = 0;
 +                  cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
                    // allocate memory for a new AP_STACK, enough to
                    // store the top stack frame plus an

rts/RtsSymbols.c

@@ -906,7 +906,8 @@ extern char **environ;
        SymI_HasProto(revertCAFs)                                         \
        SymI_HasProto(RtsFlags)                                           \
        SymI_NeedsDataProto(rts_breakpoint_io_action)                     \
 -      SymI_NeedsDataProto(rts_stop_next_breakpoint)                     \
 +      SymI_NeedsDataProto(rts_enableStopNextBreakpointAll)              \
 +      SymI_NeedsDataProto(rts_disableStopNextBreakpointAll)             \
        SymI_NeedsDataProto(rts_stop_on_exception)                        \
        SymI_HasProto(stopTimer)                                          \
        SymI_HasProto(n_capabilities)                                     \

rts/include/rts/Constants.h

@@ -328,6 +328,12 @@
   */
  #define TSO_ALLOC_LIMIT 256
 +/*
 + * Enables step-in mode for this thread -- it will stop at the immediate next
 + * breakpoint found in this thread.
 + */
 +#define TSO_STOP_NEXT_BREAKPOINT 512
++
  /*
   * The number of times we spin in a spin lock before yielding (see
   * #3758).  To tune this value, use the benchmark in #3758: run the