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 ===================================== @@ -1,5 +1,5 @@ {-# 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 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/695b5398aa4e15265fdae3e0e603d283... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/695b5398aa4e15265fdae3e0e603d283... You're receiving this email because of your account on gitlab.haskell.org.