Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC Commits: f5c6d98e by Rodrigo Mesquita at 2025-08-01T21:30:27+01:00 debugger: Re-use the last BreakpointId whole in step-out Previously, to come up with a location to stop at for `:stepout`, we would store the location of the last BreakpointId surrounding the continuation, as described by Note [Debugger: Stepout internal break locs]. However, re-using just the location from the last source breakpoint isn't sufficient to provide the necessary information in the break location. Specifically, it wouldn't bind any variables at that location. Really, there is no reason not to re-use the last breakpoint wholesale, and re-use all the information we had there. Step-out should behave just as if we had stopped at the call, but s.t. continuing will not re-execute the call. This commit updates the CgBreakInfo to always store a BreakpointId, be it the original one or the one we're emulating (for step-out). It makes variable bindings on :stepout work - - - - - 13 changed files: - compiler/GHC/ByteCode/Breakpoints.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Debugger/Breakpoints.hs - compiler/GHC/StgToByteCode.hs - ghc/GHCi/UI.hs - testsuite/tests/ghci.debugger/scripts/T26042b.script - testsuite/tests/ghci.debugger/scripts/T26042b.stdout - testsuite/tests/ghci.debugger/scripts/T26042c.stdout - testsuite/tests/ghci.debugger/scripts/T26042d2.stdout - testsuite/tests/ghci.debugger/scripts/T26042e.stdout - testsuite/tests/ghci.debugger/scripts/T26042f.script - testsuite/tests/ghci.debugger/scripts/T26042f2.stdout - testsuite/tests/ghci.debugger/scripts/T26042g.stdout Changes: ===================================== compiler/GHC/ByteCode/Breakpoints.hs ===================================== @@ -177,15 +177,17 @@ data CgBreakInfo -- necessarily the same: See Note [Breakpoint identifiers]. -- -- If there is no original tick identifier (that is, the breakpoint was - -- created during code generation), instead refer directly to the SrcSpan - -- we want to use for it. + -- created during code generation), we re-use the BreakpointId of something else. + -- It would also be reasonable to have an @Either something BreakpointId@ + -- for @cgb_tick_id@, but currently we can always re-use a source-level BreakpointId. + -- In the case of step-out, see Note [Debugger: Stepout internal break locs] } -- See Note [Syncing breakpoint info] in GHC.Runtime.Eval -- | Breakpoints created during code generation don't have a source-level tick --- location. Instead, we come up with one ourselves. -newtype InternalBreakLoc = InternalBreakLoc SrcSpan - deriving newtype (Eq, Show, NFData, Outputable) +-- location. Instead, we re-use an existing one. +newtype InternalBreakLoc = InternalBreakLoc { internalBreakLoc :: BreakpointId } + deriving newtype (Eq, NFData, Outputable) -- | Get an internal breakpoint info by 'InternalBreakpointId' getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo @@ -207,36 +209,34 @@ assert_modules_match ibi_mod imbs_mod = -- | Get the source module and tick index for this breakpoint -- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId') -getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> Either InternalBreakLoc BreakpointId +getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs = assert_modules_match ibi_mod (imodBreaks_module imbs) $ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix - in cgb_tick_id cgb + in either internalBreakLoc id (cgb_tick_id cgb) -- | Get the source module for this breakpoint (where the breakpoint is defined) getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs = assert_modules_match ibi_mod (imodBreaks_module imbs) $ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix - in case cgb_tick_id cgb of - Left InternalBreakLoc{} -> imodBreaks_module imbs - Right BreakpointId{bi_tick_mod} -> bi_tick_mod + in either (bi_tick_mod . internalBreakLoc) bi_tick_mod (cgb_tick_id cgb) -- | Get the source span for this breakpoint getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan -getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x) +getBreakLoc = getBreakXXX modBreaks_locs -- | Get the vars for this breakpoint getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName] -getBreakVars = getBreakXXX modBreaks_vars (const []) +getBreakVars = getBreakXXX modBreaks_vars -- | Get the decls for this breakpoint getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String] -getBreakDecls = getBreakXXX modBreaks_decls (const []) +getBreakDecls = getBreakXXX modBreaks_decls -- | Get the decls for this breakpoint -getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String)) -getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing) +getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO ((String, String)) +getBreakCCS = getBreakXXX modBreaks_ccs -- | Internal utility to access a ModBreaks field at a particular breakpoint index -- @@ -253,12 +253,12 @@ getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing) -- -- To avoid cyclic dependencies, we instead receive a function that looks up -- the 'ModBreaks' given a 'Module' -getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a -getBreakXXX view viewInternal lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs = +getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a +getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs = assert_modules_match ibi_mod (imodBreaks_module imbs) $ do let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix - case cgb_tick_id cgb of - Right BreakpointId{bi_tick_mod, bi_tick_index} + case either internalBreakLoc id (cgb_tick_id cgb) of + BreakpointId{bi_tick_mod, bi_tick_index} | bi_tick_mod == ibi_mod -> do let these_mbs = imodBreaks_modBreaks imbs @@ -267,8 +267,6 @@ getBreakXXX view viewInternal lookupModule (InternalBreakpointId ibi_mod ibi_ix) -> do other_mbs <- lookupModule bi_tick_mod return $ view other_mbs ! bi_tick_index - Left l -> - return $ viewInternal l -------------------------------------------------------------------------------- -- Instances ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -1712,10 +1712,8 @@ allocateCCS interp ce mbss let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo let ccs = IM.map (\info -> - case cgb_tick_id info of - Right bi -> fromMaybe (toRemotePtr nullPtr) - (M.lookup bi ccss) - Left InternalBreakLoc{} -> toRemotePtr nullPtr + fromMaybe (toRemotePtr nullPtr) + (M.lookup (either internalBreakLoc id (cgb_tick_id info)) ccss) ) imodBreaks_breakInfo assertPpr (count == length ccs) ===================================== compiler/GHC/Runtime/Debugger/Breakpoints.hs ===================================== @@ -257,6 +257,8 @@ mkBreakpointOccurrences = do Right (BreakpointId tick_mod tick_ix) -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi]) Left _ + -- Do not include internal breakpoints in the visible breakpoint + -- occurrences! -> bmp ) bmp0 (imodBreaks_breakInfo ibrks) ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -63,7 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU, assertNonVoidIds, assertNonVoidStgArgs ) import GHC.StgToCmm.Layout import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes) -import GHC.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks ) +import GHC.Runtime.Interpreter ( interpreterProfiled ) import GHC.Data.Bitmap import GHC.Data.FlatBag as FlatBag import GHC.Data.OrdList @@ -99,7 +99,7 @@ import GHC.CoreToIface import Control.Monad.IO.Class import Control.Monad.Trans.Reader (ReaderT(..)) import Control.Monad.Trans.State (StateT(..)) -import Data.Array ((!)) +import Data.Bifunctor (Bifunctor(..)) -- ----------------------------------------------------------------------------- -- Generating byte code for a complete module @@ -402,11 +402,16 @@ schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do -- See Note [Debugger: Stepout internal break locs] code <- withBreakTick bp $ schemeE d 0 p rhs - let idOffSets = getVarOffSets platform d p fvs + -- As per Note [Stack layout when entering run_BCO], the breakpoint AP_STACK + -- as we yield from the interpreter is headed by a stg_apply_interp + BCO to be a valid stack. + -- Therefore, the var offsets are offset by 2 words + let idOffSets = map (fmap (second (+2))) $ + getVarOffSets platform d p fvs ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs) toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word) toWord = fmap (\(i, wo) -> (i, fromIntegral wo)) - breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Right tick_id) + breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty + (Right tick_id) mibi <- newBreakInfo breakInfo @@ -416,21 +421,15 @@ schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do schemeER_wrk d p rhs = schemeE d 0 p rhs +-- | Get the offset in words into this breakpoint's AP_STACK which contains the matching Id getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)] getVarOffSets platform depth env = map getOffSet where getOffSet id = case lookupBCEnv_maybe id env of - Nothing -> Nothing - Just offset -> - -- michalt: I'm not entirely sure why we need the stack - -- adjustment by 2 here. I initially thought that there's - -- something off with getIdValFromApStack (the only user of this - -- value), but it looks ok to me. My current hypothesis is that - -- this "adjustment" is needed due to stack manipulation for - -- BRK_FUN in Interpreter.c In any case, this is used only when - -- we trigger a breakpoint. - let !var_depth_ws = bytesToWords platform (depth - offset) + 2 - in Just (id, var_depth_ws) + Nothing -> Nothing + Just offset -> + let !var_depth_ws = bytesToWords platform (depth - offset) + in Just (id, var_depth_ws) fvsToEnv :: BCEnv -> CgStgRhs -> [Id] -- Takes the free variables of a right-hand side, and @@ -1141,10 +1140,17 @@ doCase d s p scrut bndr alts -- When an alt is entered, it assumes the returned value is -- on top of the itbl; see Note [Return convention for non-tuple values] -- for details. - ret_frame_size_w :: WordOff - ret_frame_size_w | ubx_tuple_frame = - if profiling then 5 else 4 - | otherwise = 2 + ctoi_frame_header_w :: WordOff + ctoi_frame_header_w + | ubx_tuple_frame = + if profiling then 5 else 4 + | otherwise = 2 + + -- The size of the ret_*_info frame header, whose frame returns the + -- value to the case continuation frame (ctoi_*_info) + ret_info_header_w :: WordOff + | ubx_tuple_frame = 3 + | otherwise = 1 -- The stack space used to save/restore the CCCS when profiling save_ccs_size_b | profiling && @@ -1319,12 +1325,10 @@ doCase d s p scrut bndr alts let -- drop the stg_ctoi_*_info header... - alt_final1 = SLIDE bndr_size ret_frame_size_w `consOL` alt_final0 + alt_final1 = SLIDE bndr_size ctoi_frame_header_w `consOL` alt_final0 -- after dropping the stg_ret_*_info header - alt_final2 - | ubx_tuple_frame = SLIDE 0 3 `consOL` alt_final1 - | otherwise = SLIDE 0 1 `consOL` alt_final1 + alt_final2 = SLIDE 0 ret_info_header_w `consOL` alt_final1 -- When entering a case continuation BCO, the stack is always headed -- by the stg_ret frame and the stg_ctoi frame that returned to it. @@ -1341,14 +1345,21 @@ doCase d s p scrut bndr alts -- continuation BCO, for step-out. -- See Note [Debugger: Stepout internal break locs] -> do - internal_tick_loc <- makeCaseInternalBreakLoc tick_id - -- same fvs available in the case expression are available in the case continuation - let idOffSets = getVarOffSets platform d p fvs + -- same fvs available in the surrounding tick are available in the case continuation + + -- The variable offsets into the yielded AP_STACK are adjusted + -- differently because a case continuation AP_STACK has the + -- additional stg_ret and stg_ctoi frame headers + -- (as per Note [Stack layout when entering run_BCO]): + let firstVarOff = ret_info_header_w+bndr_size+ctoi_frame_header_w + idOffSets = map (fmap (second (+firstVarOff))) $ + getVarOffSets platform d p fvs ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs) toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word) toWord = fmap (\(i, wo) -> (i, fromIntegral wo)) - breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Left internal_tick_loc) + breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty + (Left (InternalBreakLoc tick_id)) mibi <- newBreakInfo breakInfo return $ case mibi of @@ -1361,8 +1372,8 @@ doCase d s p scrut bndr alts alt_bco_name = getName bndr alt_bco = mkProtoBCO platform add_bco_name alt_bco_name alt_final (Left alts) 0{-no arity-} bitmap_size bitmap True{-is alts-} - scrut_code <- schemeE (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b) - (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b) + scrut_code <- schemeE (d + wordsToBytes platform ctoi_frame_header_w + save_ccs_size_b) + (d + wordsToBytes platform ctoi_frame_header_w + save_ccs_size_b) p scrut if ubx_tuple_frame then do let tuple_bco = tupleBCO platform call_info args_offsets @@ -1374,25 +1385,6 @@ doCase d s p scrut bndr alts _ -> panic "schemeE(StgCase).push_alts" in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code) --- | Come up with an 'InternalBreakLoc' from the location of the given 'BreakpointId'. --- See also Note [Debugger: Stepout internal break locs] -makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc -makeCaseInternalBreakLoc bid = do - hug <- hsc_HUG <$> getHscEnv - curr_mod <- getCurrentModule - mb_mod_brks <- getCurrentModBreaks - - InternalBreakLoc <$> case bid of - BreakpointId{bi_tick_mod, bi_tick_index} - | bi_tick_mod == curr_mod - , Just these_mbs <- mb_mod_brks - -> do - return $ modBreaks_locs these_mbs ! bi_tick_index - | otherwise - -> do - other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod - return $ modBreaks_locs other_mbs ! bi_tick_index - {- Note [Debugger: Stepout internal break locs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1438,6 +1430,8 @@ always have a relevant breakpoint location: - So the source location will point to the thing you've just stepped out of + - The variables available are the same as the ones bound just before entering + - Doing :step-local from there will put you on the selected alternative (which at the source level may also be the e.g. next line in a do-block) @@ -2758,9 +2752,6 @@ newBreakInfo info = BcM $ \env st -> do getCurrentModule :: BcM Module getCurrentModule = BcM $ \env st -> return (bcm_module env, st) -getCurrentModBreaks :: BcM (Maybe ModBreaks) -getCurrentModBreaks = BcM $ \env st -> return (modBreaks env, st) - withBreakTick :: StgTickish -> BcM a -> BcM a withBreakTick bp (BcM act) = BcM $ \env st -> act env{last_bp_tick=Just bp} st ===================================== ghc/GHCi/UI.hs ===================================== @@ -1621,7 +1621,7 @@ toBreakIdAndLocation (Just inf) = do brks <- liftIO $ readIModBreaks hug inf let bi = getBreakSourceId inf brks return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st), - Right (breakId loc) == bi ] + breakId loc == bi ] printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m () printStoppedAtBreakInfo res names = do ===================================== testsuite/tests/ghci.debugger/scripts/T26042b.script ===================================== @@ -7,12 +7,15 @@ main -- stepout of foo True to caller (ie bar) :stepout :list +:show bindings -- stepout of bar (to branch of foo False, where bar was called) :stepout :list +:show bindings -- stepout to right after the call to foo False in main :stepout :list +:show bindings -- done :continue ===================================== testsuite/tests/ghci.debugger/scripts/T26042b.stdout ===================================== @@ -8,7 +8,7 @@ _result :: 10 foo True i = return i ^^^^^^^^ 11 foo False _ = do -Stopped in Main., T26042b.hs:20:3-17 +Stopped in Main.bar, T26042b.hs:20:3-17 _result :: GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, @@ -17,7 +17,11 @@ _result :: 20 y <- foo True t ^^^^^^^^^^^^^^^ 21 return y -Stopped in Main., T26042b.hs:14:3-18 +_result :: + GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld + -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, + Int #) = _ +Stopped in Main.foo, T26042b.hs:14:3-18 _result :: GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, @@ -26,7 +30,11 @@ _result :: 14 n <- bar (x + y) ^^^^^^^^^^^^^^^^ 15 return n -Stopped in Main., T26042b.hs:5:3-26 +_result :: + GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld + -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, + Int #) = _ +Stopped in Main.main, T26042b.hs:5:3-26 _result :: GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, @@ -35,5 +43,9 @@ _result :: 5 a <- foo False undefined ^^^^^^^^^^^^^^^^^^^^^^^^ 6 print a +_result :: + GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld + -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, + () #) = _ 14 14 ===================================== testsuite/tests/ghci.debugger/scripts/T26042c.stdout ===================================== @@ -8,7 +8,7 @@ _result :: 10 foo True i = return i ^^^^^^^^ 11 foo False _ = do -Stopped in Main., T26042c.hs:5:3-26 +Stopped in Main.main, T26042c.hs:5:3-26 _result :: GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, ===================================== testsuite/tests/ghci.debugger/scripts/T26042d2.stdout ===================================== @@ -11,7 +11,7 @@ _result :: 12 putStrLn "hello2.2" hello2.1 hello2.2 -Stopped in Main., T26042d2.hs:6:3 +Stopped in Main.main, T26042d2.hs:6:3 _result :: GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, ===================================== testsuite/tests/ghci.debugger/scripts/T26042e.stdout ===================================== @@ -7,7 +7,7 @@ y :: [a1] -> Int = _ 11 let !z = y x ^^^^^^^^^^^^ 12 let !t = y ['b'] -Stopped in T7., T26042e.hs:18:3-17 +Stopped in T7.main, T26042e.hs:18:3-17 _result :: IO () = _ 17 main = do 18 let !(x, y) = a ===================================== testsuite/tests/ghci.debugger/scripts/T26042f.script ===================================== @@ -4,10 +4,12 @@ top :list -- out of t :stepout +:show bindings :list -- out of g :stepout :list +:show bindings -- out of f :stepout ===================================== testsuite/tests/ghci.debugger/scripts/T26042f2.stdout ===================================== @@ -8,16 +8,22 @@ x :: Int = 450 21 pure (x + 3) ^^ 22 {-# OPAQUE t #-} -Stopped in T8., T26042f.hs:14:3-14 +Stopped in T8.g, T26042f.hs:14:3-14 +_result :: Identity Int = _ +x :: Int = 225 +x :: Int = 225 _result :: Identity Int = _ 13 g x = do 14 a <- t (x*2) ^^^^^^^^^^^^ 15 n <- pure (a+a) -Stopped in T8., T26042f.hs:8:3-14 +Stopped in T8.f, T26042f.hs:8:3-14 _result :: Identity Int = _ +x :: Int = 15 7 f x = do 8 b <- g (x*x) ^^^^^^^^^^^^ 9 y <- pure (b+b) +x :: Int = 15 +_result :: Identity Int = _ 7248 ===================================== testsuite/tests/ghci.debugger/scripts/T26042g.stdout ===================================== @@ -6,7 +6,7 @@ x :: Int = 14 11 succ x = (-) (x - 2) (x + 1) ^^^^^^^^^^^^^^^^^^^ 12 -Stopped in T9., T26042g.hs:(6,3)-(8,21) +Stopped in T9.top, T26042g.hs:(6,3)-(8,21) _result :: Int = _ 5 top = do vv View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5c6d98e1c3d1fe2bc5370d81015cd97... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5c6d98e1c3d1fe2bc5370d81015cd97... You're receiving this email because of your account on gitlab.haskell.org.