Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC
Commits:
1362987b by Rodrigo Mesquita at 2025-07-23T18:39:34+01:00
Makes sure run_BCO has variables directly on top of the stack
Instead we kept ctoi_ret frames when entering run_BCO, and the ByteCode
generator accounted for the frame header and then slided it off.
Now, when run_BCO is called for a case continuation, the return value
and free variables are directly on top.
Making stg_ret_*_ stay at the start of the BCO
Actually, do add the ctoi frame header but remove it with static slides always in case conts
- - - - -
3ada6aa5 by Rodrigo Mesquita at 2025-07-23T18:40:19+01:00
Allow BRK_FUNs to head case continuation BCOs
- - - - -
cd1393d0 by Rodrigo Mesquita at 2025-07-23T18:40:20+01:00
Add InternalBreakLocs for code-generation time Brk locations
TODO: Test step-out from a continuation which receives an unboxed tuple as an argument
- - - - -
13 changed files:
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Run.hs
- rts/Interpreter.c
- + testsuite/tests/ghci.debugger/scripts/T26042d2.hs
- + testsuite/tests/ghci.debugger/scripts/T26042d2.script
- + testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
Changes:
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DerivingStrategies #-}
-- | Breakpoint information constructed during ByteCode generation.
--
@@ -15,6 +16,7 @@ module GHC.ByteCode.Breakpoints
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
+ , InternalBreakLoc(..)
-- * Operations
@@ -23,7 +25,7 @@ module GHC.ByteCode.Breakpoints
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
- , getBreakSourceId
+ , getBreakSourceId, getBreakSourceMod
-- * Utils
, seqInternalModBreaks
@@ -165,7 +167,7 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
- , cgb_tick_id :: !BreakpointId
+ , cgb_tick_id :: !(Either InternalBreakLoc BreakpointId)
-- ^ This field records the original breakpoint tick identifier for this
-- internal breakpoint info. It is used to convert a breakpoint
-- *occurrence* index ('InternalBreakpointId') into a *definition* index
@@ -173,9 +175,19 @@ data CgBreakInfo
--
-- The modules of breakpoint occurrence and breakpoint definition are not
-- 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. See Note [Internal Breakpoint Locations]
}
-- 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.
+-- See Note [Internal Breakpoint Locations]
+newtype InternalBreakLoc = InternalBreakLoc SrcSpan
+ deriving newtype (Eq, Show, NFData, Outputable)
+
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak (InternalBreakpointId mod ix) imbs =
@@ -196,27 +208,36 @@ 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 -> BreakpointId
+getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> Either InternalBreakLoc 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
+-- | 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
+
-- | Get the source span for this breakpoint
getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
-getBreakLoc = getBreakXXX modBreaks_locs
+getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
-- | Get the vars for this breakpoint
getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
-getBreakVars = getBreakXXX modBreaks_vars
+getBreakVars = getBreakXXX modBreaks_vars (const [])
-- | Get the decls for this breakpoint
getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
-getBreakDecls = getBreakXXX modBreaks_decls
+getBreakDecls = getBreakXXX modBreaks_decls (const [])
-- | Get the decls for this breakpoint
-getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
-getBreakCCS = getBreakXXX modBreaks_ccs
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
+getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
--
@@ -228,14 +249,17 @@ getBreakCCS = getBreakXXX modBreaks_ccs
-- 'ModBreaks'. When the tick module is different, we need to look up the
-- 'ModBreaks' in the HUG for that other module.
--
+-- When there is no tick module (the breakpoint was generated at codegen), use
+-- the function on internal mod breaks.
+--
-- To avoid cyclic dependencies, we instead receive a function that looks up
-- the 'ModBreaks' given a 'Module'
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
-getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view viewInternal 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
- BreakpointId{bi_tick_mod, bi_tick_index}
+ Right BreakpointId{bi_tick_mod, bi_tick_index}
| bi_tick_mod == ibi_mod
-> do
let these_mbs = imodBreaks_modBreaks imbs
@@ -244,6 +268,8 @@ getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
-> 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
=====================================
@@ -58,6 +58,7 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message (ConInfoTable(..), LoadedDLL)
+import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
import GHC.ByteCode.Asm
import GHC.ByteCode.Types
@@ -1711,8 +1712,10 @@ allocateCCS interp ce mbss
let count = 1 + (maybe 0 fst $ IM.lookupMax imodBreaks_breakInfo)
let ccs = IM.map
(\info ->
- fromMaybe (toRemotePtr nullPtr)
- (M.lookup (cgb_tick_id info) ccss)
+ case cgb_tick_id info of
+ Right bi -> fromMaybe (toRemotePtr nullPtr)
+ (M.lookup bi ccss)
+ Left InternalBreakLoc{} -> toRemotePtr nullPtr
)
imodBreaks_breakInfo
assertPpr (count == length ccs)
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -253,8 +253,11 @@ mkBreakpointOccurrences = do
let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
IntMap.foldrWithKey (\info_ix cgi bmp -> do
let ibi = InternalBreakpointId imod info_ix
- let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
- extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ case cgb_tick_id cgi of
+ Right (BreakpointId tick_mod tick_ix)
+ -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ Left _
+ -> bmp
) bmp0 (imodBreaks_breakInfo ibrks)
--------------------------------------------------------------------------------
@@ -287,7 +290,7 @@ getCurrentBreakModule = do
Nothing -> pure Nothing
Just ibi -> do
brks <- readIModBreaks hug ibi
- return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ Just $ getBreakSourceMod ibi brks
ix ->
Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -151,7 +151,7 @@ getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
getHistoryModule hug hist = do
let ibi = historyBreakpointId hist
brks <- readIModBreaks hug ibi
- return $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ getBreakSourceMod ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
=====================================
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 )
+import GHC.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -99,6 +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 ((!))
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -393,26 +394,30 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
- code <- schemeE d 0 p rhs
- mb_current_mod_breaks <- getCurrentModBreaks
- case mb_current_mod_breaks of
- -- if we're not generating ModBreaks for this module for some reason, we
- -- can't store breakpoint occurrence information.
- Nothing -> pure code
- Just current_mod_breaks -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = 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 tick_id
-
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
+ platform <- profilePlatform <$> getProfile
+
+ code <- case rhs of
+ -- When we find a tick surrounding a case expression we introduce a new BRK_FUN
+ -- instruction at the start of the case *continuation*, in addition to the
+ -- usual BRK_FUN surrounding the StgCase)
+ -- See Note [TODO]
+ StgCase scrut bndr _ alts
+ -> doCase d 0 p (Just bp) scrut bndr alts
+ _ -> schemeE d 0 p rhs
+
+ let idOffSets = 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)
+
+ mibi <- newBreakInfo breakInfo
+
+ return $ case mibi of
+ Nothing -> code
+ Just ibi -> BRK_FUN ibi `consOL` code
- let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
- return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
@@ -614,7 +619,7 @@ schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut
schemeE d s p (StgCase scrut bndr _ alts)
- = doCase d s p scrut bndr alts
+ = doCase d s p Nothing scrut bndr alts
{-
@@ -1106,11 +1111,15 @@ doCase
:: StackDepth
-> Sequel
-> BCEnv
+ -> Maybe StgTickish
+ -- ^ The breakpoint surrounding the full case expression, if any (only
+ -- source-level cases get breakpoint ticks, and those are the only we care
+ -- about). See Note [TODO]
-> CgStgExpr
-> Id
-> [CgStgAlt]
-> BcM BCInstrList
-doCase d s p scrut bndr alts
+doCase d s p m_bid scrut bndr alts
= do
profile <- getProfile
hsc_env <- getHscEnv
@@ -1140,43 +1149,34 @@ 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_b :: StackDepth
- ret_frame_size_b | ubx_tuple_frame =
- (if profiling then 5 else 4) * wordSize platform
- | otherwise = 2 * wordSize platform
+ ret_frame_size_w :: WordOff
+ ret_frame_size_w | ubx_tuple_frame =
+ if profiling then 5 else 4
+ | otherwise = 2
-- The stack space used to save/restore the CCCS when profiling
save_ccs_size_b | profiling &&
not ubx_tuple_frame = 2 * wordSize platform
| otherwise = 0
- -- The size of the return frame info table pointer if one exists
- unlifted_itbl_size_b :: StackDepth
- unlifted_itbl_size_b | ubx_tuple_frame = wordSize platform
- | otherwise = 0
-
(bndr_size, call_info, args_offsets)
| ubx_tuple_frame =
let bndr_reps = typePrimRep (idType bndr)
(call_info, args_offsets) =
layoutNativeCall profile NativeTupleReturn 0 id bndr_reps
- in ( wordsToBytes platform (nativeCallSize call_info)
+ in ( nativeCallSize call_info
, call_info
, args_offsets
)
- | otherwise = ( wordsToBytes platform (idSizeW platform bndr)
+ | otherwise = ( idSizeW platform bndr
, voidTupleReturnInfo
, []
)
- -- depth of stack after the return value has been pushed
+ -- Depth of stack after the return value has been pushed
+ -- This is the stack depth at the continuation.
d_bndr =
- d + ret_frame_size_b + bndr_size
-
- -- depth of stack after the extra info table for an unlifted return
- -- has been pushed, if any. This is the stack depth at the
- -- continuation.
- d_alts = d + ret_frame_size_b + bndr_size + unlifted_itbl_size_b
+ d + wordsToBytes platform bndr_size
-- Env in which to compile the alts, not including
-- any vars bound by the alts themselves
@@ -1188,13 +1188,13 @@ doCase d s p scrut bndr alts
-- given an alt, return a discr and code for it.
codeAlt :: CgStgAlt -> BcM (Discr, BCInstrList)
codeAlt GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=rhs}
- = do rhs_code <- schemeE d_alts s p_alts rhs
+ = do rhs_code <- schemeE d_bndr s p_alts rhs
return (NoDiscr, rhs_code)
codeAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs}
-- primitive or nullary constructor alt: no need to UNPACK
| null real_bndrs = do
- rhs_code <- schemeE d_alts s p_alts rhs
+ rhs_code <- schemeE d_bndr s p_alts rhs
return (my_discr alt, rhs_code)
| isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
let bndr_ty = idPrimRepU . fromNonVoid
@@ -1206,7 +1206,7 @@ doCase d s p scrut bndr alts
bndr_ty
(assertNonVoidIds bndrs)
- stack_bot = d_alts
+ stack_bot = d_bndr
p' = Map.insertList
[ (arg, tuple_start -
@@ -1224,7 +1224,7 @@ doCase d s p scrut bndr alts
(addIdReps (assertNonVoidIds real_bndrs))
size = WordOff tot_wds
- stack_bot = d_alts + wordsToBytes platform size
+ stack_bot = d_bndr + wordsToBytes platform size
-- convert offsets from Sp into offsets into the virtual stack
p' = Map.insertList
@@ -1324,22 +1324,53 @@ doCase d s p scrut bndr alts
alt_stuff <- mapM codeAlt alts
alt_final0 <- mkMultiBranch maybe_ncons alt_stuff
- let alt_final1
- | ubx_tuple_frame = SLIDE 0 2 `consOL` alt_final0
- | otherwise = alt_final0
- alt_final
- | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
- -- See Note [Debugger: BRK_ALTS]
- = BRK_ALTS False `consOL` alt_final1
- | otherwise = alt_final1
+ let
+
+ -- drop the stg_ctoi_*_info header...
+ alt_final1 = SLIDE bndr_size ret_frame_size_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
+
+ -- when `BRK_FUN` in a case continuation BCO executes,
+ -- the stack will already have a full continuation that just
+ -- re-executes the BCO being stopped at (including the stg_ret and
+ -- stg_ctoi frames)
+ --
+ -- right after the `BRK_FUN`, all case continuations will drop the
+ -- stg_ret and stg_ctoi headers (see alt_final1, alt_final2), leaving
+ -- the stack with the bound return values followed by the free variables
+ alt_final <- case m_bid of
+ Just (Breakpoint tick_ty tick_id fvs)
+ | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
+ -- Construct an internal breakpoint to put at the start of this case
+ -- continuation BCO.
+ -- See Note [TODO]
+ -> 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
+ 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)
+
+ mibi <- newBreakInfo breakInfo
+ return $ case mibi of
+ Nothing -> alt_final2
+ Just ibi -> BRK_FUN ibi `consOL` alt_final2
+ _ -> pure alt_final2
add_bco_name <- shouldAddBcoName
let
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 + ret_frame_size_b + save_ccs_size_b)
- (d + ret_frame_size_b + save_ccs_size_b)
+ 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)
p scrut
if ubx_tuple_frame
then do let tuple_bco = tupleBCO platform call_info args_offsets
@@ -1351,6 +1382,24 @@ doCase d s p scrut bndr alts
_ -> panic "schemeE(StgCase).push_alts"
in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
+makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
+makeCaseInternalBreakLoc bid = do
+ hug <- hsc_HUG <$> getHscEnv
+ curr_mod <- getCurrentModule
+ mb_mod_brks <- getCurrentModBreaks
+
+ -- TODO: Subtract the scrutinee loc from the case loc to get continuation loc
+ 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: BRK_ALTS]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1718,6 +1767,10 @@ tupleBCO platform args_info args =
with using a fake name here. We will need to change this if we want
to save some memory by sharing the BCO between places that have
the same tuple shape
+
+ ROMES:TODO: This seems like it would have a pretty good impact.
+ Looking at examples like UnboxedTuple.hs shows many occurrences of the
+ same tuple_BCO
-}
invented_name = mkSystemVarName (mkPseudoUniqueE 0) (fsLit "tuple")
@@ -2667,14 +2720,19 @@ getLabelsBc n = BcM $ \_ st ->
let ctr = nextlabel st
in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
-newBreakInfo :: CgBreakInfo -> BcM Int
-newBreakInfo info = BcM $ \_ st ->
- let ix = breakInfoIdx st
- st' = st
- { breakInfo = IntMap.insert ix info (breakInfo st)
- , breakInfoIdx = ix + 1
- }
- in return (ix, st')
+newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
+newBreakInfo info = BcM $ \env st -> do
+ -- if we're not generating ModBreaks for this module for some reason, we
+ -- can't store breakpoint occurrence information.
+ case modBreaks env of
+ Nothing -> pure (Nothing, st)
+ Just modBreaks -> do
+ let ix = breakInfoIdx st
+ st' = st
+ { breakInfo = IntMap.insert ix info (breakInfo st)
+ , breakInfoIdx = ix + 1
+ }
+ return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
getCurrentModule :: BcM Module
getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
@@ -2687,7 +2745,7 @@ tickFS = fsLit "ticked"
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
import GHC.Runtime.Eval.Utils
-- The GHC interface
-import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId, getBreakSourceMod)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -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),
- breakId loc == bi ]
+ Right (breakId loc) == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
@@ -3825,7 +3825,7 @@ pprStopped res = do
hug <- hsc_HUG <$> GHC.getSession
brks <- liftIO $ readIModBreaks hug ibi
return $ Just $ moduleName $
- bi_tick_mod $ getBreakSourceId ibi brks
+ getBreakSourceMod ibi brks
return $
text "Stopped in"
<+> ((case mb_mod_name of
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -362,6 +362,14 @@ withBreakAction opts breakMVar statusMVar mtid act
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
+
+ -- Block until this thread is resumed (by the thread which took the
+ -- `ResumeContext` from the `statusMVar`).
+ --
+ -- The `onBreak` function must have been called from `rts/Interpreter.c`
+ -- when interpreting a `BRK_FUN`. After taking from the MVar, the function
+ -- returns to the continuation on the stack which is where the interpreter
+ -- was stopped.
takeMVar breakMVar
resetBreakAction stablePtr = do
=====================================
rts/Interpreter.c
=====================================
@@ -207,6 +207,19 @@ See also Note [Width of parameters] for some more motivation.
// Perhaps confusingly this still reads a full word, merely the offset is in bytes.
#define ReadSpB(n) (*((StgWord*) SafeSpBP(n)))
+/*
+ * SLIDE "n" words "by" words
+ * a_1 ... a_n, b_1 ... b_by, k
+ * =>
+ * a_1 ... a_n, k
+ */
+#define SpSlide(n, by) \
+ while(n-- > 0) { \
+ SpW(n+by) = ReadSpW(n); \
+ } \
+ Sp_addW(by); \
+
+
/* Note [PUSH_L underflow]
~~~~~~~~~~~~~~~~~~~~~~~
BCOs can be nested, resulting in nested BCO stack frames where the inner most
@@ -284,6 +297,18 @@ allocate_NONUPD (Capability *cap, int n_words)
return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
+STATIC_INLINE int
+is_ctoi_nontuple_frame(const StgPtr frame_head) {
+ return (
+ (W_)frame_head == (W_)&stg_ctoi_R1p_info ||
+ (W_)frame_head == (W_)&stg_ctoi_R1n_info ||
+ (W_)frame_head == (W_)&stg_ctoi_F1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_D1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_L1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_V_info
+ );
+}
+
int rts_stop_on_exception = 0;
/* ---------------------------------------------------------------------------
@@ -844,7 +869,6 @@ eval_obj:
debugBelch("\n\n");
);
-// IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
IF_DEBUG(sanity,checkStackFrame(Sp));
switch ( get_itbl(obj)->type ) {
@@ -1086,11 +1110,31 @@ do_return_pointer:
// Returning to an interpreted continuation: put the object on
// the stack, and start executing the BCO.
INTERP_TICK(it_retto_BCO);
- Sp_subW(1);
- SpW(0) = (W_)tagged_obj;
- obj = (StgClosure*)ReadSpW(2);
+ obj = (StgClosure*)ReadSpW(1);
ASSERT(get_itbl(obj)->type == BCO);
- goto run_BCO_return_pointer;
+
+ // Heap check
+ if (doYouWantToGC(cap)) {
+ Sp_subW(2);
+ SpW(1) = (W_)tagged_obj;
+ SpW(0) = (W_)&stg_ret_p_info;
+ RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
+ }
+ else {
+
+ // Stack checks aren't necessary at return points, the stack use
+ // is aggregated into the enclosing function entry point.
+
+ // Make sure stack is headed by a ctoi R1p frame when returning a pointer
+ ASSERT(ReadSpW(0) == (W_)&stg_ctoi_R1p_info);
+
+ // Add the return frame on top of the args
+ Sp_subW(2);
+ SpW(1) = (W_)tagged_obj;
+ SpW(0) = (W_)&stg_ret_p_info;
+ }
+
+ goto run_BCO;
default:
do_return_unrecognised:
@@ -1159,8 +1203,9 @@ do_return_nonpointer:
// get the offset of the header of the next stack frame
offset = stack_frame_sizeW((StgClosure *)Sp);
+ StgClosure* next_frame = (StgClosure*)(SafeSpWP(offset));
- switch (get_itbl((StgClosure*)(SafeSpWP(offset)))->type) {
+ switch (get_itbl(next_frame)->type) {
case RET_BCO:
// Returning to an interpreted continuation: pop the return frame
@@ -1168,8 +1213,59 @@ do_return_nonpointer:
// executing the BCO.
INTERP_TICK(it_retto_BCO);
obj = (StgClosure*)ReadSpW(offset+1);
+
ASSERT(get_itbl(obj)->type == BCO);
- goto run_BCO_return_nonpointer;
+
+ // Heap check
+ if (doYouWantToGC(cap)) {
+ RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
+ }
+ else {
+ // Stack checks aren't necessary at return points, the stack use
+ // is aggregated into the enclosing function entry point.
+
+#if defined(PROFILING)
+ /*
+ Restore the current cost centre stack if a tuple is being returned.
+
+ When a "simple" unlifted value is returned, the cccs is restored with
+ an stg_restore_cccs frame on the stack, for example:
+
+ ...
+ stg_ctoi_D1
+ <CCCS>
+ stg_restore_cccs
+
+ But stg_restore_cccs cannot deal with tuples, which may have more
+ things on the stack. Therefore we store the CCCS inside the
+ stg_ctoi_t frame.
+
+ If we have a tuple being returned, the stack looks like this:
+
+ ...
+ <CCCS> <- to restore, Sp offset