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.
