[Git][ghc/ghc][wip/romes/step-out-10] 3 commits: cleanup: Use BreakpointIds in bytecode gen

Rodrigo Mesquita pushed to branch wip/romes/step-out-10 at Glasgow Haskell Compiler / GHC Commits: 5fcbe16a by Rodrigo Mesquita at 2025-07-01T17:22:38+01:00 cleanup: Use BreakpointIds in bytecode gen Small clean up to use BreakpointId and InternalBreakpointId more uniformly in bytecode generation rather than using Module + Ix pairs - - - - - 3d02f5a3 by Rodrigo Mesquita at 2025-07-01T18:10:09+01:00 ghci: Allocate BreakArrays at link time only Previously, a BreakArray would be allocated with a slot for every tick in a module at `mkModBreaks`, in HsToCore. However, this approach has a few downsides: - It interleaves interpreter behaviour (allocating arrays for breakpoints) within the desugarer - It is inflexible in the sense it is impossible for the bytecode generator to add "internal" breakpoints that can be triggered at runtime, because those wouldn't have a source tick. (This is relevant for our intended implementation plan of step-out in #26042) - It ties the BreakArray indices to the *tick* indexes, while at runtime we would rather just have the *info* indexes (currently we have both because BreakArrays are indexed by the *tick* one). Paving the way for #26042 and #26064, this commit moves the allocation of BreakArrays to bytecode-loading time -- akin to what is done for CCS arrays. Since a BreakArray is allocated only when bytecode is linked, if a breakpoint is set (e.g. `:break 10`) before the bytecode is linked, there will exist no BreakArray to trigger the breakpoint in. Therefore, the function to allocate break arrays (`allocateBreakArrays`) is exposed and also used in GHC.Runtime.Eval to allocate a break array when a breakpoint is set, if it doesn't exist yet (in the linker env). - - - - - 5f9d327d by Rodrigo Mesquita at 2025-07-01T18:29:14+01:00 THE LAST PART - - - - - 23 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Breakpoints.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Debugger/Breakpoints.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - − compiler/GHC/Runtime/Interpreter.hs-boot - − compiler/GHC/Runtime/Interpreter/Types.hs-boot - compiler/GHC/StgToByteCode.hs - ghc/GHCi/UI.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,19 +841,14 @@ assembleI platform i = case i of W8 -> emit_ bci_OP_INDEX_ADDR_08 [] _ -> unsupported_width - BRK_FUN tick_mod tickx info_mod infox -> - do 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 tick_mod $ fromIntegral tickx - emit_ bci_BRK_FUN [ Op p1 - , Op tick_addr, Op info_addr - , Op tick_unitid_addr, Op info_unitid_addr - , SmallOp tickx, SmallOp infox - , Op np - ] + BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do + p1 <- ptr $ BCOPtrBreakArray info_mod + info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod + info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod + info_wix <- int infox + np <- lit1 $ BCONPtrCostCentre ibi + emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr + , Op info_wix, Op np ] BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp active] ===================================== compiler/GHC/ByteCode/Breakpoints.hs ===================================== @@ -7,7 +7,7 @@ -- '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(..) @@ -17,7 +17,6 @@ module GHC.ByteCode.Breakpoints , InternalBreakpointId(..), BreakInfoIndex -- * Operations - , toBreakpointId -- ** Internal-level operations , getInternalBreak, addInternalBreak @@ -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'@. See `internalBreakIdToBreakId` -} -------------------------------------------------------------------------------- @@ -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 -------------------------------------------------------------------------------- @@ -128,20 +148,23 @@ 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. 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 +getInternalBreak (InternalBreakpointId mod ix) imbs = + assert_modules_match mod (imodBreaks_module imbs) $ + imodBreaks_breakInfo imbs IM.! 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)} +addInternalBreak (InternalBreakpointId mod ix) info imbs = + assert_modules_match mod (imodBreaks_module imbs) $ + imbs{imodBreaks_breakInfo = IM.insert ix info (imodBreaks_breakInfo imbs)} -- | Assert that the module in the 'InternalBreakpointId' and in -- 'InternalModBreaks' match. @@ -156,26 +179,28 @@ assert_modules_match ibi_mod imbs_mod = -------------------------------------------------------------------------------- -- | Get the source span for this breakpoint -getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan +getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> Maybe SrcSpan getBreakLoc = getBreakXXX modBreaks_locs -- | Get the vars for this breakpoint -getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName] +getBreakVars :: InternalBreakpointId -> InternalModBreaks -> Maybe [OccName] getBreakVars = getBreakXXX modBreaks_vars -- | Get the decls for this breakpoint -getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String] +getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> Maybe [String] getBreakDecls = getBreakXXX modBreaks_decls -- | Get the decls for this breakpoint -getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String) +getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> Maybe (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 +getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> Maybe a +getBreakXXX view (InternalBreakpointId ibi_mod ibi_ix) imbs = + assert_modules_match ibi_mod (imodBreaks_module imbs) $ do + let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix + mbs <- imodBreaks_modBreaks imbs + Just $ view mbs ! bi_tick_index (cgb_tick_id cgb) -------------------------------------------------------------------------------- -- Instances @@ -190,7 +215,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 +229,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 ===================================== @@ -17,7 +17,6 @@ import GHC.ByteCode.Types import GHC.Cmm.Type (Width) import GHC.StgToCmm.Layout ( ArgRep(..) ) import GHC.Utils.Outputable -import GHC.Unit.Module import GHC.Types.Name import GHC.Types.Literal import GHC.Types.Unique @@ -259,10 +258,7 @@ data BCInstr -- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode -- Breakpoints - | BRK_FUN !Module -- breakpoint tick module - !Word16 -- breakpoint tick index - !Module -- breakpoint info module - !Word16 -- breakpoint info index + | BRK_FUN !InternalBreakpointId -- An internal breakpoint for triggering a break on any case alternative -- See Note [Debugger: BRK_ALTS] @@ -458,10 +454,9 @@ instance Outputable BCInstr where ppr ENTER = text "ENTER" ppr (RETURN pk) = text "RETURN " <+> ppr pk ppr (RETURN_TUPLE) = text "RETURN_TUPLE" - ppr (BRK_FUN _tick_mod tickx _info_mod infox) + ppr (BRK_FUN (InternalBreakpointId info_mod infox)) = text "BRK_FUN" <+> text "<breakarray>" - <+> text "" <+> text "" <+> ppr tickx - <+> text "" <+> text "" <+> ppr infox + <+> ppr info_mod <+> ppr infox <+> text "<cc>" ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active #if MIN_VERSION_rts(1,0,3) ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -97,9 +97,9 @@ lookupLiteral interp pkgs_loaded le ptr = case ptr of BCONPtrFFIInfo (FFIInfo {..}) -> do RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet pure $ fromIntegral p - BCONPtrCostCentre tick_mod tick_no - | interpreterProfiled interp -> - case expectJust (lookupModuleEnv (ccs_env le) tick_mod) ! tick_no of + BCONPtrCostCentre InternalBreakpointId{..} + | interpreterProfiled interp -> do + case expectJust (lookupModuleEnv (ccs_env le) ibi_info_mod) ! ibi_info_index of RemotePtr p -> pure $ fromIntegral p | otherwise -> case toRemotePtr nullPtr of ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -284,8 +284,8 @@ data BCONPtr | BCONPtrFS !FastString -- | A libffi ffi_cif function prototype. | BCONPtrFFIInfo !FFIInfo - -- | A 'CostCentre' remote pointer array's respective 'Module' and index - | BCONPtrCostCentre !Module !BreakTickIndex + -- | A 'CostCentre' remote pointer array's respective 'BreakpointId' + | BCONPtrCostCentre !BreakpointId instance NFData BCONPtr where rnf x = x `seq` () ===================================== 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.hs ===================================== @@ -97,8 +97,8 @@ import GHC.Unit.Module.Deps import Data.List (partition) import Data.IORef -import Data.Traversable (for) import GHC.Iface.Make (mkRecompUsageInfo) +import GHC.Runtime.Interpreter (interpreterProfiled) {- ************************************************************************ @@ -162,13 +162,12 @@ deSugar hsc_env mod mod_loc export_set (typeEnvTyCons type_env) binds else return (binds, Nothing) - ; modBreaks <- for - [ (i, s) - | i <- hsc_interp hsc_env - , (_, s) <- m_tickInfo - , breakpointsAllowed dflags - ] - $ \(interp, specs) -> mkModBreaks interp mod specs + ; let modBreaks + | Just (_, specs) <- m_tickInfo + , breakpointsAllowed dflags + = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs + | otherwise + = Nothing ; ds_hpc_info <- case m_tickInfo of Just (orig_file2, ticks) ===================================== 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(..) @@ -33,14 +33,6 @@ import GHC.Unit.Module (Module) import GHC.Utils.Outputable import Data.List (intersperse) -import GHCi.BreakArray (BreakArray) -import GHCi.RemoteTypes (ForeignRef) - --- TODO: Break this cycle -import {-# SOURCE #-} GHC.Runtime.Interpreter.Types (Interp, interpreterProfiled) -import {-# SOURCE #-} qualified GHC.Runtime.Interpreter as GHCi (newBreakArray) -import Data.Array.Base (numElements) - -------------------------------------------------------------------------------- -- ModBreaks -------------------------------------------------------------------------------- @@ -58,10 +50,7 @@ import Data.Array.Base (numElements) -- and 'modBreaks_decls'. data ModBreaks = ModBreaks - { modBreaks_flags :: ForeignRef BreakArray - -- ^ The array of flags, one per breakpoint, - -- indicating which breakpoints are enabled. - , modBreaks_locs :: !(Array BreakTickIndex SrcSpan) + { modBreaks_locs :: !(Array BreakTickIndex SrcSpan) -- ^ An array giving the source span of each breakpoint. , modBreaks_vars :: !(Array BreakTickIndex [OccName]) -- ^ An array giving the names of the free variables at each breakpoint. @@ -83,40 +72,31 @@ data ModBreaks -- generator needs to encode this information for each expression, the data is -- allocated remotely in GHCi's address space and passed to the codegen as -- foreign pointers. -mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks -mkModBreaks interp mod extendedMixEntries - = do - let count = fromIntegral $ sizeSS extendedMixEntries +mkModBreaks :: Bool {-^ Whether the interpreter is profiled and thus if we should include store a CCS array -} + -> Module -> SizedSeq Tick -> ModBreaks +mkModBreaks interpreterProfiled modl extendedMixEntries + = let count = fromIntegral $ sizeSS extendedMixEntries entries = ssElts extendedMixEntries - let - locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] - varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] - declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] - ccs - | interpreterProfiled interp = - listArray - (0, count - 1) - [ ( concat $ intersperse "." $ tick_path t, - renderWithContext defaultSDocContext $ ppr $ tick_loc t - ) - | t <- entries - ] - | otherwise = listArray (0, -1) [] - hydrateModBreaks interp $ - ModBreaks - { modBreaks_flags = undefined, - modBreaks_locs = locsTicks, - modBreaks_vars = varsTicks, - modBreaks_decls = declsTicks, - modBreaks_ccs = ccs, - modBreaks_module = mod - } - -hydrateModBreaks :: Interp -> ModBreaks -> IO ModBreaks -hydrateModBreaks interp ModBreaks {..} = do - let count = numElements modBreaks_locs - modBreaks_flags <- GHCi.newBreakArray interp count - pure ModBreaks {..} + locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] + varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] + declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] + ccs + | interpreterProfiled = + listArray + (0, count - 1) + [ ( concat $ intersperse "." $ tick_path t, + renderWithContext defaultSDocContext $ ppr $ tick_loc t + ) + | t <- entries + ] + | otherwise = listArray (0, -1) [] + in ModBreaks + { modBreaks_locs = locsTicks + , modBreaks_vars = varsTicks + , modBreaks_decls = declsTicks + , modBreaks_ccs = ccs + , modBreaks_module = modl + } {- Note [Field modBreaks_decls] ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -28,6 +28,7 @@ module GHC.Linker.Loader , extendLoadedEnv , deleteFromLoadedEnv -- * Internals + , allocateBreakArrays , rmDupLinkables , modifyLoaderState , initLinkDepsOpts @@ -122,6 +123,11 @@ import System.Win32.Info (getSystemDirectory) import GHC.Utils.Exception import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey) import GHC.Driver.Downsweep +import GHC.HsToCore.Breakpoints +import qualified Data.IntMap.Strict as IM +import qualified GHC.Runtime.Interpreter as GHCi +import GHC.Data.Maybe (expectJust) +import Foreign.Ptr (nullPtr) @@ -699,13 +705,13 @@ loadDecls interp hsc_env span linkable = do le2_breakarray_env <- allocateBreakArrays interp - (catMaybes $ map bc_breaks cbcs) (breakarray_env le) + (map bc_breaks cbcs) le2_ccs_env <- allocateCCS interp - (catMaybes $ map bc_breaks cbcs) (ccs_env le) + (map bc_breaks cbcs) let le2 = le { itbl_env = le2_itbl_env , addr_env = le2_addr_env , breakarray_env = le2_breakarray_env @@ -933,12 +939,8 @@ dynLinkBCOs interp pls bcos = do le1 = linker_env pls ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs) ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs - be2 <- - allocateBreakArrays - interp - (catMaybes $ map bc_breaks cbcs) - (breakarray_env le1) - ce2 <- allocateCCS interp (catMaybes $ map bc_breaks cbcs) (ccs_env le1) + be2 <- allocateBreakArrays interp (breakarray_env le1) (map bc_breaks cbcs) + ce2 <- allocateCCS interp (ccs_env le1) (map bc_breaks cbcs) let le2 = le1 { itbl_env = ie2, addr_env = ae2, breakarray_env = be2, ccs_env = ce2 } names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs @@ -1656,44 +1658,80 @@ allocateTopStrings interp topStrings prev_env = do where mk_entry nm ptr = (nm, (nm, AddrPtr ptr)) --- | Given a list of 'ModBreaks' collected from a list of --- 'CompiledByteCode', allocate the 'BreakArray'. +-- | Given a list of 'InternalModBreaks and 'ModBreaks' collected from a list of +-- 'CompiledByteCode', allocate the 'BreakArray' used to trigger breakpoints. allocateBreakArrays :: Interp -> - [InternalModBreaks] -> ModuleEnv (ForeignRef BreakArray) -> + [InternalModBreaks] -> IO (ModuleEnv (ForeignRef BreakArray)) -allocateBreakArrays _interp mbs be = +allocateBreakArrays interp = foldlM - ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> - evaluate $ extendModuleEnv be0 modBreaks_module modBreaks_flags + ( \be0 imbs -> do + let bi = imodBreaks_breakInfo imbs + hi = maybe 0 fst (IM.lookupMax bi) -- allocate as many slots as internal breakpoints + if not $ elemModuleEnv (imodBreaks_module imbs) be0 then do + -- If no BreakArray is assigned to this module yet, create one + breakArray <- GHCi.newBreakArray interp hi + evaluate $ extendModuleEnv be0 (imodBreaks_module imbs) breakArray + else + return be0 ) - be - mbs --- | Given a list of 'ModBreaks' collected from a list of --- 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling --- is enabled. +-- | Given a list of 'InternalModBreaks' and 'ModBreaks' collected from a list +-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is +-- enabled. +-- +-- Note that the resulting CostCenter is indexed by the 'InternalBreakpointId', +-- not by 'BreakpointId'. At runtime, BRK_FUN instructions are annotated with +-- internal ids -- we'll look them up in the array and push the corresponding +-- cost center. allocateCCS :: Interp -> - [InternalModBreaks] -> ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) -> + [InternalModBreaks] -> IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) -allocateCCS interp mbs ce - | interpreterProfiled interp = +allocateCCS interp ce mbss + | interpreterProfiled interp = do + -- First construct the CCSs for each module, using the 'ModBreaks' + ccs_map <- foldlM + ( \(ccs_map :: ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) imbs -> do + case imodBreaks_modBreaks imbs of + Nothing -> return ccs_map -- don't add it + Just mbs -> do + ccs <- + mkCostCentres + interp + (moduleNameString $ moduleName $ modBreaks_module mbs) + (elems $ modBreaks_ccs mbs) + evaluate $ + extendModuleEnv ccs_map (modBreaks_module mbs) $ + listArray (0, length ccs - 1) ccs + ) emptyModuleEnv mbss + -- Now, construct an array indexed by an 'InternalBreakpointId' index by first + -- finding the matching 'BreakpointId' and then looking it up in the ccs_map foldlM - ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do - ccs <- - mkCostCentres - interp - (moduleNameString $ moduleName modBreaks_module) - (elems modBreaks_ccs) + ( \ce0 imbs -> do + let breakModl = imodBreaks_module imbs + breakInfoMap = imodBreaks_breakInfo imbs + hi = maybe 0 fst (IM.lookupMax breakInfoMap) -- as many slots as internal breaks + ccss = expectJust $ lookupModuleEnv ccs_map breakModl + ccs_im <- foldlM + (\(bids :: IM.IntMap (RemotePtr CostCentre)) cgi -> do + let tickBreakId = bi_tick_index $ cgb_tick_id cgi + pure $ IM.insert tickBreakId (ccss ! tickBreakId) bids + ) mempty breakInfoMap + if not $ elemModuleEnv breakModl ce0 then do evaluate $ - extendModuleEnv ce0 modBreaks_module $ - listArray - (0, length ccs - 1) - ccs + extendModuleEnv ce0 breakModl $ + listArray (0, hi-1) $ + map (\i -> case IM.lookup i ccs_im of + Nothing -> toRemotePtr nullPtr + Just ccs -> ccs + ) [0..hi-1] + else + return ce0 ) ce - mbs + mbss | otherwise = pure ce ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -72,6 +72,7 @@ import GHC.Unit.Module.WholeCoreBindings import Data.Maybe (mapMaybe) import Data.List.NonEmpty (NonEmpty, nonEmpty) import qualified Data.List.NonEmpty as NE +import GHC.HsToCore.Breakpoints (BreakTickIndex) {- ********************************************************************** ===================================== compiler/GHC/Runtime/Debugger/Breakpoints.hs ===================================== @@ -197,7 +197,7 @@ type TickArray = Array Int [(BreakTickIndex,RealSrcSpan)] makeModuleLineMap :: GhcMonad m => Module -> m (Maybe TickArray) makeModuleLineMap m = do mi <- getModuleInfo m - return $ mkTickArray . assocs . modBreaks_locs . imodBreaks_modBreaks <$> (modInfoModBreaks =<< mi) + return $ mkTickArray . assocs . modBreaks_locs <$> (imodBreaks_modBreaks =<< modInfoModBreaks =<< mi) where mkTickArray :: [(BreakTickIndex, SrcSpan)] -> TickArray mkTickArray ticks @@ -211,7 +211,7 @@ makeModuleLineMap m = do getModBreak :: GhcMonad m => Module -> m (Maybe ModBreaks) getModBreak m = do mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m - pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info + pure $ imodBreaks_modBreaks =<< modInfoModBreaks mod_info -------------------------------------------------------------------------------- -- Getting current breakpoint information @@ -238,6 +238,6 @@ getCurrentBreakModule = do return $ case resumes of [] -> Nothing (r:_) -> case resumeHistoryIx r of - 0 -> ibi_tick_mod <$> resumeBreakpointId r + 0 -> ibi_info_mod <$> resumeBreakpointId r ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1) ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -64,6 +64,7 @@ import GHCi.RemoteTypes import GHC.ByteCode.Types import GHC.Linker.Loader as Loader +import GHC.Linker.Types (LinkerEnv(..)) import GHC.Hs @@ -126,6 +127,7 @@ import GHC.Tc.Utils.Instantiate (instDFunType) import GHC.Tc.Utils.Monad import GHC.IfaceToCore +import GHC.ByteCode.Breakpoints import Control.Monad import Data.Dynamic @@ -134,7 +136,7 @@ import Data.List (find,intercalate) import Data.List.NonEmpty (NonEmpty) import Unsafe.Coerce ( unsafeCoerce ) import qualified GHC.Unit.Home.Graph as HUG -import GHC.ByteCode.Breakpoints +import GHCi.BreakArray (BreakArray) -- ----------------------------------------------------------------------------- -- running a statement interactively @@ -146,13 +148,13 @@ mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO Hi mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi getHistoryModule :: History -> Module -getHistoryModule = ibi_tick_mod . historyBreakpointId +getHistoryModule = ibi_info_mod . historyBreakpointId getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan getHistorySpan hug hist = do let ibi = historyBreakpointId hist - brks <- readModBreaks hug (ibi_tick_mod ibi) - return $ getBreakLoc ibi brks + brks <- expectJust <$> readModBreaks hug ibi + return $ expectJust $ getBreakLoc ibi brks {- | Finds the enclosing top level function name -} -- ToDo: a better way to do this would be to keep hold of the decl_path computed @@ -160,8 +162,10 @@ getHistorySpan hug hist = do -- for each tick. findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String] findEnclosingDecls hug ibi = do - brks <- readModBreaks hug (ibi_tick_mod ibi) - return $ getBreakDecls ibi brks + readModBreaks hug ibi >>= \case + Nothing -> return [] + Just brks -> return $ + fromMaybe [] (getBreakDecls ibi brks) -- | Update fixity environment in the current interactive context. updateFixityEnv :: GhcMonad m => FixityEnv -> m () @@ -346,15 +350,17 @@ handleRunStatus step expr bindings final_ids status history0 = do -- - the breakpoint was explicitly enabled (in @BreakArray@) -- - or one of the stepping options in @EvalOpts@ caused us to stop at one EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do - let ibi = evalBreakpointToId eval_break let hug = hsc_HUG hsc_env - tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi) + let ibi@InternalBreakpointId{ibi_info_index} + = evalBreakpointToId eval_break + brks <- liftIO $ readModBreaks hug ibi + breakArray <- getBreakArray interp ibi (expectJust brks) let - span = getBreakLoc ibi tick_brks - decl = intercalate "." $ getBreakDecls ibi tick_brks + span = fromMaybe noSrcSpan $ getBreakLoc ibi =<< brks + decl = intercalate "." $ fromMaybe [] $ getBreakDecls ibi =<< brks -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)? - bactive <- liftIO $ breakpointStatus interp (modBreaks_flags $ imodBreaks_modBreaks tick_brks) (ibi_tick_index ibi) + bactive <- liftIO $ breakpointStatus interp breakArray ibi_info_index apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt @@ -442,7 +448,8 @@ resumeExec step mbCnt -- When the user specified a break ignore count, set it -- in the interpreter case (mb_brkpt, mbCnt) of - (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt + (Just ibi, Just cnt) -> + setupBreakpoint interp ibi cnt _ -> return () let eval_opts = initEvalOpts dflags (enableGhcStepMode step) @@ -451,20 +458,35 @@ resumeExec step mbCnt hug = hsc_HUG hsc_env hist' = case mb_brkpt of Nothing -> pure prevHistoryLst - Just bi + Just ibi | breakHere False step span -> do - hist1 <- liftIO (mkHistory hug apStack bi) + hist1 <- liftIO (mkHistory hug apStack ibi) return $ hist1 `consBL` fromListBL 50 hist | otherwise -> pure prevHistoryLst handleRunStatus step expr bindings final_ids status =<< hist' -setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #19157 -setupBreakpoint interp bi cnt = do +setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157 +setupBreakpoint interp ibi cnt = do hug <- hsc_HUG <$> getSession - modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi) - let breakarray = modBreaks_flags $ imodBreaks_modBreaks modBreaks - _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt - pure () + ims <- liftIO $ readModBreaks hug ibi + breakArray <- getBreakArray interp ibi (expectJust ims) + liftIO $ GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt + +getBreakArray :: GhcMonad m => Interp -> InternalBreakpointId -> InternalModBreaks -> m (ForeignRef BreakArray) +getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do + + liftIO $ modifyLoaderState interp $ \ld_st -> do + let le = linker_env ld_st + + -- Recall that BreakArrays are allocated only at BCO link time, so if we + -- haven't linked the BCOs we intend to break at yet, we allocate the arrays here. + ba_env <- allocateBreakArrays interp (breakarray_env le) [imbs] + + return + ( ld_st { linker_env = le{breakarray_env = ba_env} } + , expectJust {- just computed -} $ + lookupModuleEnv ba_env ibi_info_mod + ) back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) back n = moveHist (+n) @@ -493,8 +515,8 @@ moveHist fn = do span <- case mb_info of Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>") Just ibi -> liftIO $ do - brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi) - return $ getBreakLoc ibi brks + brks <- readModBreaks (hsc_HUG hsc_env) ibi + return $ fromMaybe noSrcSpan $ getBreakLoc ibi =<< brks (hsc_env1, names) <- liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info let ic = hsc_IC hsc_env1 @@ -555,11 +577,10 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do -- of the breakpoint and the free variables of the expression. bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do let hug = hsc_HUG hsc_env - info_brks <- readModBreaks hug (ibi_info_mod ibi) - tick_brks <- readModBreaks hug (ibi_tick_mod ibi) - let info = getInternalBreak ibi (info_brks) + info_brks <- readModBreaks hug ibi + let info = getInternalBreak ibi (expectJust info_brks) interp = hscInterp hsc_env - occs = getBreakVars ibi tick_brks + occs = fromMaybe [] $ getBreakVars ibi =<< info_brks -- Rehydrate to understand the breakpoint info relative to the current environment. -- This design is critical to preventing leaks (#22530) @@ -699,6 +720,7 @@ pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 } {- Note [Syncing breakpoint info] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ROMES:TODO: Update To display the values of the free variables for a single breakpoint, the function `GHC.Runtime.Eval.bindLocalsAtBreakpoint` pulls out the information from the fields `modBreaks_breakInfo` and ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -107,7 +107,6 @@ import Data.Binary import Data.ByteString (ByteString) import Foreign hiding (void) import qualified GHC.Exts.Heap as Heap -import GHC.Stack.CCS (CostCentre,CostCentreStack) import System.Directory import System.Process import qualified GHC.InfoProv as InfoProv @@ -411,15 +410,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 +434,17 @@ 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 <- readModBreaks hug 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 ibi modbreaks -- resume the seq (:force) processing in the iserv process withForeignRef resume_ctxt_fhv $ \hval -> do @@ -741,14 +735,14 @@ getModBreaks hmi | Just linkable <- homeModInfoByteCode hmi, -- The linkable may have 'DotO's as well; only consider BCOs. See #20570. [cbc] <- linkableBCOs linkable - = bc_breaks cbc + = Just $ bc_breaks cbc | otherwise = Nothing -- probably object code -- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module' -- from the 'HomeUnitGraph'. -readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks -readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug +readModBreaks :: HasCallStack => HomeUnitGraph -> InternalBreakpointId -> IO (Maybe InternalModBreaks) +readModBreaks hug ibi = getModBreaks . expectJust <$> HUG.lookupHugByModule (ibi_info_mod ibi) hug -- ----------------------------------------------------------------------------- -- Misc utils ===================================== compiler/GHC/Runtime/Interpreter.hs-boot deleted ===================================== @@ -1,10 +0,0 @@ -module GHC.Runtime.Interpreter where - -import {-# SOURCE #-} GHC.Runtime.Interpreter.Types -import Data.Int (Int) -import GHC.Base (IO) -import GHCi.BreakArray (BreakArray) -import GHCi.RemoteTypes (ForeignRef) - -newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray) - ===================================== compiler/GHC/Runtime/Interpreter/Types.hs-boot deleted ===================================== @@ -1,6 +0,0 @@ -module GHC.Runtime.Interpreter.Types where - -import Data.Bool - -data Interp -interpreterProfiled :: Interp -> Bool ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -134,10 +134,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries "Proto-BCOs" FormatByteCode (vcat (intersperse (char ' ') (map ppr $ elemsFlatBag proto_bcos))) - let mod_breaks = case mb_modBreaks of - Nothing -> Nothing - Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb - cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries + cbc <- assembleBCOs profile proto_bcos tycs strings internalBreaks spt_entries -- Squash space leaks in the CompiledByteCode. This is really -- important, because when loading a set of modules into GHCi @@ -394,69 +391,22 @@ 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 - - let info_mod = modBreaks_module current_mod_breaks - infox <- newBreakInfo breakInfo - - 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) - breakInstr = BRK_FUN tick_mod (toW16 tick_no) info_mod (toW16 infox) - return $ breakInstr `consOL` code -schemeER_wrk d p rhs = schemeE d 0 p rhs + 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 + + -- TODO: Lookup tick_id in InternalBreakMods and if it returns Nothing then + -- we don't have Breakpoint information for this Breakpoint so might as well + -- not emit the instruction. + ibi <- newBreakInfo breakInfo + return $ BRK_FUN ibi `consOL` code --- | 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 +schemeER_wrk d p rhs = schemeE d 0 p rhs getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)] getVarOffSets platform depth env = map getOffSet ===================================== ghc/GHCi/UI.hs ===================================== @@ -1572,9 +1572,9 @@ afterRunStmt step run_result = do Right names -> do show_types <- isOptionSet ShowType when show_types $ printTypeOfNames names - GHC.ExecBreak names mb_info + GHC.ExecBreak names mibi | first_resume : _ <- resumes - -> do mb_id_loc <- toBreakIdAndLocation mb_info + -> do mb_id_loc <- toBreakIdAndLocation mibi let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc if (null bCmd) then printStoppedAtBreakInfo first_resume names @@ -1612,8 +1612,8 @@ toBreakIdAndLocation Nothing = return Nothing toBreakIdAndLocation (Just inf) = do st <- getGHCiState return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st), - breakModule loc == ibi_tick_mod inf, - breakTick loc == ibi_tick_index inf ] + breakModule loc == ibi_info_mod inf, + breakTick loc == ibi_info_index inf ] printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m () printStoppedAtBreakInfo res names = do @@ -3793,7 +3793,7 @@ pprStopped res = <> text (GHC.resumeDecl res)) <> char ',' <+> ppr (GHC.resumeSpan res) where - mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res + mb_mod_name = moduleName . ibi_info_mod <$> GHC.resumeBreakpointId res showUnits :: GHC.GhcMonad m => m () showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do @@ -4348,11 +4348,11 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do case result of Left sdoc -> printForUser sdoc Right (loc, count) -> do - let bi = GHC.BreakpointId - { bi_tick_mod = breakModule loc - , bi_tick_index = breakTick loc + let ibi = GHC.InternalBreakpointId + { ibi_info_mod = breakModule loc + , ibi_info_index = breakTick loc } - setupBreakpoint bi count + setupBreakpoint ibi count ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int)) ignoreSwitch [break, count] = do @@ -4369,7 +4369,7 @@ getIgnoreCount str = where sdocIgnore = text "Ignore count" <+> quotes (text str) -setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m() +setupBreakpoint :: GhciMonad m => GHC.InternalBreakpointId -> Int -> m() setupBreakpoint loc count = do hsc_env <- GHC.getSession GHC.setupBreakpoint (hscInterp hsc_env) loc count @@ -4448,7 +4448,7 @@ breakById inp = do Left sdoc -> printForUser sdoc Right (mod, mod_info, fun_str) -> do let modBreaks = expectJust (GHC.modInfoModBreaks mod_info) - findBreakAndSet mod $ \_ -> findBreakForBind fun_str (imodBreaks_modBreaks modBreaks) + findBreakAndSet mod $ \_ -> maybe [] (findBreakForBind fun_str) (imodBreaks_modBreaks modBreaks) breakSyntax :: a breakSyntax = throwGhcException $ CmdLineError ("Syntax: :break [<mod>.]<func>[.<func>]\n" @@ -4727,10 +4727,10 @@ turnBreakOnOff onOff loc return loc { breakEnabled = onOff } setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m () -setBreakFlag md ix enaDisa = do +setBreakFlag md ix enaDisa = do let enaDisaToCount True = breakOn enaDisaToCount False = breakOff - setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa + setupBreakpoint (GHC.InternalBreakpointId md ix) $ enaDisaToCount enaDisa -- --------------------------------------------------------------------------- -- User code exception handling ===================================== 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 ===================================== @@ -342,7 +342,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 @@ -355,11 +355,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 @@ -406,8 +404,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_GET_LARGE_ARG; + 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, literals[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_LIT(BCO_GET_LARGE_ARG); #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/d116ee0b222db687bd6acb58114cb92... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d116ee0b222db687bd6acb58114cb92... You're receiving this email because of your account on gitlab.haskell.org.