[Git][ghc/ghc][wip/romes/step-out-10] 4 commits: LAST PART WIP

Rodrigo Mesquita pushed to branch wip/romes/step-out-10 at Glasgow Haskell Compiler / GHC Commits: 058ddc61 by Rodrigo Mesquita at 2025-07-02T14:56:10+01:00 LAST PART WIP - - - - - 8837b6ba by Rodrigo Mesquita at 2025-07-02T15:00:16+01:00 A thing that I don't like - - - - - 9a35db92 by Rodrigo Mesquita at 2025-07-02T15:00:21+01:00 Revert "A thing that I don't like" This reverts commit 8837b6ba2bac987debeca39304e461417a28abb4. - - - - - 71819682 by Rodrigo Mesquita at 2025-07-02T16:48:57+01:00 Good - - - - - 13 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Breakpoints.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs - libraries/ghci/GHCi/Debugger.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - rts/Disassembler.c - rts/Exception.cmm - rts/Interpreter.c Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -841,24 +841,19 @@ assembleI platform i = case i of W8 -> emit_ bci_OP_INDEX_ADDR_08 [] _ -> unsupported_width - BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox) -> do + BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do + p1 <- ptr $ BCOPtrBreakArray info_mod let -- cast that checks that round-tripping through Word16 doesn't change the value toW16 x = let r = fromIntegral x :: Word16 in if fromIntegral r == x then r else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x) - p1 <- ptr $ BCOPtrBreakArray tick_mod tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod - tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod - info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod - np <- lit1 $ BCONPtrCostCentre (BreakpointId tick_mod tickx) - emit_ bci_BRK_FUN [ Op p1 - , Op tick_addr, Op info_addr - , Op tick_unitid_addr, Op info_unitid_addr - , SmallOp (toW16 tickx), SmallOp (toW16 infox) - , Op np - ] + info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod + np <- lit1 $ BCONPtrCostCentre ibi + emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr + , SmallOp infox, Op np ] BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)] ===================================== compiler/GHC/ByteCode/Breakpoints.hs ===================================== @@ -7,20 +7,19 @@ -- 'InternalModBreaks', and is uniquely identified at runtime by an -- 'InternalBreakpointId'. -- --- See Note [Breakpoint identifiers] +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers] module GHC.ByteCode.Breakpoints ( -- * Internal Mod Breaks InternalModBreaks(..), CgBreakInfo(..) - , mkInternalModBreaks + , mkInternalModBreaks, imodBreaks_module -- ** Internal breakpoint identifier , InternalBreakpointId(..), BreakInfoIndex -- * Operations - , toBreakpointId -- ** Internal-level operations - , getInternalBreak, addInternalBreak + , getInternalBreak -- ** Source-level information operations , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS @@ -47,6 +46,31 @@ import GHC.Utils.Panic import Data.Array {- +Note [ModBreaks vs InternalModBreaks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +'ModBreaks' and 'BreakpointId's must not to be confused with +'InternalModBreaks' and 'InternalBreakId's. + +'ModBreaks' is constructed once during HsToCore from the information attached +to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks' +can be queried using 'BreakpointId's, which uniquely identifies a breakpoint +within the list of breakpoint information for a given module's 'ModBreaks'. + +'InternalModBreaks' are constructed during bytecode generation and are indexed +by a 'InternalBreakpointId'. They contain all the information relevant to a +breakpoint for code generation that can be accessed during runtime execution +(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's +are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN' +instruction receives 'InternalBreakpointId' as an argument. + +We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used +to get source-level information about a breakpoint via the corresponding 'ModBreaks'. + +Notably, 'InternalModBreaks' can contain entries for so-called internal +breakpoints, which do not necessarily have a source-level location attached to +it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to +introduce breakpoints during code generation for features such as stepping-out. + Note [Breakpoint identifiers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Before optimization a breakpoint is identified uniquely with a tick module @@ -64,6 +88,10 @@ So every breakpoint occurrence gets assigned a module-unique *info index* and we store it alongside the occurrence module (*info module*) in the 'InternalBreakpointId' datatype. This is the index that we use at runtime to identify a breakpoint. + +When the internal breakpoint has a matching tick-level breakpoint we can fetch +the related tick-level information by first looking up a mapping +@'InternalBreakpointId' -> 'BreakpointId'@ in @'CgBreakInfo'@. -} -------------------------------------------------------------------------------- @@ -78,19 +106,11 @@ type BreakInfoIndex = Int -- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation. -- See Note [Breakpoint identifiers] data InternalBreakpointId = InternalBreakpointId - { ibi_tick_mod :: !Module -- ^ Breakpoint tick module - , ibi_tick_index :: !Int -- ^ Breakpoint tick index - , ibi_info_mod :: !Module -- ^ Breakpoint tick module + { ibi_info_mod :: !Module -- ^ Breakpoint tick module , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index } deriving (Eq, Ord) -toBreakpointId :: InternalBreakpointId -> BreakpointId -toBreakpointId ibi = BreakpointId - { bi_tick_mod = ibi_tick_mod ibi - , bi_tick_index = ibi_tick_index ibi - } - -------------------------------------------------------------------------------- -- * Internal Mod Breaks -------------------------------------------------------------------------------- @@ -107,18 +127,34 @@ data InternalModBreaks = InternalModBreaks -- 'InternalBreakpointId'. , imodBreaks_modBreaks :: !ModBreaks - -- ^ Store the original ModBreaks for this module, unchanged. - -- Allows us to query about source-level breakpoint information using - -- an internal breakpoint id. + -- ^ Store the ModBreaks for this module + -- + -- Recall Note [Breakpoint identifiers]: for some module A, an + -- *occurrence* of a breakpoint in A may have been inlined from some + -- breakpoint *defined* in module B. + -- + -- This 'ModBreaks' contains information regarding all the breakpoints + -- defined in the module this 'InternalModBreaks' corresponds to. It + -- /does not/ necessarily have information regarding all the breakpoint + -- occurrences registered in 'imodBreaks_breakInfo'. Some of those + -- occurrences may refer breakpoints inlined from other modules. } --- | Construct an 'InternalModBreaks' +-- | Construct an 'InternalModBreaks'. +-- +-- INVARIANT: The given 'ModBreaks' correspond to the same module as this +-- 'InternalModBreaks' module (the first argument) and its breakpoint infos +-- (the @IntMap CgBreakInfo@ argument) mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks mkInternalModBreaks mod im mbs = assertPpr (mod == modBreaks_module mbs) (text "Constructing InternalModBreaks with the ModBreaks of a different module!") $ InternalModBreaks im mbs +-- | Get the module to which these 'InternalModBreaks' correspond +imodBreaks_module :: InternalModBreaks -> Module +imodBreaks_module = modBreaks_module . imodBreaks_modBreaks + -- | Information about a breakpoint that we know at code-generation time -- In order to be used, this needs to be hydrated relative to the current HscEnv by -- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for @@ -128,20 +164,22 @@ data CgBreakInfo { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint , cgb_vars :: ![Maybe (IfaceIdBndr, Word)] , cgb_resty :: !IfaceType + , cgb_tick_id :: !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 + -- ('BreakpointId'). + -- + -- The modules of breakpoint occurrence and breakpoint definition are not + -- necessarily the same: See Note [Breakpoint identifiers]. } -- See Note [Syncing breakpoint info] in GHC.Runtime.Eval -- | Get an internal breakpoint info by 'InternalBreakpointId' getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo -getInternalBreak (InternalBreakpointId _ _ info_mod info_ix) imbs = - assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ - imodBreaks_breakInfo imbs IM.! info_ix - --- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId' -addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks -addInternalBreak (InternalBreakpointId _ _ info_mod info_ix) info imbs = - assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ - imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)} +getInternalBreak (InternalBreakpointId mod ix) imbs = + assert_modules_match mod (imodBreaks_module imbs) $ + imodBreaks_breakInfo imbs IM.! ix -- | Assert that the module in the 'InternalBreakpointId' and in -- 'InternalModBreaks' match. @@ -156,26 +194,47 @@ assert_modules_match ibi_mod imbs_mod = -------------------------------------------------------------------------------- -- | Get the source span for this breakpoint -getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan +getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan getBreakLoc = getBreakXXX modBreaks_locs -- | Get the vars for this breakpoint -getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName] +getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName] getBreakVars = getBreakXXX modBreaks_vars -- | Get the decls for this breakpoint -getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String] +getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String] getBreakDecls = getBreakXXX modBreaks_decls -- | Get the decls for this breakpoint -getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String) +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 -getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a -getBreakXXX view (InternalBreakpointId tick_mod tick_id _ _) imbs = - assert_modules_match tick_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ do - view (imodBreaks_modBreaks imbs) ! tick_id +-- +-- Recall Note [Breakpoint identifiers]: the internal breakpoint module (the +-- *occurrence* module) doesn't necessarily match the module where the +-- tick breakpoint was defined with the relevant 'ModBreaks'. +-- +-- When the tick module is the same as the internal module, we use the stored +-- 'ModBreaks'. When the tick module is different, we need to look up the +-- 'ModBreaks' in the HUG for that other module. +-- +-- 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 = + 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} + | bi_tick_mod == ibi_mod + -> do + let these_mbs = imodBreaks_modBreaks imbs + return $ view these_mbs ! bi_tick_index + | otherwise + -> do + other_mbs <- lookupModule bi_tick_mod + return $ view other_mbs ! bi_tick_index -------------------------------------------------------------------------------- -- Instances @@ -190,7 +249,8 @@ seqInternalModBreaks InternalModBreaks{..} = seqCgBreakInfo CgBreakInfo{..} = rnf cgb_tyvars `seq` rnf cgb_vars `seq` - rnf cgb_resty + rnf cgb_resty `seq` + rnf cgb_tick_id instance Outputable InternalBreakpointId where ppr InternalBreakpointId{..} = @@ -203,4 +263,5 @@ instance NFData InternalBreakpointId where instance Outputable CgBreakInfo where ppr info = text "CgBreakInfo" <+> parens (ppr (cgb_vars info) <+> - ppr (cgb_resty info)) + ppr (cgb_resty info) <+> + ppr (cgb_tick_id info)) ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -454,9 +454,8 @@ instance Outputable BCInstr where ppr ENTER = text "ENTER" ppr (RETURN pk) = text "RETURN " <+> ppr pk ppr (RETURN_TUPLE) = text "RETURN_TUPLE" - ppr (BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox)) + ppr (BRK_FUN (InternalBreakpointId info_mod infox)) = text "BRK_FUN" <+> text "<breakarray>" - <+> ppr tick_mod <+> ppr tickx <+> ppr info_mod <+> ppr infox <+> text "<cc>" ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -704,12 +704,13 @@ toIfaceLFInfo nm lfi = case lfi of -- Dehydrating CgBreakInfo -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo -dehydrateCgBreakInfo ty_vars idOffSets tick_ty = +dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo +dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid = CgBreakInfo { cgb_tyvars = map toIfaceTvBndr ty_vars , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets , cgb_resty = toIfaceType tick_ty + , cgb_tick_id = bid } {- Note [Inlining and hs-boot files] ===================================== compiler/GHC/HsToCore/Breakpoints.hs ===================================== @@ -12,7 +12,7 @@ -- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed -- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'. -- --- See Note [Breakpoint identifiers] +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers] module GHC.HsToCore.Breakpoints ( -- * ModBreaks mkModBreaks, ModBreaks(..) ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -28,6 +28,7 @@ module GHC.Runtime.Interpreter , whereFrom , getModBreaks , readModBreaks + , readModBreaksMaybe , seqHValue , evalBreakpointToId @@ -411,15 +412,10 @@ evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId evalBreakpointToId eval_break = let mkUnitId u = fsToUnit $ mkFastStringShortByteString u - toModule u n = mkModule (mkUnitId u) (mkModuleName n) - tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break) - infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break) in InternalBreakpointId - { ibi_tick_mod = tickl - , ibi_tick_index = eb_tick_index eval_break - , ibi_info_mod = infol + { ibi_info_mod = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break) , ibi_info_index = eb_info_index eval_break } @@ -440,17 +436,18 @@ handleSeqHValueStatus interp unit_env eval_status = -- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq Just break -> do - let bi = evalBreakpointToId break + let ibi = evalBreakpointToId break + hug = ue_home_unit_graph unit_env -- Just case: Stopped at a breakpoint, extract SrcSpan information -- from the breakpoint. - mb_modbreaks <- getModBreaks . expectJust <$> - lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env) + mb_modbreaks <- readModBreaksMaybe hug (ibi_info_mod ibi) case mb_modbreaks of -- Nothing case - should not occur! We should have the appropriate -- breakpoint information Nothing -> nothing_case - Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks + Just modbreaks -> put . brackets . ppr =<< + getBreakLoc (fmap imodBreaks_modBreaks . readModBreaks hug) ibi modbreaks -- resume the seq (:force) processing in the iserv process withForeignRef resume_ctxt_fhv $ \hval -> do @@ -745,10 +742,13 @@ getModBreaks hmi | otherwise = Nothing -- probably object code --- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module' --- from the 'HomeUnitGraph'. +-- | Read the 'InternalModBreaks' of the given home 'Module' from the 'HomeUnitGraph'. readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks -readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug +readModBreaks hug modl = expectJust <$> readModBreaksMaybe hug modl + +-- | Read the 'InternalModBreaks' of the given home 'Module' from the 'HomeUnitGraph'. +readModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe InternalModBreaks) +readModBreaksMaybe hug modl = getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug -- ----------------------------------------------------------------------------- -- Misc utils ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -31,7 +31,6 @@ import GHC.Cmm.Utils import GHC.Platform import GHC.Platform.Profile -import GHC.Runtime.Interpreter import GHCi.FFI import GHC.Types.Basic import GHC.Utils.Outputable @@ -64,6 +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.Data.Bitmap import GHC.Data.FlatBag as FlatBag import GHC.Data.OrdList @@ -79,7 +79,6 @@ import Control.Monad import Data.Char import GHC.Unit.Module -import qualified GHC.Unit.Home.Graph as HUG import Data.Coerce (coerce) #if MIN_VERSION_rts(1,0,3) @@ -394,65 +393,28 @@ 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 (BreakpointId tick_mod tick_no) fvs) rhs) = do +schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do code <- schemeE d 0 p rhs - hsc_env <- getHscEnv - current_mod <- getCurrentModule 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 -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case - Nothing -> pure code - Just ModBreaks{modBreaks_module = tick_mod} -> 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 + 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 + let info_mod = modBreaks_module current_mod_breaks + infox <- newBreakInfo breakInfo - let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox) - return $ breakInstr `consOL` code + let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox) + return $ breakInstr `consOL` code schemeER_wrk d p rhs = schemeE d 0 p rhs --- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module --- from which the breakpoint originates. --- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs --- to refer to pointers in GHCi's address space. --- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by --- 'GHC.HsToCore.deSugar'. --- --- Breakpoints might be disabled because we're in TH, because --- @-fno-break-points@ was specified, or because a module was reloaded without --- reinitializing 'ModBreaks'. --- --- If the module stored in the breakpoint is the currently processed module, use --- the 'ModBreaks' from the state. --- If that is 'Nothing', consider breakpoints to be disabled and skip the --- instruction. --- --- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph). --- If the module doesn't exist there, or if the 'ModBreaks' value is --- uninitialized, skip the instruction (i.e. return Nothing). -break_info :: - HscEnv -> - Module -> - Module -> - Maybe ModBreaks -> - BcM (Maybe ModBreaks) -break_info hsc_env mod current_mod current_mod_breaks - | mod == current_mod - = pure current_mod_breaks - | otherwise - = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case - Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp - Nothing -> pure Nothing - getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)] getVarOffSets platform depth env = map getOffSet where ===================================== libraries/ghci/GHCi/Debugger.hs ===================================== @@ -65,10 +65,7 @@ foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt -------------------------------------------------------------------------------- type BreakpointCallback - = Addr# -- pointer to the breakpoint tick module name - -> Addr# -- pointer to the breakpoint tick module unit id - -> Int# -- breakpoint tick index - -> Addr# -- pointer to the breakpoint info module name + = Addr# -- pointer to the breakpoint info module name -> Addr# -- pointer to the breakpoint info module unit id -> Int# -- breakpoint info index -> Bool -- exception? ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -418,10 +418,7 @@ data EvalStatus_ a b instance Binary a => Binary (EvalStatus_ a b) data EvalBreakpoint = EvalBreakpoint - { eb_tick_mod :: String -- ^ Breakpoint tick module - , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id - , eb_tick_index :: Int -- ^ Breakpoint tick index - , eb_info_mod :: String -- ^ Breakpoint info module + { eb_info_mod :: String -- ^ Breakpoint info module , eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id , eb_info_index :: Int -- ^ Breakpoint info index } ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -345,7 +345,7 @@ withBreakAction opts breakMVar statusMVar mtid act -- as soon as it is hit, or in resetBreakAction below. onBreak :: BreakpointCallback - onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do + onBreak info_mod# info_mod_uid# infox# is_exception apStack = do tid <- myThreadId let resume = ResumeContext { resumeBreakMVar = breakMVar @@ -358,11 +358,9 @@ withBreakAction opts breakMVar statusMVar mtid act if is_exception then pure Nothing else do - tick_mod <- peekCString (Ptr tick_mod#) - tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#) info_mod <- peekCString (Ptr info_mod#) info_mod_uid <- BS.packCString (Ptr info_mod_uid#) - pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#))) + pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#))) putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs takeMVar breakMVar @@ -409,8 +407,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction noBreakAction :: BreakpointCallback -noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint" -noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue +noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint" +noBreakAction _ _ _ True _ = return () -- exception: just continue -- Malloc and copy the bytes. We don't have any way to monitor the -- lifetime of this memory, so it just leaks. ===================================== rts/Disassembler.c ===================================== @@ -84,16 +84,23 @@ disInstr ( StgBCO *bco, int pc ) switch (instr & 0xff) { - case bci_BRK_FUN: - debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] ); - debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] ); - CostCentre* cc = (CostCentre*)literals[instrs[pc+5]]; + case bci_BRK_FUN: { + W_ p1, info_mod, info_unit_id, info_wix, np; + p1 = BCO_GET_LARGE_ARG; + info_mod = BCO_GET_LARGE_ARG; + info_unit_id = BCO_GET_LARGE_ARG; + info_wix = BCO_NEXT; + np = BCO_GET_LARGE_ARG; + debugBelch ("BRK_FUN " ); printPtr( ptrs[p1] ); + debugBelch("%" FMT_Word, literals[info_mod] ); + debugBelch("%" FMT_Word, literals[info_unit_id] ); + debugBelch("%" FMT_Word, info_wix ); + CostCentre* cc = (CostCentre*)literals[np]; if (cc) { debugBelch(" %s", cc->label); } debugBelch("\n"); - pc += 6; - break; + break; } case bci_BRK_ALTS: debugBelch ("BRK_ALTS %d\n", BCO_NEXT); break; ===================================== rts/Exception.cmm ===================================== @@ -535,23 +535,17 @@ retry_pop_stack: // be per-thread. CInt[rts_stop_on_exception] = 0; ("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr"); - Sp = Sp - WDS(17); - Sp(16) = exception; - Sp(15) = stg_raise_ret_info; - Sp(14) = exception; - Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception - Sp(12) = stg_ap_ppv_info; - Sp(11) = 0; - Sp(10) = stg_ap_n_info; - Sp(9) = 0; - Sp(8) = stg_ap_n_info; - Sp(7) = 0; - Sp(6) = stg_ap_n_info; - Sp(5) = 0; - Sp(4) = stg_ap_n_info; - Sp(3) = 0; - Sp(2) = stg_ap_n_info; - Sp(1) = 0; + Sp = Sp - WDS(11); + Sp(10) = exception; + Sp(9) = stg_raise_ret_info; + Sp(8) = exception; + Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception + Sp(6) = stg_ap_ppv_info; + Sp(5) = 0; + Sp(4) = stg_ap_n_info; + Sp(3) = 0; + Sp(2) = stg_ap_n_info; + Sp(1) = 0; R1 = ioAction; jump RET_LBL(stg_ap_n) [R1]; } ===================================== rts/Interpreter.c ===================================== @@ -1454,9 +1454,9 @@ run_BCO: /* check for a breakpoint on the beginning of a let binding */ case bci_BRK_FUN: { - int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index; + W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index; #if defined(PROFILING) - int arg8_cc; + W_ arg5_cc; #endif StgArrBytes *breakPoints; int returning_from_break, stop_next_breakpoint; @@ -1471,14 +1471,11 @@ run_BCO: int size_words; arg1_brk_array = BCO_GET_LARGE_ARG; - arg2_tick_mod = BCO_GET_LARGE_ARG; - arg3_info_mod = BCO_GET_LARGE_ARG; - arg4_tick_mod_id = BCO_GET_LARGE_ARG; - arg5_info_mod_id = BCO_GET_LARGE_ARG; - arg6_tick_index = BCO_NEXT; - arg7_info_index = BCO_NEXT; + arg2_info_mod_name = BCO_GET_LARGE_ARG; + arg3_info_mod_id = BCO_GET_LARGE_ARG; + arg4_info_index = BCO_NEXT; #if defined(PROFILING) - arg8_cc = BCO_GET_LARGE_ARG; + arg5_cc = BCO_GET_LARGE_ARG; #else BCO_GET_LARGE_ARG; #endif @@ -1498,7 +1495,7 @@ run_BCO: #if defined(PROFILING) cap->r.rCCCS = pushCostCentre(cap->r.rCCCS, - (CostCentre*)BCO_LIT(arg8_cc)); + (CostCentre*)BCO_LIT(arg5_cc)); #endif // if we are returning from a break then skip this section @@ -1509,11 +1506,11 @@ run_BCO: // stop the current thread if either `stop_next_breakpoint` is // true OR if the ignore count for this particular breakpoint is zero - StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index]; + StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index]; if (stop_next_breakpoint == false && ignore_count > 0) { // decrement and write back ignore count - ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count; + ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count; } else if (stop_next_breakpoint == true || ignore_count == 0) { @@ -1547,10 +1544,7 @@ run_BCO: // Arrange the stack to call the breakpoint IO action, and // continue execution of this BCO when the IO action returns. // - // ioAction :: Addr# -- the breakpoint tick module - // -> Addr# -- the breakpoint tick module unit id - // -> Int# -- the breakpoint tick index - // -> Addr# -- the breakpoint info module + // ioAction :: Addr# -- the breakpoint info module // -> Addr# -- the breakpoint info module unit id // -> Int# -- the breakpoint info index // -> Bool -- exception? @@ -1560,23 +1554,17 @@ run_BCO: ioAction = (StgClosure *) deRefStablePtr ( rts_breakpoint_io_action); - Sp_subW(19); - SpW(18) = (W_)obj; - SpW(17) = (W_)&stg_apply_interp_info; - SpW(16) = (W_)new_aps; - SpW(15) = (W_)False_closure; // True <=> an exception - SpW(14) = (W_)&stg_ap_ppv_info; - SpW(13) = (W_)arg7_info_index; - SpW(12) = (W_)&stg_ap_n_info; - SpW(11) = (W_)BCO_LIT(arg5_info_mod_id); - SpW(10) = (W_)&stg_ap_n_info; - SpW(9) = (W_)BCO_LIT(arg3_info_mod); - SpW(8) = (W_)&stg_ap_n_info; - SpW(7) = (W_)arg6_tick_index; + Sp_subW(13); + SpW(12) = (W_)obj; + SpW(11) = (W_)&stg_apply_interp_info; + SpW(10) = (W_)new_aps; + SpW(9) = (W_)False_closure; // True <=> an exception + SpW(8) = (W_)&stg_ap_ppv_info; + SpW(7) = (W_)arg4_info_index; SpW(6) = (W_)&stg_ap_n_info; - SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id); + SpW(5) = (W_)BCO_LIT(arg3_info_mod_id); SpW(4) = (W_)&stg_ap_n_info; - SpW(3) = (W_)BCO_LIT(arg2_tick_mod); + SpW(3) = (W_)BCO_LIT(arg2_info_mod_name); SpW(2) = (W_)&stg_ap_n_info; SpW(1) = (W_)ioAction; SpW(0) = (W_)&stg_enter_info; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58798b6431b91e1dee5a03dc3b63b67... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58798b6431b91e1dee5a03dc3b63b67... You're receiving this email because of your account on gitlab.haskell.org.