Rodrigo Mesquita pushed to branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC Commits: 06651a24 by Rodrigo Mesquita at 2025-07-02T17:24:52+01:00 refact: Split InternalModBreaks out of ModBreaks There are currently two competing ways of referring to a Breakpoint: 1. Using the Tick module + Tick index 2. Using the Info module + Info index 1. The Tick index is allocated during desugaring in `mkModBreaks`. It is used to refer to a breakpoint associated to a Core Tick. For a given Tick module, there are N Ticks indexed by Tick index. 2. The Info index is allocated during code generation (in StgToByteCode) and uniquely identifies the breakpoints at runtime (and is indeed used to determine which breakpoint was hit at runtime). Why we need both is described by Note [Breakpoint identifiers]. For every info index we used to keep a `CgBreakInfo`, a datatype containing information relevant to ByteCode Generation, in `ModBreaks`. This commit splits out the `IntMap CgBreakInfo` out of `ModBreaks` into a new datatype `InternalModBreaks`. - The purpose is to separate the `ModBreaks` datatype, which stores data associated from tick-level information which is fixed after desugaring, from the unrelated `IntMap CgBreakInfo` information accumulated during bytecode generation. - We move `ModBreaks` to GHC.HsToCore.Breakpoints The new `InternalModBreaks` simply combines the `IntMap CgBreakInfo` with `ModBreaks`. After code generation we construct an `InternalModBreaks` with the `CgBreakInfo`s we accumulated and the existing `ModBreaks` and store that in the compiled BCO in `bc_breaks`. - Note that we previously only updated the `modBreaks_breakInfo` field of `ModBreaks` at this exact location, and then stored the updated `ModBreaks` in the same `bc_breaks`. - We put this new datatype in GHC.ByteCode.Breakpoints The rest of the pipeline for which CgBreakInfo is relevant is accordingly updated to also use `InternalModBreaks` - - - - - c3f1b718 by Rodrigo Mesquita at 2025-07-02T17:24:52+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 - - - - - 5178fc25 by Rodrigo Mesquita at 2025-07-02T17:24:52+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). - - - - - 26 changed files: - compiler/GHC.hs - 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/Core/Ppr.hs - compiler/GHC/Driver/Session/Inspect.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.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/Eval/Types.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs - − compiler/GHC/Types/Breakpoint.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/ghc.cabal.in - ghc/GHCi/UI.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC.hs ===================================== @@ -201,7 +201,7 @@ module GHC ( getResumeContext, GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType, modInfoModBreaks, - ModBreaks(..), BreakIndex, + ModBreaks(..), BreakTickIndex, BreakpointId(..), InternalBreakpointId(..), GHC.Runtime.Eval.back, GHC.Runtime.Eval.forward, @@ -427,7 +427,6 @@ import GHC.Types.Basic import GHC.Types.TyThing import GHC.Types.Name.Env import GHC.Types.TypeEnv -import GHC.Types.Breakpoint import GHC.Types.PkgQual import GHC.Unit ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -109,7 +109,7 @@ assembleBCOs -> FlatBag (ProtoBCO Name) -> [TyCon] -> [(Name, ByteString)] - -> Maybe ModBreaks + -> Maybe InternalModBreaks -> [SptEntry] -> IO CompiledByteCode assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do @@ -841,19 +841,24 @@ 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 (InternalBreakpointId tick_mod tickx info_mod infox) -> do + 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 + ] BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)] ===================================== compiler/GHC/ByteCode/Breakpoints.hs ===================================== @@ -0,0 +1,206 @@ +{-# LANGUAGE RecordWildCards #-} + +-- | Breakpoint information constructed during ByteCode generation. +-- +-- Specifically, code-generation breakpoints are referred to as "internal +-- breakpoints", the internal breakpoint data for a module is stored in +-- 'InternalModBreaks', and is uniquely identified at runtime by an +-- 'InternalBreakpointId'. +-- +-- See Note [Breakpoint identifiers] +module GHC.ByteCode.Breakpoints + ( -- * Internal Mod Breaks + InternalModBreaks(..), CgBreakInfo(..) + , mkInternalModBreaks + + -- ** Internal breakpoint identifier + , InternalBreakpointId(..), BreakInfoIndex + + -- * Operations + , toBreakpointId + + -- ** Internal-level operations + , getInternalBreak, addInternalBreak + + -- ** Source-level information operations + , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS + + -- * Utils + , seqInternalModBreaks + + ) + where + +import GHC.Prelude +import GHC.Types.SrcLoc +import GHC.Types.Name.Occurrence +import Control.DeepSeq +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IM + +import GHC.HsToCore.Breakpoints +import GHC.Iface.Syntax + +import GHC.Unit.Module (Module) +import GHC.Utils.Outputable +import GHC.Utils.Panic +import Data.Array + +{- +Note [Breakpoint identifiers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Before optimization a breakpoint is identified uniquely with a tick module +and a tick index. See 'BreakpointId'. A tick module contains an array, indexed +with the tick indexes, which indicates breakpoint status. + +When we generate ByteCode, we collect information for every breakpoint at +their *occurrence sites* (see CgBreakInfo) and these info +are stored in the ModIface of the occurrence module. Because of inlining, we +can't reuse the tick index to uniquely identify an occurrence; because of +cross-module inlining, we can't assume that the occurrence module is the same +as the tick module (#24712). + +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. +-} + +-------------------------------------------------------------------------------- +-- * Internal breakpoint identifiers +-------------------------------------------------------------------------------- + +-- | Internal breakpoint info index +type BreakInfoIndex = Int + +-- | Internal breakpoint identifier +-- +-- 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_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 +-------------------------------------------------------------------------------- + +-- | Internal mod breaks store the runtime-relevant information of breakpoints. +-- +-- Importantly, it maps 'InternalBreakpointId's to 'CgBreakInfo'. +-- +-- 'InternalModBreaks' are constructed during bytecode generation and stored in +-- 'CompiledByteCode' afterwards. +data InternalModBreaks = InternalModBreaks + { imodBreaks_breakInfo :: !(IntMap CgBreakInfo) + -- ^ Access code-gen time information about a breakpoint, indexed by + -- '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. + } + +-- | Construct an 'InternalModBreaks' +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 + +-- | 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 +-- preventing space leaks (see #22530) +data CgBreakInfo + = CgBreakInfo + { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint + , cgb_vars :: ![Maybe (IfaceIdBndr, Word)] + , cgb_resty :: !IfaceType + } +-- 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)} + +-- | Assert that the module in the 'InternalBreakpointId' and in +-- 'InternalModBreaks' match. +assert_modules_match :: Module -> Module -> a -> a +assert_modules_match ibi_mod imbs_mod = + assertPpr (ibi_mod == imbs_mod) + (text "Tried to query the InternalModBreaks of module" <+> ppr imbs_mod + <+> text "with an InternalBreakpointId for module" <+> ppr ibi_mod) + +-------------------------------------------------------------------------------- +-- Tick-level Breakpoint information +-------------------------------------------------------------------------------- + +-- | Get the source span for this breakpoint +getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan +getBreakLoc = getBreakXXX modBreaks_locs + +-- | Get the vars for this breakpoint +getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName] +getBreakVars = getBreakXXX modBreaks_vars + +-- | Get the decls for this breakpoint +getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String] +getBreakDecls = getBreakXXX modBreaks_decls + +-- | Get the decls for this breakpoint +getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (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 + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +-- | Fully force an 'InternalModBreaks' value +seqInternalModBreaks :: InternalModBreaks -> () +seqInternalModBreaks InternalModBreaks{..} = + rnf (fmap seqCgBreakInfo imodBreaks_breakInfo) + where + seqCgBreakInfo :: CgBreakInfo -> () + seqCgBreakInfo CgBreakInfo{..} = + rnf cgb_tyvars `seq` + rnf cgb_vars `seq` + rnf cgb_resty + +instance Outputable InternalBreakpointId where + ppr InternalBreakpointId{..} = + text "InternalBreakpointId" <+> ppr ibi_info_mod <+> ppr ibi_info_index + +instance NFData InternalBreakpointId where + rnf InternalBreakpointId{..} = + rnf ibi_info_mod `seq` rnf ibi_info_index + +instance Outputable CgBreakInfo where + ppr info = text "CgBreakInfo" <+> + parens (ppr (cgb_vars info) <+> + ppr (cgb_resty 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,10 @@ 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 tick_mod tickx info_mod infox)) = text "BRK_FUN" <+> text "<breakarray>" - <+> text "" <+> text "" <+> ppr tickx - <+> text "" <+> text "" <+> ppr infox + <+> ppr tick_mod <+> ppr tickx + <+> 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 BreakpointId{..} + | interpreterProfiled interp -> do + case expectJust (lookupModuleEnv (ccs_env le) bi_tick_mod) ! bi_tick_index of RemotePtr p -> pure $ fromIntegral p | otherwise -> case toRemotePtr nullPtr of ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -18,10 +18,15 @@ module GHC.ByteCode.Types , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..) , ItblEnv, ItblPtr(..) , AddrEnv, AddrPtr(..) - , CgBreakInfo(..) - , ModBreaks (..), BreakIndex - , CCostCentre , FlatBag, sizeFlatBag, fromSmallArray, elemsFlatBag + + -- * Mod Breaks + , ModBreaks (..), BreakpointId(..), BreakTickIndex + + -- * Internal Mod Breaks + , InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks + -- ** Internal breakpoint identifier + , InternalBreakpointId(..), BreakInfoIndex ) where import GHC.Prelude @@ -33,8 +38,8 @@ import GHC.Types.Name.Env import GHC.Utils.Outputable import GHC.Builtin.PrimOps import GHC.Types.SptEntry -import GHC.Types.SrcLoc -import GHCi.BreakArray +import GHC.HsToCore.Breakpoints +import GHC.ByteCode.Breakpoints import GHCi.Message import GHCi.RemoteTypes import GHCi.FFI @@ -42,12 +47,9 @@ import Control.DeepSeq import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray ) import Foreign -import Data.Array import Data.ByteString (ByteString) -import Data.IntMap (IntMap) import qualified GHC.Exts.Heap as Heap import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList ) -import GHC.Iface.Syntax import GHC.Unit.Module -- ----------------------------------------------------------------------------- @@ -63,8 +65,12 @@ data CompiledByteCode = CompiledByteCode , bc_strs :: [(Name, ByteString)] -- ^ top-level strings (heap allocated) - , bc_breaks :: Maybe ModBreaks - -- ^ breakpoint info (Nothing if breakpoints are disabled) + , bc_breaks :: Maybe InternalModBreaks + -- ^ All breakpoint information (no information if breakpoints are disabled). + -- + -- This information is used when loading a bytecode object: we will + -- construct the arrays to be used at runtime to trigger breakpoints at load time + -- from it (in 'allocateBreakArrays' and 'allocateCCS' in 'GHC.ByteCode.Loader'). , bc_spt_entries :: ![SptEntry] -- ^ Static pointer table entries which should be loaded along with the @@ -86,7 +92,9 @@ seqCompiledByteCode CompiledByteCode{..} = rnf bc_bcos `seq` rnf bc_itbls `seq` rnf bc_strs `seq` - rnf (fmap seqModBreaks bc_breaks) + case bc_breaks of + Nothing -> () + Just ibks -> seqInternalModBreaks ibks newtype ByteOff = ByteOff Int deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable) @@ -276,87 +284,15 @@ data BCONPtr | BCONPtrFS !FastString -- | A libffi ffi_cif function prototype. | BCONPtrFFIInfo !FFIInfo - -- | A 'CostCentre' remote pointer array's respective 'Module' and index. - | BCONPtrCostCentre !Module !BreakIndex + -- | A 'CostCentre' remote pointer array's respective 'BreakpointId' + | BCONPtrCostCentre !BreakpointId instance NFData BCONPtr where rnf x = x `seq` () --- | 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 --- preventing space leaks (see #22530) -data CgBreakInfo - = CgBreakInfo - { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint - , cgb_vars :: ![Maybe (IfaceIdBndr, Word)] - , cgb_resty :: !IfaceType - } --- See Note [Syncing breakpoint info] in GHC.Runtime.Eval - -seqCgBreakInfo :: CgBreakInfo -> () -seqCgBreakInfo CgBreakInfo{..} = - rnf cgb_tyvars `seq` - rnf cgb_vars `seq` - rnf cgb_resty - instance Outputable UnlinkedBCO where ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs) = sep [text "BCO", ppr nm, text "with", ppr (sizeFlatBag lits), text "lits", ppr (sizeFlatBag ptrs), text "ptrs" ] -instance Outputable CgBreakInfo where - ppr info = text "CgBreakInfo" <+> - parens (ppr (cgb_vars info) <+> - ppr (cgb_resty info)) - --- ----------------------------------------------------------------------------- --- Breakpoints - --- | Breakpoint index -type BreakIndex = Int - --- | C CostCentre type -data CCostCentre - --- | All the information about the breakpoints for a module -data ModBreaks - = ModBreaks - { modBreaks_flags :: ForeignRef BreakArray - -- ^ The array of flags, one per breakpoint, - -- indicating which breakpoints are enabled. - , modBreaks_locs :: !(Array BreakIndex SrcSpan) - -- ^ An array giving the source span of each breakpoint. - , modBreaks_vars :: !(Array BreakIndex [OccName]) - -- ^ An array giving the names of the free variables at each breakpoint. - , modBreaks_decls :: !(Array BreakIndex [String]) - -- ^ An array giving the names of the declarations enclosing each breakpoint. - -- See Note [Field modBreaks_decls] - , modBreaks_ccs :: !(Array BreakIndex (String, String)) - -- ^ Array pointing to cost centre info for each breakpoint; - -- actual 'CostCentre' allocation is done at link-time. - , modBreaks_breakInfo :: !(IntMap CgBreakInfo) - -- ^ info about each breakpoint from the bytecode generator - , modBreaks_module :: !Module - -- ^ info about the module in which we are setting the breakpoint - } - -seqModBreaks :: ModBreaks -> () -seqModBreaks ModBreaks{..} = - rnf modBreaks_flags `seq` - rnf modBreaks_locs `seq` - rnf modBreaks_vars `seq` - rnf modBreaks_decls `seq` - rnf modBreaks_ccs `seq` - rnf (fmap seqCgBreakInfo modBreaks_breakInfo) `seq` - rnf modBreaks_module - -{- -Note [Field modBreaks_decls] -~~~~~~~~~~~~~~~~~~~~~~ -A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means: -The breakpoint is in the function called "baz" that is declared in a `let` -or `where` clause of a declaration called "bar", which itself is declared -in a `let` or `where` clause of the top-level function called "foo". --} ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -31,7 +31,6 @@ import GHC.Prelude import GHC.Core import GHC.Core.Stats (exprStats) -import GHC.Types.Breakpoint import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Literal( pprLiteral ) import GHC.Types.Name( pprInfixName, pprPrefixName ) ===================================== compiler/GHC/Driver/Session/Inspect.hs ===================================== @@ -91,7 +91,7 @@ data ModuleInfo = ModuleInfo { minf_instances :: [ClsInst], minf_iface :: Maybe ModIface, minf_safe :: SafeHaskellMode, - minf_modBreaks :: Maybe ModBreaks + minf_modBreaks :: Maybe InternalModBreaks } -- We don't want HomeModInfo here, because a ModuleInfo applies -- to package modules too. @@ -196,6 +196,6 @@ modInfoIface = minf_iface modInfoSafe :: ModuleInfo -> SafeHaskellMode modInfoSafe = minf_safe -modInfoModBreaks :: ModuleInfo -> Maybe ModBreaks +modInfoModBreaks :: ModuleInfo -> Maybe InternalModBreaks modInfoModBreaks = minf_modBreaks ===================================== 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 ===================================== @@ -1,26 +1,69 @@ {-# LANGUAGE RecordWildCards #-} +-- | Information attached to Breakpoints generated from Ticks +-- +-- The breakpoint information stored in 'ModBreaks' is generated during +-- desugaring from the ticks annotating the source expressions. +-- +-- This information can be queried per-breakpoint using the 'BreakpointId' +-- datatype, which indexes tick-level breakpoint information. +-- +-- 'ModBreaks' and 'BreakpointId's are not to be confused with +-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed +-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'. +-- +-- See Note [Breakpoint identifiers] module GHC.HsToCore.Breakpoints - ( mkModBreaks, - hydrateModBreaks + ( -- * ModBreaks + mkModBreaks, ModBreaks(..) + + -- ** Re-exports BreakpointId + , BreakpointId(..), BreakTickIndex ) where import GHC.Prelude - -import qualified GHC.Runtime.Interpreter as GHCi -import GHC.Runtime.Interpreter -import GHC.ByteCode.Types -import GHC.Unit +import Data.Array import GHC.HsToCore.Ticks (Tick (..)) - import GHC.Data.SizedSeq -import GHC.Utils.Outputable as Outputable - +import GHC.Types.SrcLoc (SrcSpan) +import GHC.Types.Name (OccName) +import GHC.Types.Tickish (BreakTickIndex, BreakpointId(..)) +import GHC.Unit.Module (Module) +import GHC.Utils.Outputable import Data.List (intersperse) -import Data.Array -import Data.Array.Base (numElements) -import qualified Data.IntMap as IntMap + +-------------------------------------------------------------------------------- +-- ModBreaks +-------------------------------------------------------------------------------- + +-- | All the information about the source-relevant breakpoints for a module +-- +-- This information is constructed once during desugaring (with `mkModBreaks`) +-- from breakpoint ticks and fixed/unchanged from there on forward. It could be +-- exported as an abstract datatype because it should never be updated after +-- construction, only queried. +-- +-- The arrays can be indexed using the int in the corresponding 'BreakpointId' +-- (i.e. the 'BreakpointId' whose 'Module' matches the 'Module' corresponding +-- to these 'ModBreaks') with the accessors 'modBreaks_locs', 'modBreaks_vars', +-- and 'modBreaks_decls'. +data ModBreaks + = ModBreaks + { 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. + , modBreaks_decls :: !(Array BreakTickIndex [String]) + -- ^ An array giving the names of the declarations enclosing each breakpoint. + -- See Note [Field modBreaks_decls] + , modBreaks_ccs :: !(Array BreakTickIndex (String, String)) + -- ^ Array pointing to cost centre info for each breakpoint; + -- actual 'CostCentre' allocation is done at link-time. + , modBreaks_module :: !Module + -- ^ The module to which this ModBreaks is associated. + -- We also cache this here for internal sanity checks. + } -- | Initialize memory for breakpoint data that is shared between the bytecode -- generator and the interpreter. @@ -29,38 +72,37 @@ import qualified Data.IntMap as IntMap -- 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_breakInfo = IntMap.empty, - modBreaks_module = mod - } + 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 + } -hydrateModBreaks :: Interp -> ModBreaks -> IO ModBreaks -hydrateModBreaks interp ModBreaks {..} = do - let count = numElements modBreaks_locs - modBreaks_flags <- GHCi.newBreakArray interp count - pure ModBreaks {..} +{- +Note [Field modBreaks_decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means: +The breakpoint is in the function called "baz" that is declared in a `let` +or `where` clause of a declaration called "bar", which itself is declared +in a `let` or `where` clause of the top-level function called "foo". +-} ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -34,7 +34,6 @@ import GHC.Driver.Flags (DumpFlag(..)) import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic import GHC.Utils.Logger -import GHC.Types.Breakpoint import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Id ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -56,7 +56,6 @@ import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue) import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey, constraintKindTyConKey ) -import GHC.Types.Breakpoint import GHC.Types.Unique ( hasKey ) import GHC.Iface.Type import GHC.Iface.Recomp.Binary @@ -75,6 +74,7 @@ import GHC.Types.Avail import GHC.Types.ForeignCall import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic +import GHC.Types.Tickish import GHC.Unit.Module import GHC.Unit.Module.Warnings import GHC.Types.SrcLoc ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -28,6 +28,7 @@ module GHC.Linker.Loader , extendLoadedEnv , deleteFromLoadedEnv -- * Internals + , allocateBreakArrays , rmDupLinkables , modifyLoaderState , initLinkDepsOpts @@ -122,8 +123,8 @@ import System.Win32.Info (getSystemDirectory) import GHC.Utils.Exception import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey) import GHC.Driver.Downsweep - - +import qualified GHC.Runtime.Interpreter as GHCi +import Data.Array.Base (numElements) -- Note [Linkers and loaders] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -696,16 +697,8 @@ loadDecls interp hsc_env span linkable = do let le = linker_env pls le2_itbl_env <- linkITbls interp (itbl_env le) (concat $ map bc_itbls cbcs) le2_addr_env <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le) cbcs - le2_breakarray_env <- - allocateBreakArrays - interp - (catMaybes $ map bc_breaks cbcs) - (breakarray_env le) - le2_ccs_env <- - allocateCCS - interp - (catMaybes $ map bc_breaks cbcs) - (ccs_env le) + le2_breakarray_env <- allocateBreakArrays interp (breakarray_env le) (catMaybes $ map bc_breaks cbcs) + le2_ccs_env <- allocateCCS interp (ccs_env le) (catMaybes $ map bc_breaks cbcs) let le2 = le { itbl_env = le2_itbl_env , addr_env = le2_addr_env , breakarray_env = le2_breakarray_env @@ -933,12 +926,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) (catMaybes $ map bc_breaks cbcs) + ce2 <- allocateCCS interp (ccs_env le1) (catMaybes $ 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 +1645,51 @@ 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' collected from a list of +-- 'CompiledByteCode', allocate the 'BreakArray' used to trigger breakpoints. allocateBreakArrays :: Interp -> - [ModBreaks] -> ModuleEnv (ForeignRef BreakArray) -> + [InternalModBreaks] -> IO (ModuleEnv (ForeignRef BreakArray)) -allocateBreakArrays _interp mbs be = +allocateBreakArrays interp = foldlM - ( \be0 ModBreaks {..} -> - evaluate $ extendModuleEnv be0 modBreaks_module modBreaks_flags + ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do + -- If no BreakArray is assigned to this module yet, create one + if not $ elemModuleEnv modBreaks_module be0 then do + let count = numElements modBreaks_locs + breakArray <- GHCi.newBreakArray interp count + evaluate $ extendModuleEnv be0 modBreaks_module 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' collected from a list +-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is +-- enabled. allocateCCS :: Interp -> - [ModBreaks] -> - ModuleEnv (Array BreakIndex (RemotePtr CostCentre)) -> - IO (ModuleEnv (Array BreakIndex (RemotePtr CostCentre))) -allocateCCS interp mbs ce + ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) -> + [InternalModBreaks] -> + IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) +allocateCCS interp ce mbss | interpreterProfiled interp = foldlM - ( \ce0 ModBreaks {..} -> do + ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do ccs <- mkCostCentres interp (moduleNameString $ moduleName modBreaks_module) (elems modBreaks_ccs) - evaluate $ - extendModuleEnv ce0 modBreaks_module $ - listArray - (0, length ccs - 1) - ccs + if not $ elemModuleEnv modBreaks_module ce0 then do + evaluate $ + extendModuleEnv ce0 modBreaks_module $ + listArray + (0, length ccs - 1) + ccs + else + return ce0 ) ce - mbs + mbss | otherwise = pure ce ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -188,7 +188,7 @@ data LinkerEnv = LinkerEnv , breakarray_env :: !(ModuleEnv (ForeignRef BreakArray)) -- ^ Each 'Module's remote pointer of 'BreakArray'. - , ccs_env :: !(ModuleEnv (Array BreakIndex (RemotePtr CostCentre))) + , ccs_env :: !(ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) -- ^ Each 'Module's array of remote pointers of 'CostCentre'. -- Untouched when not profiling. } ===================================== compiler/GHC/Runtime/Debugger/Breakpoints.hs ===================================== @@ -16,7 +16,8 @@ import Data.Maybe import qualified Data.List.NonEmpty as NE import qualified Data.Semigroup as S -import GHC.ByteCode.Types (BreakIndex, ModBreaks(..)) +import GHC.HsToCore.Breakpoints +import GHC.ByteCode.Breakpoints import GHC.Driver.Env import GHC.Driver.Monad import GHC.Driver.Session.Inspect @@ -24,7 +25,6 @@ import GHC.Runtime.Eval import GHC.Runtime.Eval.Utils import GHC.Types.Name import GHC.Types.SrcLoc -import GHC.Types.Breakpoint import GHC.Unit.Module import GHC.Unit.Module.Graph import GHC.Unit.Module.ModSummary @@ -44,7 +44,7 @@ import qualified GHC.Data.Strict as Strict -- - the leftmost subexpression starting on the specified line, or -- - the rightmost subexpression enclosing the specified line -- -findBreakByLine :: Int {-^ Line number -} -> TickArray -> Maybe (BreakIndex, RealSrcSpan) +findBreakByLine :: Int {-^ Line number -} -> TickArray -> Maybe (BreakTickIndex, RealSrcSpan) findBreakByLine line arr | not (inRange (bounds arr) line) = Nothing | otherwise = @@ -61,7 +61,7 @@ findBreakByLine line arr where ends_here (_,pan) = srcSpanEndLine pan == line -- | Find a breakpoint in the 'TickArray' of a module, given a line number and a column coordinate. -findBreakByCoord :: (Int, Int) -> TickArray -> Maybe (BreakIndex, RealSrcSpan) +findBreakByCoord :: (Int, Int) -> TickArray -> Maybe (BreakTickIndex, RealSrcSpan) findBreakByCoord (line, col) arr | not (inRange (bounds arr) line) = Nothing | otherwise = @@ -174,7 +174,7 @@ resolveFunctionBreakpoint inp = do -- for -- (a) this binder only (it maybe a top-level or a nested declaration) -- (b) that do not have an enclosing breakpoint -findBreakForBind :: String {-^ Name of bind to break at -} -> ModBreaks -> [(BreakIndex, RealSrcSpan)] +findBreakForBind :: String {-^ Name of bind to break at -} -> ModBreaks -> [(BreakTickIndex, RealSrcSpan)] findBreakForBind str_name modbreaks = filter (not . enclosed) ticks where ticks = [ (index, span) @@ -191,15 +191,15 @@ findBreakForBind str_name modbreaks = filter (not . enclosed) ticks -------------------------------------------------------------------------------- -- | Maps line numbers to the breakpoint ticks existing at that line for a module. -type TickArray = Array Int [(BreakIndex,RealSrcSpan)] +type TickArray = Array Int [(BreakTickIndex,RealSrcSpan)] -- | Construct the 'TickArray' for the given module. makeModuleLineMap :: GhcMonad m => Module -> m (Maybe TickArray) makeModuleLineMap m = do mi <- getModuleInfo m - return $ mkTickArray . assocs . modBreaks_locs <$> (modInfoModBreaks =<< mi) + return $ mkTickArray . assocs . modBreaks_locs . imodBreaks_modBreaks <$> (modInfoModBreaks =<< mi) where - mkTickArray :: [(BreakIndex, SrcSpan)] -> TickArray + mkTickArray :: [(BreakTickIndex, SrcSpan)] -> TickArray mkTickArray ticks = accumArray (flip (:)) [] (1, max_line) [ (line, (nm,pan)) | (nm,RealSrcSpan pan _) <- ticks, line <- srcSpanLines pan ] @@ -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 $ modInfoModBreaks mod_info + pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info -------------------------------------------------------------------------------- -- Getting current breakpoint information ===================================== 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 @@ -111,7 +112,6 @@ import GHC.Types.Unique import GHC.Types.Unique.Supply import GHC.Types.Unique.DSet import GHC.Types.TyThing -import GHC.Types.Breakpoint import GHC.Types.Unique.Map import GHC.Types.Avail @@ -127,16 +127,16 @@ import GHC.Tc.Utils.Instantiate (instDFunType) import GHC.Tc.Utils.Monad import GHC.IfaceToCore +import GHC.ByteCode.Breakpoints import Control.Monad -import Data.Array import Data.Dynamic import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap import Data.List (find,intercalate) import Data.List.NonEmpty (NonEmpty) import Unsafe.Coerce ( unsafeCoerce ) import qualified GHC.Unit.Home.Graph as HUG +import GHCi.BreakArray (BreakArray) -- ----------------------------------------------------------------------------- -- running a statement interactively @@ -154,7 +154,7 @@ getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan getHistorySpan hug hist = do let ibi = historyBreakpointId hist brks <- readModBreaks hug (ibi_tick_mod ibi) - return $ modBreaks_locs brks ! ibi_tick_index ibi + return $ 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 @@ -163,7 +163,7 @@ getHistorySpan hug hist = do findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String] findEnclosingDecls hug ibi = do brks <- readModBreaks hug (ibi_tick_mod ibi) - return $ modBreaks_decls brks ! ibi_tick_index ibi + return $ getBreakDecls ibi brks -- | Update fixity environment in the current interactive context. updateFixityEnv :: GhcMonad m => FixityEnv -> m () @@ -350,13 +350,14 @@ handleRunStatus step expr bindings final_ids status history0 = do 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) + tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi) + breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks let - span = modBreaks_locs tick_brks ! ibi_tick_index ibi - decl = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi + span = getBreakLoc ibi tick_brks + decl = intercalate "." $ getBreakDecls ibi tick_brks -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)? - bactive <- liftIO $ breakpointStatus interp (modBreaks_flags tick_brks) (ibi_tick_index ibi) + bactive <- liftIO $ breakpointStatus interp breakArray (ibi_tick_index ibi) apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt @@ -464,9 +465,24 @@ setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #191 setupBreakpoint interp bi cnt = do hug <- hsc_HUG <$> getSession modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi) - let breakarray = modBreaks_flags modBreaks - _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt - pure () + breakArray <- getBreakArray interp bi modBreaks + liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt + +getBreakArray :: GhcMonad m => Interp -> BreakpointId -> InternalModBreaks -> m (ForeignRef BreakArray) +getBreakArray interp BreakpointId{bi_tick_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 bi_tick_mod + ) back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) back n = moveHist (+n) @@ -496,7 +512,7 @@ moveHist fn = do Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>") Just ibi -> liftIO $ do brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi) - return $ modBreaks_locs brks ! ibi_tick_index ibi + return $ getBreakLoc ibi brks (hsc_env1, names) <- liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info let ic = hsc_IC hsc_env1 @@ -559,9 +575,9 @@ 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 = expectJust $ IntMap.lookup (ibi_info_index ibi) (modBreaks_breakInfo info_brks) + let info = getInternalBreak ibi (info_brks) interp = hscInterp hsc_env - occs = modBreaks_vars tick_brks ! ibi_tick_index ibi + occs = getBreakVars ibi tick_brks -- Rehydrate to understand the breakpoint info relative to the current environment. -- This design is critical to preventing leaks (#22530) ===================================== compiler/GHC/Runtime/Eval/Types.hs ===================================== @@ -17,11 +17,11 @@ import GHC.Prelude import GHCi.RemoteTypes import GHCi.Message (EvalExpr, ResumeContext) +import GHC.ByteCode.Types (InternalBreakpointId(..)) import GHC.Driver.Config (EvalStep(..)) import GHC.Types.Id import GHC.Types.Name import GHC.Types.TyThing -import GHC.Types.Breakpoint import GHC.Types.Name.Reader import GHC.Types.SrcLoc import GHC.Utils.Exception @@ -176,7 +176,7 @@ data Resume = Resume , resumeApStack :: ForeignHValue -- The object from which we can get -- value of the free variables. , resumeBreakpointId :: Maybe InternalBreakpointId - -- ^ the breakpoint we stopped at + -- ^ the internal breakpoint we stopped at -- (Nothing <=> exception) , resumeSpan :: SrcSpan -- just a copy of the SrcSpan -- from the ModBreaks, ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -74,9 +74,9 @@ import GHCi.Message import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHCi.BreakArray (BreakArray) -import GHC.Types.Breakpoint -import GHC.ByteCode.Types +import GHC.ByteCode.Breakpoints +import GHC.ByteCode.Types import GHC.Linker.Types import GHC.Data.Maybe @@ -105,7 +105,6 @@ import Control.Monad.IO.Class import Control.Monad.Catch as MC (mask) import Data.Binary import Data.ByteString (ByteString) -import Data.Array ((!)) import Foreign hiding (void) import qualified GHC.Exts.Heap as Heap import GHC.Stack.CCS (CostCentre,CostCentreStack) @@ -451,7 +450,7 @@ handleSeqHValueStatus interp unit_env eval_status = -- Nothing case - should not occur! We should have the appropriate -- breakpoint information Nothing -> nothing_case - Just modbreaks -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! ibi_tick_index bi + Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks -- resume the seq (:force) processing in the iserv process withForeignRef resume_ctxt_fhv $ \hval -> do @@ -737,7 +736,7 @@ wormholeRef interp _r = case interpInstance interp of -- | Get the breakpoint information from the ByteCode object associated to this -- 'HomeModInfo'. -getModBreaks :: HomeModInfo -> Maybe ModBreaks +getModBreaks :: HomeModInfo -> Maybe InternalModBreaks getModBreaks hmi | Just linkable <- homeModInfoByteCode hmi, -- The linkable may have 'DotO's as well; only consider BCOs. See #20570. @@ -748,7 +747,7 @@ getModBreaks hmi -- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module' -- from the 'HomeUnitGraph'. -readModBreaks :: HomeUnitGraph -> Module -> IO ModBreaks +readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug -- ----------------------------------------------------------------------------- ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -34,7 +34,6 @@ import GHC.Platform.Profile import GHC.Runtime.Interpreter import GHCi.FFI import GHC.Types.Basic -import GHC.Types.Breakpoint import GHC.Utils.Outputable import GHC.Types.Name import GHC.Types.Id @@ -71,6 +70,7 @@ import GHC.Data.OrdList import GHC.Data.Maybe import GHC.Types.Tickish import GHC.Types.SptEntry +import GHC.ByteCode.Breakpoints import Data.List ( genericReplicate, intersperse , partition, scanl', sortBy, zip4, zip6 ) @@ -134,9 +134,9 @@ 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 modBreaks of + let mod_breaks = case mb_modBreaks of Nothing -> Nothing - Just mb -> Just mb{ modBreaks_breakInfo = breakInfo } + Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries -- Squash space leaks in the CompiledByteCode. This is really @@ -405,7 +405,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fv 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 + 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) @@ -416,12 +416,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fv 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) + let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox) return $ breakInstr `consOL` code schemeER_wrk d p rhs = schemeE d 0 p rhs @@ -455,7 +450,7 @@ break_info hsc_env mod current_mod current_mod_breaks = pure current_mod_breaks | otherwise = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case - Just hp -> pure $ getModBreaks hp + Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp Nothing -> pure Nothing getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)] @@ -2659,20 +2654,19 @@ typeArgReps platform = map (toArgRep platform) . typePrimRep -- | Read only environment for generating ByteCode data BcM_Env = BcM_Env - { bcm_hsc_env :: HscEnv - , bcm_module :: Module -- current module (for breakpoints) + { bcm_hsc_env :: !HscEnv + , bcm_module :: !Module -- current module (for breakpoints) + , modBreaks :: !(Maybe ModBreaks) } data BcM_State = BcM_State { nextlabel :: !Word32 -- ^ For generating local labels , breakInfoIdx :: !Int -- ^ Next index for breakInfo array - , modBreaks :: Maybe ModBreaks -- info about breakpoints - - , breakInfo :: IntMap CgBreakInfo -- ^ Info at breakpoint occurrence. - -- Indexed with breakpoint *info* index. - -- See Note [Breakpoint identifiers] - -- in GHC.Types.Breakpoint + , breakInfo :: !(IntMap CgBreakInfo) + -- ^ Info at breakpoints occurrences. Indexed with + -- 'InternalBreakpointId'. See Note [Breakpoint identifiers] in + -- GHC.ByteCode.Breakpoints. } newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (r, BcM_State)) @@ -2681,7 +2675,7 @@ newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (r, BcM_State)) runBc :: HscEnv -> Module -> Maybe ModBreaks -> BcM r -> IO (r, BcM_State) runBc hsc_env this_mod mbs (BcM m) - = m (BcM_Env hsc_env this_mod) (BcM_State 0 0 mbs IntMap.empty) + = m (BcM_Env hsc_env this_mod mbs) (BcM_State 0 0 IntMap.empty) instance HasDynFlags BcM where getDynFlags = hsc_dflags <$> getHscEnv @@ -2724,7 +2718,7 @@ getCurrentModule :: BcM Module getCurrentModule = BcM $ \env st -> return (bcm_module env, st) getCurrentModBreaks :: BcM (Maybe ModBreaks) -getCurrentModBreaks = BcM $ \_env st -> return (modBreaks st, st) +getCurrentModBreaks = BcM $ \env st -> return (modBreaks env, st) tickFS :: FastString tickFS = fsLit "ticked" ===================================== compiler/GHC/Types/Breakpoint.hs deleted ===================================== @@ -1,66 +0,0 @@ --- | Breakpoint related types -module GHC.Types.Breakpoint - ( BreakpointId (..) - , InternalBreakpointId (..) - , toBreakpointId - ) -where - -import GHC.Prelude -import GHC.Unit.Module -import GHC.Utils.Outputable -import Control.DeepSeq -import Data.Data (Data) - --- | Breakpoint identifier. --- --- See Note [Breakpoint identifiers] -data BreakpointId = BreakpointId - { bi_tick_mod :: !Module -- ^ Breakpoint tick module - , bi_tick_index :: !Int -- ^ Breakpoint tick index - } - deriving (Eq, Ord, Data) - --- | Internal breakpoint identifier --- --- 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 info module - , ibi_info_index :: !Int -- ^ Breakpoint info index - } - deriving (Eq, Ord) - -toBreakpointId :: InternalBreakpointId -> BreakpointId -toBreakpointId ibi = BreakpointId - { bi_tick_mod = ibi_tick_mod ibi - , bi_tick_index = ibi_tick_index ibi - } - - --- Note [Breakpoint identifiers] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- Before optimization a breakpoint is identified uniquely with a tick module --- and a tick index. See BreakpointId. A tick module contains an array, indexed --- with the tick indexes, which indicates breakpoint status. --- --- When we generate ByteCode, we collect information for every breakpoint at --- their *occurrence sites* (see CgBreakInfo in GHC.ByteCode.Types) and these info --- are stored in the ModIface of the occurrence module. Because of inlining, we --- can't reuse the tick index to uniquely identify an occurrence; because of --- cross-module inlining, we can't assume that the occurrence module is the same --- as the tick module (#24712). --- --- 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. - -instance Outputable BreakpointId where - ppr BreakpointId{bi_tick_mod, bi_tick_index} = - text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index - -instance NFData BreakpointId where - rnf BreakpointId{bi_tick_mod, bi_tick_index} = - rnf bi_tick_mod `seq` rnf bi_tick_index ===================================== compiler/GHC/Types/Tickish.hs ===================================== @@ -21,17 +21,20 @@ module GHC.Types.Tickish ( isProfTick, TickishPlacement(..), tickishPlace, - tickishContains + tickishContains, + + -- * Breakpoint tick identifiers + BreakpointId(..), BreakTickIndex ) where import GHC.Prelude import GHC.Data.FastString +import Control.DeepSeq import GHC.Core.Type import GHC.Unit.Module -import GHC.Types.Breakpoint import GHC.Types.CostCentre import GHC.Types.SrcLoc ( RealSrcSpan, containsSpan ) import GHC.Types.Var @@ -41,7 +44,7 @@ import GHC.Utils.Panic import Language.Haskell.Syntax.Extension ( NoExtField ) import Data.Data -import GHC.Utils.Outputable (Outputable (ppr), text) +import GHC.Utils.Outputable (Outputable (ppr), text, (<+>)) {- ********************************************************************* * * @@ -171,6 +174,35 @@ deriving instance Eq (GenTickish 'TickishPassCmm) deriving instance Ord (GenTickish 'TickishPassCmm) deriving instance Data (GenTickish 'TickishPassCmm) +-------------------------------------------------------------------------------- +-- Tick breakpoint index +-------------------------------------------------------------------------------- + +-- | Breakpoint tick index +-- newtype BreakTickIndex = BreakTickIndex Int +-- deriving (Eq, Ord, Data, Ix, NFData, Outputable) +type BreakTickIndex = Int + +-- | Breakpoint identifier. +-- +-- Indexes into the structures in the @'ModBreaks'@ created during desugaring +-- (after inserting the breakpoint ticks in the expressions). +-- See Note [Breakpoint identifiers] +data BreakpointId = BreakpointId + { bi_tick_mod :: !Module -- ^ Breakpoint tick module + , bi_tick_index :: !BreakTickIndex -- ^ Breakpoint tick index + } + deriving (Eq, Ord, Data) + +instance Outputable BreakpointId where + ppr BreakpointId{bi_tick_mod, bi_tick_index} = + text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index + +instance NFData BreakpointId where + rnf BreakpointId{bi_tick_mod, bi_tick_index} = + rnf bi_tick_mod `seq` rnf bi_tick_index + +-------------------------------------------------------------------------------- -- | A "counting tick" (where tickishCounts is True) is one that -- counts evaluations in some way. We cannot discard a counting tick, ===================================== compiler/GHC/Unit/Module/ModGuts.hs ===================================== @@ -7,7 +7,7 @@ where import GHC.Prelude -import GHC.ByteCode.Types +import GHC.HsToCore.Breakpoints import GHC.ForeignSrcLang import GHC.Hs ===================================== compiler/ghc.cabal.in ===================================== @@ -223,6 +223,7 @@ Library GHC.Builtin.Uniques GHC.Builtin.Utils GHC.ByteCode.Asm + GHC.ByteCode.Breakpoints GHC.ByteCode.InfoTable GHC.ByteCode.Instr GHC.ByteCode.Linker @@ -892,7 +893,6 @@ Library GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic - GHC.Types.Breakpoint GHC.Types.CompleteMatch GHC.Types.CostCentre GHC.Types.CostCentre.State ===================================== ghc/GHCi/UI.hs ===================================== @@ -45,6 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv) import GHC.Runtime.Eval.Utils -- The GHC interface +import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks) import GHC.Runtime.Interpreter import GHCi.RemoteTypes import GHCi.BreakArray( breakOn, breakOff ) @@ -66,7 +67,8 @@ import qualified GHC import GHC ( LoadHowMuch(..), Target(..), TargetId(..), Resume, SingleStep, Ghc, GetDocsFailure(..), pushLogHookM, - getModuleGraph, handleSourceError ) + getModuleGraph, handleSourceError, + InternalBreakpointId(..) ) import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation) import GHC.Hs.ImpExp import GHC.Hs @@ -78,7 +80,6 @@ import GHC.Core.TyCo.Ppr import GHC.Types.SafeHaskell ( getSafeMode ) import GHC.Types.SourceError ( SourceError ) import GHC.Types.Name -import GHC.Types.Breakpoint import GHC.Types.Var ( varType ) import GHC.Iface.Syntax ( showToHeader ) import GHC.Builtin.Names @@ -4473,7 +4474,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 modBreaks + findBreakAndSet mod $ \_ -> findBreakForBind fun_str (imodBreaks_modBreaks modBreaks) breakSyntax :: a breakSyntax = throwGhcException $ CmdLineError ("Syntax: :break [<mod>.]<func>[.<func>]\n" ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -5,6 +5,7 @@ GHC.Builtin.Types GHC.Builtin.Types.Literals GHC.Builtin.Types.Prim GHC.Builtin.Uniques +GHC.ByteCode.Breakpoints GHC.ByteCode.Types GHC.Cmm.BlockId GHC.Cmm.CLabel @@ -110,6 +111,8 @@ GHC.Hs.Pat GHC.Hs.Specificity GHC.Hs.Type GHC.Hs.Utils +GHC.HsToCore.Breakpoints +GHC.HsToCore.Ticks GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Flags @@ -150,7 +153,6 @@ GHC.Tc.Zonk.Monad GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic -GHC.Types.Breakpoint GHC.Types.CostCentre GHC.Types.CostCentre.State GHC.Types.Cpr ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -5,6 +5,7 @@ GHC.Builtin.Types GHC.Builtin.Types.Literals GHC.Builtin.Types.Prim GHC.Builtin.Uniques +GHC.ByteCode.Breakpoints GHC.ByteCode.Types GHC.Cmm.BlockId GHC.Cmm.CLabel @@ -114,8 +115,10 @@ GHC.Hs.Pat GHC.Hs.Specificity GHC.Hs.Type GHC.Hs.Utils +GHC.HsToCore.Breakpoints GHC.HsToCore.Errors.Types GHC.HsToCore.Pmc.Solver.Types +GHC.HsToCore.Ticks GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Flags @@ -171,7 +174,6 @@ GHC.Tc.Zonk.Monad GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic -GHC.Types.Breakpoint GHC.Types.CompleteMatch GHC.Types.CostCentre GHC.Types.CostCentre.State View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d52d4c315944254bc09cd1922262de... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d52d4c315944254bc09cd1922262de... You're receiving this email because of your account on gitlab.haskell.org.