Rodrigo Mesquita pushed to branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC Commits: 52490055 by Rodrigo Mesquita at 2025-07-03T16:18:11+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). - - - - - 10 changed files: - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Eval.hs - − compiler/GHC/Runtime/Interpreter.hs-boot - − compiler/GHC/Runtime/Interpreter/Types.hs-boot - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -58,15 +58,16 @@ linkBCO :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> NameEnv Int -> UnlinkedBCO -> IO ResolvedBCO -linkBCO interp pkgs_loaded le bco_ix +linkBCO interp pkgs_loaded le lb bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (elemsFlatBag lits0) - ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (elemsFlatBag ptrs0) + (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le lb) (elemsFlatBag lits0) + ptrs <- mapM (resolvePtr interp pkgs_loaded le lb bco_ix) (elemsFlatBag ptrs0) let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits return $ ResolvedBCO { resolvedBCOIsLE = isLittleEndian , resolvedBCOArity = arity @@ -76,8 +77,8 @@ linkBCO interp pkgs_loaded le bco_ix , resolvedBCOPtrs = addListToSS emptySS ptrs } -lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word -lookupLiteral interp pkgs_loaded le ptr = case ptr of +lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> LinkedBreaks -> BCONPtr -> IO Word +lookupLiteral interp pkgs_loaded le lb ptr = case ptr of BCONPtrWord lit -> return lit BCONPtrLbl sym -> do Ptr a# <- lookupStaticPtr interp sym @@ -99,7 +100,7 @@ lookupLiteral interp pkgs_loaded le ptr = case ptr of pure $ fromIntegral p BCONPtrCostCentre BreakpointId{..} | interpreterProfiled interp -> do - case expectJust (lookupModuleEnv (ccs_env le) bi_tick_mod) ! bi_tick_index of + case expectJust (lookupModuleEnv (ccs_env lb) bi_tick_mod) ! bi_tick_index of RemotePtr p -> pure $ fromIntegral p | otherwise -> case toRemotePtr nullPtr of @@ -158,10 +159,11 @@ resolvePtr :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> NameEnv Int -> BCOPtr -> IO ResolvedBCOPtr -resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of +resolvePtr interp pkgs_loaded le lb bco_ix ptr = case ptr of BCOPtrName nm | Just ix <- lookupNameEnv bco_ix nm -> return (ResolvedBCORef ix) -- ref to another BCO in this group @@ -182,10 +184,10 @@ resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of -> ResolvedBCOStaticPtr <$> lookupPrimOp interp pkgs_loaded op BCOPtrBCO bco - -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le bco_ix bco + -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le lb bco_ix bco BCOPtrBreakArray tick_mod -> - withForeignRef (expectJust (lookupModuleEnv (breakarray_env le) tick_mod)) $ + withForeignRef (expectJust (lookupModuleEnv (breakarray_env lb) tick_mod)) $ \ba -> pure $ ResolvedBCOPtrBreakArray ba -- | Look up the address of a Haskell symbol in the currently ===================================== 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 ===================================== @@ -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,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] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -177,13 +178,15 @@ emptyLoaderState = LoaderState { closure_env = emptyNameEnv , itbl_env = emptyNameEnv , addr_env = emptyNameEnv - , breakarray_env = emptyModuleEnv - , ccs_env = emptyModuleEnv } , pkgs_loaded = init_pkgs , bcos_loaded = emptyModuleEnv , objs_loaded = emptyModuleEnv , temp_sos = [] + , linked_breaks = LinkedBreaks + { breakarray_env = emptyModuleEnv + , ccs_env = emptyModuleEnv + } } -- Packages that don't need loading, because the compiler -- shares them with the interpreted program. @@ -694,28 +697,22 @@ loadDecls interp hsc_env span linkable = do else do -- Link the expression itself let le = linker_env pls + let lb = linked_breaks 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 lb) (catMaybes $ map bc_breaks cbcs) + le2_ccs_env <- allocateCCS interp (ccs_env lb) (catMaybes $ map bc_breaks cbcs) let le2 = le { itbl_env = le2_itbl_env - , addr_env = le2_addr_env - , breakarray_env = le2_breakarray_env + , addr_env = le2_addr_env } + let lb2 = lb { breakarray_env = le2_breakarray_env , ccs_env = le2_ccs_env } -- Link the necessary packages and linkables - new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs + new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 lb2 cbcs nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let ce2 = extendClosureEnv (closure_env le2) nms_fhvs - !pls2 = pls { linker_env = le2 { closure_env = ce2 } } + !pls2 = pls { linker_env = le2 { closure_env = ce2 } + , linked_breaks = lb2 } return (pls2, (nms_fhvs, links_needed, units_needed)) where cbcs = linkableBCOs linkable @@ -931,17 +928,15 @@ dynLinkBCOs interp pls bcos = do le1 = linker_env pls + lb1 = linked_breaks 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) - let le2 = le1 { itbl_env = ie2, addr_env = ae2, breakarray_env = be2, ccs_env = ce2 } + be2 <- allocateBreakArrays interp (breakarray_env lb1) (catMaybes $ map bc_breaks cbcs) + ce2 <- allocateCCS interp (ccs_env lb1) (catMaybes $ map bc_breaks cbcs) + let le2 = le1 { itbl_env = ie2, addr_env = ae2 } + let lb2 = lb1 { breakarray_env = be2, ccs_env = ce2 } - names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs + names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 lb2 cbcs -- We only want to add the external ones to the ClosureEnv let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs @@ -952,19 +947,21 @@ dynLinkBCOs interp pls bcos = do new_binds <- makeForeignNamedHValueRefs interp to_add let ce2 = extendClosureEnv (closure_env le2) new_binds - return $! pls1 { linker_env = le2 { closure_env = ce2 } } + return $! pls1 { linker_env = le2 { closure_env = ce2 } + , linked_breaks = lb2 } -- Link a bunch of BCOs and return references to their values linkSomeBCOs :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> [CompiledByteCode] -> IO [(Name,HValueRef)] -- The returned HValueRefs are associated 1-1 with -- the incoming unlinked BCOs. Each gives the -- value of the corresponding unlinked BCO -linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] +linkSomeBCOs interp pkgs_loaded le lb mods = foldr fun do_link mods [] where fun CompiledByteCode{..} inner accum = inner (Foldable.toList bc_bcos : accum) @@ -974,7 +971,7 @@ linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] let flat = [ bco | bcos <- mods, bco <- bcos ] names = map unlinkedBCOName flat bco_ix = mkNameEnv (zip names [0..]) - resolved <- sequence [ linkBCO interp pkgs_loaded le bco_ix bco | bco <- flat ] + resolved <- sequence [ linkBCO interp pkgs_loaded le lb bco_ix bco | bco <- flat ] hvrefs <- createBCOs interp resolved return (zip names hvrefs) @@ -1072,9 +1069,13 @@ unload_wkr interp keep_linkables pls@LoaderState{..} = do keep_name n = isExternalName n && nameModule n `elemModuleEnv` remaining_bcos_loaded - !new_pls = pls { linker_env = filterLinkerEnv keep_name linker_env, - bcos_loaded = remaining_bcos_loaded, - objs_loaded = remaining_objs_loaded } + keep_mod :: Module -> Bool + keep_mod m = m `elemModuleEnv` remaining_bcos_loaded + + !new_pls = pls { linker_env = filterLinkerEnv keep_name linker_env, + linked_breaks = filterLinkedBreaks keep_mod linked_breaks, + bcos_loaded = remaining_bcos_loaded, + objs_loaded = remaining_objs_loaded } return new_pls where @@ -1656,30 +1657,34 @@ 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 -> - [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 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 -> - [InternalModBreaks] -> ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) -> + [InternalModBreaks] -> IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) -allocateCCS interp mbs ce +allocateCCS interp ce mbss | interpreterProfiled interp = foldlM ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do @@ -1688,12 +1693,15 @@ allocateCCS interp mbs ce 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 ===================================== @@ -18,6 +18,8 @@ module GHC.Linker.Types , ClosureEnv , emptyClosureEnv , extendClosureEnv + , LinkedBreaks(..) + , filterLinkedBreaks , LinkableSet , mkLinkableSet , unionLinkableSet @@ -159,6 +161,9 @@ data LoaderState = LoaderState , temp_sos :: ![(FilePath, String)] -- ^ We need to remember the name of previous temporary DLL/.so -- libraries so we can link them (see #10322) + + , linked_breaks :: !LinkedBreaks + -- ^ Mapping from loaded modules to their breakpoint arrays } uninitializedLoader :: IO Loader @@ -184,20 +189,13 @@ data LinkerEnv = LinkerEnv , addr_env :: !AddrEnv -- ^ Like 'closure_env' and 'itbl_env', but for top-level 'Addr#' literals, -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode. - - , breakarray_env :: !(ModuleEnv (ForeignRef BreakArray)) - -- ^ Each 'Module's remote pointer of 'BreakArray'. - - , ccs_env :: !(ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) - -- ^ Each 'Module's array of remote pointers of 'CostCentre'. - -- Untouched when not profiling. } filterLinkerEnv :: (Name -> Bool) -> LinkerEnv -> LinkerEnv -filterLinkerEnv f le = le - { closure_env = filterNameEnv (f . fst) (closure_env le) - , itbl_env = filterNameEnv (f . fst) (itbl_env le) - , addr_env = filterNameEnv (f . fst) (addr_env le) +filterLinkerEnv f (LinkerEnv closure_e itbl_e addr_e) = LinkerEnv + { closure_env = filterNameEnv (f . fst) closure_e + , itbl_env = filterNameEnv (f . fst) itbl_e + , addr_env = filterNameEnv (f . fst) addr_e } type ClosureEnv = NameEnv (Name, ForeignHValue) @@ -209,6 +207,29 @@ extendClosureEnv :: ClosureEnv -> [(Name,ForeignHValue)] -> ClosureEnv extendClosureEnv cl_env pairs = extendNameEnvList cl_env [ (n, (n,v)) | (n,v) <- pairs] +-- | 'BreakArray's and CCSs are allocated per-module at link-time. +-- +-- Specifically, a module's 'BreakArray' is allocated either: +-- - When a BCO for that module is linked +-- - When :break is used on a given module *before* the BCO has been linked. +-- +-- We keep this structure in the 'LoaderState' +data LinkedBreaks + = LinkedBreaks + { breakarray_env :: !(ModuleEnv (ForeignRef BreakArray)) + -- ^ Each 'Module's remote pointer of 'BreakArray'. + + , ccs_env :: !(ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) + -- ^ Each 'Module's array of remote pointers of 'CostCentre'. + -- Untouched when not profiling. + } + +filterLinkedBreaks :: (Module -> Bool) -> LinkedBreaks -> LinkedBreaks +filterLinkedBreaks f (LinkedBreaks ba_e ccs_e) = LinkedBreaks + { breakarray_env = filterModuleEnv (\m _ -> f m) ba_e + , ccs_env = filterModuleEnv (\m _ -> f m) ccs_e + } + type PkgsLoaded = UniqDFM UnitId LoadedPkgInfo data LoadedPkgInfo ===================================== 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 (LinkedBreaks (..)) 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 @@ -348,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 = getBreakLoc ibi tick_brks decl = intercalate "." $ getBreakDecls ibi tick_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_tick_index ibi) apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt @@ -462,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 $ imodBreaks_modBreaks 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 lb = linked_breaks 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 lb) [imbs] + + return + ( ld_st { linked_breaks = lb{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) ===================================== 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 ===================================== 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/-/commit/52490055d8f05e61489ee2ef8b57899f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52490055d8f05e61489ee2ef8b57899f... You're receiving this email because of your account on gitlab.haskell.org.