Rodrigo Mesquita pushed to branch wip/romes/step-out-9 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). - - - - - 11 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Eval.hs - − compiler/GHC/Runtime/Interpreter.hs-boot - − compiler/GHC/Runtime/Interpreter/Types.hs-boot - compiler/GHC/StgToByteCode.hs Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -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 active] ===================================== 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 ===================================== @@ -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/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] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -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,30 +1645,31 @@ 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 + let count = numElements modBreaks_locs + breakArray <- GHCi.newBreakArray interp count + evaluate $ extendModuleEnv be0 modBreaks_module breakArray ) - 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 +1678,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/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 @@ -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_info_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 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) ===================================== 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 ===================================== @@ -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 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13ad4e54bd28fa7e31c6e3bcee26585... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13ad4e54bd28fa7e31c6e3bcee26585... You're receiving this email because of your account on gitlab.haskell.org.