[Git][ghc/ghc][wip/romes/step-out-11] Add InternalBreakLocs for code-generation time Brk locations
by Rodrigo Mesquita (＠alt-romes) 23 Jul '25
by Rodrigo Mesquita (＠alt-romes) 23 Jul '25
23 Jul '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC
Commits:
b4387c89 by Rodrigo Mesquita at 2025-07-23T18:41:27+01:00
Add InternalBreakLocs for code-generation time Brk locations
T26042d2 is a simple example displaying how this approach is not good
enough e.g. for do blocks because the cases continuations currently end
up not surrounded by a tick.
TODO: Figure out how to add BRK_FUNs to all case continuations where it
is relevant that we can step out to
TODO: Test step-out from a continuation which receives an unboxed tuple as an argument
- - - - -
11 changed files:
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- + testsuite/tests/ghci.debugger/scripts/T26042d2.hs
- + testsuite/tests/ghci.debugger/scripts/T26042d2.script
- + testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
Changes:
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DerivingStrategies #-}
-- | Breakpoint information constructed during ByteCode generation.
--
@@ -15,6 +16,7 @@ module GHC.ByteCode.Breakpoints
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
+ , InternalBreakLoc(..)
-- * Operations
@@ -23,7 +25,7 @@ module GHC.ByteCode.Breakpoints
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
- , getBreakSourceId
+ , getBreakSourceId, getBreakSourceMod
-- * Utils
, seqInternalModBreaks
@@ -165,7 +167,7 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
- , cgb_tick_id :: !BreakpointId
+ , cgb_tick_id :: !(Either InternalBreakLoc BreakpointId)
-- ^ This field records the original breakpoint tick identifier for this
-- internal breakpoint info. It is used to convert a breakpoint
-- *occurrence* index ('InternalBreakpointId') into a *definition* index
@@ -173,9 +175,19 @@ data CgBreakInfo
--
-- The modules of breakpoint occurrence and breakpoint definition are not
-- necessarily the same: See Note [Breakpoint identifiers].
+ --
+ -- If there is no original tick identifier (that is, the breakpoint was
+ -- created during code generation), instead refer directly to the SrcSpan
+ -- we want to use for it. See Note [Internal Breakpoint Locations]
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
+-- | Breakpoints created during code generation don't have a source-level tick
+-- location. Instead, we come up with one ourselves.
+-- See Note [Internal Breakpoint Locations]
+newtype InternalBreakLoc = InternalBreakLoc SrcSpan
+ deriving newtype (Eq, Show, NFData, Outputable)
+
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak (InternalBreakpointId mod ix) imbs =
@@ -196,27 +208,36 @@ assert_modules_match ibi_mod imbs_mod =
-- | Get the source module and tick index for this breakpoint
-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
-getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
+getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> Either InternalBreakLoc BreakpointId
getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
assert_modules_match ibi_mod (imodBreaks_module imbs) $
let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
in cgb_tick_id cgb
+-- | Get the source module for this breakpoint (where the breakpoint is defined)
+getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module
+getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in case cgb_tick_id cgb of
+ Left InternalBreakLoc{} -> imodBreaks_module imbs
+ Right BreakpointId{bi_tick_mod} -> bi_tick_mod
+
-- | Get the source span for this breakpoint
getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
-getBreakLoc = getBreakXXX modBreaks_locs
+getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
-- | Get the vars for this breakpoint
getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
-getBreakVars = getBreakXXX modBreaks_vars
+getBreakVars = getBreakXXX modBreaks_vars (const [])
-- | Get the decls for this breakpoint
getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
-getBreakDecls = getBreakXXX modBreaks_decls
+getBreakDecls = getBreakXXX modBreaks_decls (const [])
-- | Get the decls for this breakpoint
-getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
-getBreakCCS = getBreakXXX modBreaks_ccs
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
+getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
--
@@ -228,14 +249,17 @@ getBreakCCS = getBreakXXX modBreaks_ccs
-- 'ModBreaks'. When the tick module is different, we need to look up the
-- 'ModBreaks' in the HUG for that other module.
--
+-- When there is no tick module (the breakpoint was generated at codegen), use
+-- the function on internal mod breaks.
+--
-- To avoid cyclic dependencies, we instead receive a function that looks up
-- the 'ModBreaks' given a 'Module'
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
-getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view viewInternal lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
case cgb_tick_id cgb of
- BreakpointId{bi_tick_mod, bi_tick_index}
+ Right BreakpointId{bi_tick_mod, bi_tick_index}
| bi_tick_mod == ibi_mod
-> do
let these_mbs = imodBreaks_modBreaks imbs
@@ -244,6 +268,8 @@ getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
-> do
other_mbs <- lookupModule bi_tick_mod
return $ view other_mbs ! bi_tick_index
+ Left l ->
+ return $ viewInternal l
--------------------------------------------------------------------------------
-- Instances
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -58,6 +58,7 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message (ConInfoTable(..), LoadedDLL)
+import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
import GHC.ByteCode.Asm
import GHC.ByteCode.Types
@@ -1711,8 +1712,10 @@ allocateCCS interp ce mbss
let count = 1 + (maybe 0 fst $ IM.lookupMax imodBreaks_breakInfo)
let ccs = IM.map
(\info ->
- fromMaybe (toRemotePtr nullPtr)
- (M.lookup (cgb_tick_id info) ccss)
+ case cgb_tick_id info of
+ Right bi -> fromMaybe (toRemotePtr nullPtr)
+ (M.lookup bi ccss)
+ Left InternalBreakLoc{} -> toRemotePtr nullPtr
)
imodBreaks_breakInfo
assertPpr (count == length ccs)
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -253,8 +253,11 @@ mkBreakpointOccurrences = do
let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
IntMap.foldrWithKey (\info_ix cgi bmp -> do
let ibi = InternalBreakpointId imod info_ix
- let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
- extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ case cgb_tick_id cgi of
+ Right (BreakpointId tick_mod tick_ix)
+ -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ Left _
+ -> bmp
) bmp0 (imodBreaks_breakInfo ibrks)
--------------------------------------------------------------------------------
@@ -287,7 +290,7 @@ getCurrentBreakModule = do
Nothing -> pure Nothing
Just ibi -> do
brks <- readIModBreaks hug ibi
- return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ Just $ getBreakSourceMod ibi brks
ix ->
Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -151,7 +151,7 @@ getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
getHistoryModule hug hist = do
let ibi = historyBreakpointId hist
brks <- readIModBreaks hug ibi
- return $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ getBreakSourceMod ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -63,7 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
assertNonVoidIds, assertNonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
-import GHC.Runtime.Interpreter ( interpreterProfiled )
+import GHC.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -99,6 +99,7 @@ import GHC.CoreToIface
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
+import Data.Array ((!))
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -393,26 +394,30 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
- code <- schemeE d 0 p rhs
- mb_current_mod_breaks <- getCurrentModBreaks
- case mb_current_mod_breaks of
- -- if we're not generating ModBreaks for this module for some reason, we
- -- can't store breakpoint occurrence information.
- Nothing -> pure code
- Just current_mod_breaks -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
-
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
+ platform <- profilePlatform <$> getProfile
+
+ code <- case rhs of
+ -- When we find a tick surrounding a case expression we introduce a new BRK_FUN
+ -- instruction at the start of the case *continuation*, in addition to the
+ -- usual BRK_FUN surrounding the StgCase)
+ -- See Note [TODO]
+ StgCase scrut bndr _ alts
+ -> doCase d 0 p (Just bp) scrut bndr alts
+ _ -> schemeE d 0 p rhs
+
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Right tick_id)
+
+ mibi <- newBreakInfo breakInfo
+
+ return $ case mibi of
+ Nothing -> code
+ Just ibi -> BRK_FUN ibi `consOL` code
- let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
- return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
@@ -614,7 +619,7 @@ schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut
schemeE d s p (StgCase scrut bndr _ alts)
- = doCase d s p scrut bndr alts
+ = doCase d s p Nothing scrut bndr alts
{-
@@ -1106,11 +1111,15 @@ doCase
:: StackDepth
-> Sequel
-> BCEnv
+ -> Maybe StgTickish
+ -- ^ The breakpoint surrounding the full case expression, if any (only
+ -- source-level cases get breakpoint ticks, and those are the only we care
+ -- about). See Note [TODO]
-> CgStgExpr
-> Id
-> [CgStgAlt]
-> BcM BCInstrList
-doCase d s p scrut bndr alts
+doCase d s p m_bid scrut bndr alts
= do
profile <- getProfile
hsc_env <- getHscEnv
@@ -1325,19 +1334,35 @@ doCase d s p scrut bndr alts
| ubx_tuple_frame = SLIDE 0 3 `consOL` alt_final1
| otherwise = SLIDE 0 1 `consOL` alt_final1
- -- when `BRK_FUN` in a case continuation BCO executes,
- -- the stack will already have a full continuation that just
- -- re-executes the BCO being stopped at (including the stg_ret and
- -- stg_ctoi frames)
- --
- -- right after the `BRK_FUN`, all case continuations will drop the
- -- stg_ret and stg_ctoi headers (see alt_final1, alt_final2), leaving
- -- the stack with the bound return values followed by the free variables
- alt_final
- | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
- -- See Note [Debugger: BRK_ALTS]
- = BRK_ALTS False `consOL` alt_final2
- | otherwise = alt_final2
+ -- when `BRK_FUN` in a case continuation BCO executes,
+ -- the stack will already have a full continuation that just
+ -- re-executes the BCO being stopped at (including the stg_ret and
+ -- stg_ctoi frames)
+ --
+ -- right after the `BRK_FUN`, all case continuations will drop the
+ -- stg_ret and stg_ctoi headers (see alt_final1, alt_final2), leaving
+ -- the stack with the bound return values followed by the free variables
+ alt_final <- case m_bid of
+ Just (Breakpoint tick_ty tick_id fvs)
+ | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
+ -- Construct an internal breakpoint to put at the start of this case
+ -- continuation BCO.
+ -- See Note [TODO]
+ -> do
+ internal_tick_loc <- makeCaseInternalBreakLoc tick_id
+
+ -- same fvs available in the case expression are available in the case continuation
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Left internal_tick_loc)
+
+ mibi <- newBreakInfo breakInfo
+ return $ case mibi of
+ Nothing -> alt_final2
+ Just ibi -> BRK_FUN ibi `consOL` alt_final2
+ _ -> pure alt_final2
add_bco_name <- shouldAddBcoName
let
@@ -1357,6 +1382,24 @@ doCase d s p scrut bndr alts
_ -> panic "schemeE(StgCase).push_alts"
in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
+makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
+makeCaseInternalBreakLoc bid = do
+ hug <- hsc_HUG <$> getHscEnv
+ curr_mod <- getCurrentModule
+ mb_mod_brks <- getCurrentModBreaks
+
+ -- TODO: Subtract the scrutinee loc from the case loc to get continuation loc
+ InternalBreakLoc <$> case bid of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == curr_mod
+ , Just these_mbs <- mb_mod_brks
+ -> do
+ return $ modBreaks_locs these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod
+ return $ modBreaks_locs other_mbs ! bi_tick_index
+
{-
Note [Debugger: BRK_ALTS]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2677,14 +2720,19 @@ getLabelsBc n = BcM $ \_ st ->
let ctr = nextlabel st
in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
-newBreakInfo :: CgBreakInfo -> BcM Int
-newBreakInfo info = BcM $ \_ st ->
- let ix = breakInfoIdx st
- st' = st
- { breakInfo = IntMap.insert ix info (breakInfo st)
- , breakInfoIdx = ix + 1
- }
- in return (ix, st')
+newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
+newBreakInfo info = BcM $ \env st -> do
+ -- if we're not generating ModBreaks for this module for some reason, we
+ -- can't store breakpoint occurrence information.
+ case modBreaks env of
+ Nothing -> pure (Nothing, st)
+ Just modBreaks -> do
+ let ix = breakInfoIdx st
+ st' = st
+ { breakInfo = IntMap.insert ix info (breakInfo st)
+ , breakInfoIdx = ix + 1
+ }
+ return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
getCurrentModule :: BcM Module
getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
@@ -2697,7 +2745,7 @@ tickFS = fsLit "ticked"
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
import GHC.Runtime.Eval.Utils
-- The GHC interface
-import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId, getBreakSourceMod)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -1621,7 +1621,7 @@ toBreakIdAndLocation (Just inf) = do
brks <- liftIO $ readIModBreaks hug inf
let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakId loc == bi ]
+ Right (breakId loc) == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
@@ -3825,7 +3825,7 @@ pprStopped res = do
hug <- hsc_HUG <$> GHC.getSession
brks <- liftIO $ readIModBreaks hug ibi
return $ Just $ moduleName $
- bi_tick_mod $ getBreakSourceId ibi brks
+ getBreakSourceMod ibi brks
return $
text "Stopped in"
<+> ((case mb_mod_name of
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.hs
=====================================
@@ -0,0 +1,13 @@
+
+module Main where
+
+main = do
+ putStrLn "hello1"
+ f
+ putStrLn "hello3"
+ putStrLn "hello4"
+
+f = do
+ putStrLn "hello2.1"
+ putStrLn "hello2.2"
+{-# NOINLINE f #-}
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.script
=====================================
@@ -0,0 +1,12 @@
+:load T26042d2.hs
+
+:break 11
+main
+:list
+:stepout
+:list
+:stepout
+
+-- should exit! we compile this test case with -O1 to make sure the monad >> are inlined
+-- and thus the test relies on the filtering behavior based on SrcSpans for stepout
+
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
=====================================
@@ -0,0 +1,16 @@
+Breakpoint 0 activated at T26042d2.hs:11:3-21
+hello1
+Stopped in Main.f, T26042d2.hs:11:3-21
+_result ::
+ GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
+ -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
+ () #) = _
+10 f = do
+11 putStrLn "hello2.1"
+ ^^^^^^^^^^^^^^^^^^^
+12 putStrLn "hello2.2"
+hello2.1
+hello2.2
+<--- should break here too
+hello3
+hello4
=====================================
testsuite/tests/ghci.debugger/scripts/T26042g.stdout
=====================================
@@ -6,10 +6,13 @@ x :: Int = 14
11 succ x = (-) (x - 2) (x + 1)
^^^^^^^^^^^^^^^^^^^
12
-Stopped in T9.top, T26042g.hs:8:10-21
+Stopped in T9., T26042g.hs:(6,3)-(8,21)
_result :: Int = _
+5 top = do
+ vv
+6 case succ 14 of
7 5 -> 5
8 _ -> 6 + other 55
- ^^^^^^^^^^^^
+ ^^
9
171
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -147,8 +147,9 @@ test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script'])
# Step out tests
test('T26042b', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042b.hs'])], ghci_script, ['T26042b.script'])
-test('T26042c', [expect_broken(26042),extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
+test('T26042c', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
test('T26042d', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d.hs'])], ghci_script, ['T26042d.script'])
+test('T26042d2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d2.hs'])], ghci_script, ['T26042d2.script'])
test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop
test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042f.hs', 'T26042f.script'])], ghci_script, ['T26042f.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4387c89b6042a9ce2f52483c6a984f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4387c89b6042a9ce2f52483c6a984f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-11] 3 commits: Makes sure run_BCO has variables directly on top of the stack
by Rodrigo Mesquita (＠alt-romes) 23 Jul '25
by Rodrigo Mesquita (＠alt-romes) 23 Jul '25
23 Jul '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC
Commits:
1362987b by Rodrigo Mesquita at 2025-07-23T18:39:34+01:00
Makes sure run_BCO has variables directly on top of the stack
Instead we kept ctoi_ret frames when entering run_BCO, and the ByteCode
generator accounted for the frame header and then slided it off.
Now, when run_BCO is called for a case continuation, the return value
and free variables are directly on top.
Making stg_ret_*_ stay at the start of the BCO
Actually, do add the ctoi frame header but remove it with static slides always in case conts
- - - - -
3ada6aa5 by Rodrigo Mesquita at 2025-07-23T18:40:19+01:00
Allow BRK_FUNs to head case continuation BCOs
- - - - -
cd1393d0 by Rodrigo Mesquita at 2025-07-23T18:40:20+01:00
Add InternalBreakLocs for code-generation time Brk locations
TODO: Test step-out from a continuation which receives an unboxed tuple as an argument
- - - - -
13 changed files:
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Run.hs
- rts/Interpreter.c
- + testsuite/tests/ghci.debugger/scripts/T26042d2.hs
- + testsuite/tests/ghci.debugger/scripts/T26042d2.script
- + testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
Changes:
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DerivingStrategies #-}
-- | Breakpoint information constructed during ByteCode generation.
--
@@ -15,6 +16,7 @@ module GHC.ByteCode.Breakpoints
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
+ , InternalBreakLoc(..)
-- * Operations
@@ -23,7 +25,7 @@ module GHC.ByteCode.Breakpoints
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
- , getBreakSourceId
+ , getBreakSourceId, getBreakSourceMod
-- * Utils
, seqInternalModBreaks
@@ -165,7 +167,7 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
- , cgb_tick_id :: !BreakpointId
+ , cgb_tick_id :: !(Either InternalBreakLoc BreakpointId)
-- ^ This field records the original breakpoint tick identifier for this
-- internal breakpoint info. It is used to convert a breakpoint
-- *occurrence* index ('InternalBreakpointId') into a *definition* index
@@ -173,9 +175,19 @@ data CgBreakInfo
--
-- The modules of breakpoint occurrence and breakpoint definition are not
-- necessarily the same: See Note [Breakpoint identifiers].
+ --
+ -- If there is no original tick identifier (that is, the breakpoint was
+ -- created during code generation), instead refer directly to the SrcSpan
+ -- we want to use for it. See Note [Internal Breakpoint Locations]
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
+-- | Breakpoints created during code generation don't have a source-level tick
+-- location. Instead, we come up with one ourselves.
+-- See Note [Internal Breakpoint Locations]
+newtype InternalBreakLoc = InternalBreakLoc SrcSpan
+ deriving newtype (Eq, Show, NFData, Outputable)
+
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak (InternalBreakpointId mod ix) imbs =
@@ -196,27 +208,36 @@ assert_modules_match ibi_mod imbs_mod =
-- | Get the source module and tick index for this breakpoint
-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
-getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
+getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> Either InternalBreakLoc BreakpointId
getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
assert_modules_match ibi_mod (imodBreaks_module imbs) $
let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
in cgb_tick_id cgb
+-- | Get the source module for this breakpoint (where the breakpoint is defined)
+getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module
+getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in case cgb_tick_id cgb of
+ Left InternalBreakLoc{} -> imodBreaks_module imbs
+ Right BreakpointId{bi_tick_mod} -> bi_tick_mod
+
-- | Get the source span for this breakpoint
getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
-getBreakLoc = getBreakXXX modBreaks_locs
+getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
-- | Get the vars for this breakpoint
getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
-getBreakVars = getBreakXXX modBreaks_vars
+getBreakVars = getBreakXXX modBreaks_vars (const [])
-- | Get the decls for this breakpoint
getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
-getBreakDecls = getBreakXXX modBreaks_decls
+getBreakDecls = getBreakXXX modBreaks_decls (const [])
-- | Get the decls for this breakpoint
-getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
-getBreakCCS = getBreakXXX modBreaks_ccs
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
+getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
--
@@ -228,14 +249,17 @@ getBreakCCS = getBreakXXX modBreaks_ccs
-- 'ModBreaks'. When the tick module is different, we need to look up the
-- 'ModBreaks' in the HUG for that other module.
--
+-- When there is no tick module (the breakpoint was generated at codegen), use
+-- the function on internal mod breaks.
+--
-- To avoid cyclic dependencies, we instead receive a function that looks up
-- the 'ModBreaks' given a 'Module'
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
-getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view viewInternal lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
case cgb_tick_id cgb of
- BreakpointId{bi_tick_mod, bi_tick_index}
+ Right BreakpointId{bi_tick_mod, bi_tick_index}
| bi_tick_mod == ibi_mod
-> do
let these_mbs = imodBreaks_modBreaks imbs
@@ -244,6 +268,8 @@ getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
-> do
other_mbs <- lookupModule bi_tick_mod
return $ view other_mbs ! bi_tick_index
+ Left l ->
+ return $ viewInternal l
--------------------------------------------------------------------------------
-- Instances
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -58,6 +58,7 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message (ConInfoTable(..), LoadedDLL)
+import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
import GHC.ByteCode.Asm
import GHC.ByteCode.Types
@@ -1711,8 +1712,10 @@ allocateCCS interp ce mbss
let count = 1 + (maybe 0 fst $ IM.lookupMax imodBreaks_breakInfo)
let ccs = IM.map
(\info ->
- fromMaybe (toRemotePtr nullPtr)
- (M.lookup (cgb_tick_id info) ccss)
+ case cgb_tick_id info of
+ Right bi -> fromMaybe (toRemotePtr nullPtr)
+ (M.lookup bi ccss)
+ Left InternalBreakLoc{} -> toRemotePtr nullPtr
)
imodBreaks_breakInfo
assertPpr (count == length ccs)
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -253,8 +253,11 @@ mkBreakpointOccurrences = do
let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
IntMap.foldrWithKey (\info_ix cgi bmp -> do
let ibi = InternalBreakpointId imod info_ix
- let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
- extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ case cgb_tick_id cgi of
+ Right (BreakpointId tick_mod tick_ix)
+ -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ Left _
+ -> bmp
) bmp0 (imodBreaks_breakInfo ibrks)
--------------------------------------------------------------------------------
@@ -287,7 +290,7 @@ getCurrentBreakModule = do
Nothing -> pure Nothing
Just ibi -> do
brks <- readIModBreaks hug ibi
- return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ Just $ getBreakSourceMod ibi brks
ix ->
Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -151,7 +151,7 @@ getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
getHistoryModule hug hist = do
let ibi = historyBreakpointId hist
brks <- readIModBreaks hug ibi
- return $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ getBreakSourceMod ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -63,7 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
assertNonVoidIds, assertNonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
-import GHC.Runtime.Interpreter ( interpreterProfiled )
+import GHC.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -99,6 +99,7 @@ import GHC.CoreToIface
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
+import Data.Array ((!))
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -393,26 +394,30 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
- code <- schemeE d 0 p rhs
- mb_current_mod_breaks <- getCurrentModBreaks
- case mb_current_mod_breaks of
- -- if we're not generating ModBreaks for this module for some reason, we
- -- can't store breakpoint occurrence information.
- Nothing -> pure code
- Just current_mod_breaks -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
-
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
+ platform <- profilePlatform <$> getProfile
+
+ code <- case rhs of
+ -- When we find a tick surrounding a case expression we introduce a new BRK_FUN
+ -- instruction at the start of the case *continuation*, in addition to the
+ -- usual BRK_FUN surrounding the StgCase)
+ -- See Note [TODO]
+ StgCase scrut bndr _ alts
+ -> doCase d 0 p (Just bp) scrut bndr alts
+ _ -> schemeE d 0 p rhs
+
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Right tick_id)
+
+ mibi <- newBreakInfo breakInfo
+
+ return $ case mibi of
+ Nothing -> code
+ Just ibi -> BRK_FUN ibi `consOL` code
- let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
- return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
@@ -614,7 +619,7 @@ schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut
schemeE d s p (StgCase scrut bndr _ alts)
- = doCase d s p scrut bndr alts
+ = doCase d s p Nothing scrut bndr alts
{-
@@ -1106,11 +1111,15 @@ doCase
:: StackDepth
-> Sequel
-> BCEnv
+ -> Maybe StgTickish
+ -- ^ The breakpoint surrounding the full case expression, if any (only
+ -- source-level cases get breakpoint ticks, and those are the only we care
+ -- about). See Note [TODO]
-> CgStgExpr
-> Id
-> [CgStgAlt]
-> BcM BCInstrList
-doCase d s p scrut bndr alts
+doCase d s p m_bid scrut bndr alts
= do
profile <- getProfile
hsc_env <- getHscEnv
@@ -1140,43 +1149,34 @@ doCase d s p scrut bndr alts
-- When an alt is entered, it assumes the returned value is
-- on top of the itbl; see Note [Return convention for non-tuple values]
-- for details.
- ret_frame_size_b :: StackDepth
- ret_frame_size_b | ubx_tuple_frame =
- (if profiling then 5 else 4) * wordSize platform
- | otherwise = 2 * wordSize platform
+ ret_frame_size_w :: WordOff
+ ret_frame_size_w | ubx_tuple_frame =
+ if profiling then 5 else 4
+ | otherwise = 2
-- The stack space used to save/restore the CCCS when profiling
save_ccs_size_b | profiling &&
not ubx_tuple_frame = 2 * wordSize platform
| otherwise = 0
- -- The size of the return frame info table pointer if one exists
- unlifted_itbl_size_b :: StackDepth
- unlifted_itbl_size_b | ubx_tuple_frame = wordSize platform
- | otherwise = 0
-
(bndr_size, call_info, args_offsets)
| ubx_tuple_frame =
let bndr_reps = typePrimRep (idType bndr)
(call_info, args_offsets) =
layoutNativeCall profile NativeTupleReturn 0 id bndr_reps
- in ( wordsToBytes platform (nativeCallSize call_info)
+ in ( nativeCallSize call_info
, call_info
, args_offsets
)
- | otherwise = ( wordsToBytes platform (idSizeW platform bndr)
+ | otherwise = ( idSizeW platform bndr
, voidTupleReturnInfo
, []
)
- -- depth of stack after the return value has been pushed
+ -- Depth of stack after the return value has been pushed
+ -- This is the stack depth at the continuation.
d_bndr =
- d + ret_frame_size_b + bndr_size
-
- -- depth of stack after the extra info table for an unlifted return
- -- has been pushed, if any. This is the stack depth at the
- -- continuation.
- d_alts = d + ret_frame_size_b + bndr_size + unlifted_itbl_size_b
+ d + wordsToBytes platform bndr_size
-- Env in which to compile the alts, not including
-- any vars bound by the alts themselves
@@ -1188,13 +1188,13 @@ doCase d s p scrut bndr alts
-- given an alt, return a discr and code for it.
codeAlt :: CgStgAlt -> BcM (Discr, BCInstrList)
codeAlt GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=rhs}
- = do rhs_code <- schemeE d_alts s p_alts rhs
+ = do rhs_code <- schemeE d_bndr s p_alts rhs
return (NoDiscr, rhs_code)
codeAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs}
-- primitive or nullary constructor alt: no need to UNPACK
| null real_bndrs = do
- rhs_code <- schemeE d_alts s p_alts rhs
+ rhs_code <- schemeE d_bndr s p_alts rhs
return (my_discr alt, rhs_code)
| isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
let bndr_ty = idPrimRepU . fromNonVoid
@@ -1206,7 +1206,7 @@ doCase d s p scrut bndr alts
bndr_ty
(assertNonVoidIds bndrs)
- stack_bot = d_alts
+ stack_bot = d_bndr
p' = Map.insertList
[ (arg, tuple_start -
@@ -1224,7 +1224,7 @@ doCase d s p scrut bndr alts
(addIdReps (assertNonVoidIds real_bndrs))
size = WordOff tot_wds
- stack_bot = d_alts + wordsToBytes platform size
+ stack_bot = d_bndr + wordsToBytes platform size
-- convert offsets from Sp into offsets into the virtual stack
p' = Map.insertList
@@ -1324,22 +1324,53 @@ doCase d s p scrut bndr alts
alt_stuff <- mapM codeAlt alts
alt_final0 <- mkMultiBranch maybe_ncons alt_stuff
- let alt_final1
- | ubx_tuple_frame = SLIDE 0 2 `consOL` alt_final0
- | otherwise = alt_final0
- alt_final
- | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
- -- See Note [Debugger: BRK_ALTS]
- = BRK_ALTS False `consOL` alt_final1
- | otherwise = alt_final1
+ let
+
+ -- drop the stg_ctoi_*_info header...
+ alt_final1 = SLIDE bndr_size ret_frame_size_w `consOL` alt_final0
+
+ -- after dropping the stg_ret_*_info header
+ alt_final2
+ | ubx_tuple_frame = SLIDE 0 3 `consOL` alt_final1
+ | otherwise = SLIDE 0 1 `consOL` alt_final1
+
+ -- when `BRK_FUN` in a case continuation BCO executes,
+ -- the stack will already have a full continuation that just
+ -- re-executes the BCO being stopped at (including the stg_ret and
+ -- stg_ctoi frames)
+ --
+ -- right after the `BRK_FUN`, all case continuations will drop the
+ -- stg_ret and stg_ctoi headers (see alt_final1, alt_final2), leaving
+ -- the stack with the bound return values followed by the free variables
+ alt_final <- case m_bid of
+ Just (Breakpoint tick_ty tick_id fvs)
+ | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
+ -- Construct an internal breakpoint to put at the start of this case
+ -- continuation BCO.
+ -- See Note [TODO]
+ -> do
+ internal_tick_loc <- makeCaseInternalBreakLoc tick_id
+
+ -- same fvs available in the case expression are available in the case continuation
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Left internal_tick_loc)
+
+ mibi <- newBreakInfo breakInfo
+ return $ case mibi of
+ Nothing -> alt_final2
+ Just ibi -> BRK_FUN ibi `consOL` alt_final2
+ _ -> pure alt_final2
add_bco_name <- shouldAddBcoName
let
alt_bco_name = getName bndr
alt_bco = mkProtoBCO platform add_bco_name alt_bco_name alt_final (Left alts)
0{-no arity-} bitmap_size bitmap True{-is alts-}
- scrut_code <- schemeE (d + ret_frame_size_b + save_ccs_size_b)
- (d + ret_frame_size_b + save_ccs_size_b)
+ scrut_code <- schemeE (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
+ (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
p scrut
if ubx_tuple_frame
then do let tuple_bco = tupleBCO platform call_info args_offsets
@@ -1351,6 +1382,24 @@ doCase d s p scrut bndr alts
_ -> panic "schemeE(StgCase).push_alts"
in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
+makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
+makeCaseInternalBreakLoc bid = do
+ hug <- hsc_HUG <$> getHscEnv
+ curr_mod <- getCurrentModule
+ mb_mod_brks <- getCurrentModBreaks
+
+ -- TODO: Subtract the scrutinee loc from the case loc to get continuation loc
+ InternalBreakLoc <$> case bid of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == curr_mod
+ , Just these_mbs <- mb_mod_brks
+ -> do
+ return $ modBreaks_locs these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod
+ return $ modBreaks_locs other_mbs ! bi_tick_index
+
{-
Note [Debugger: BRK_ALTS]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1718,6 +1767,10 @@ tupleBCO platform args_info args =
with using a fake name here. We will need to change this if we want
to save some memory by sharing the BCO between places that have
the same tuple shape
+
+ ROMES:TODO: This seems like it would have a pretty good impact.
+ Looking at examples like UnboxedTuple.hs shows many occurrences of the
+ same tuple_BCO
-}
invented_name = mkSystemVarName (mkPseudoUniqueE 0) (fsLit "tuple")
@@ -2667,14 +2720,19 @@ getLabelsBc n = BcM $ \_ st ->
let ctr = nextlabel st
in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
-newBreakInfo :: CgBreakInfo -> BcM Int
-newBreakInfo info = BcM $ \_ st ->
- let ix = breakInfoIdx st
- st' = st
- { breakInfo = IntMap.insert ix info (breakInfo st)
- , breakInfoIdx = ix + 1
- }
- in return (ix, st')
+newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
+newBreakInfo info = BcM $ \env st -> do
+ -- if we're not generating ModBreaks for this module for some reason, we
+ -- can't store breakpoint occurrence information.
+ case modBreaks env of
+ Nothing -> pure (Nothing, st)
+ Just modBreaks -> do
+ let ix = breakInfoIdx st
+ st' = st
+ { breakInfo = IntMap.insert ix info (breakInfo st)
+ , breakInfoIdx = ix + 1
+ }
+ return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
getCurrentModule :: BcM Module
getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
@@ -2687,7 +2745,7 @@ tickFS = fsLit "ticked"
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
import GHC.Runtime.Eval.Utils
-- The GHC interface
-import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId, getBreakSourceMod)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -1621,7 +1621,7 @@ toBreakIdAndLocation (Just inf) = do
brks <- liftIO $ readIModBreaks hug inf
let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakId loc == bi ]
+ Right (breakId loc) == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
@@ -3825,7 +3825,7 @@ pprStopped res = do
hug <- hsc_HUG <$> GHC.getSession
brks <- liftIO $ readIModBreaks hug ibi
return $ Just $ moduleName $
- bi_tick_mod $ getBreakSourceId ibi brks
+ getBreakSourceMod ibi brks
return $
text "Stopped in"
<+> ((case mb_mod_name of
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -362,6 +362,14 @@ withBreakAction opts breakMVar statusMVar mtid act
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
+
+ -- Block until this thread is resumed (by the thread which took the
+ -- `ResumeContext` from the `statusMVar`).
+ --
+ -- The `onBreak` function must have been called from `rts/Interpreter.c`
+ -- when interpreting a `BRK_FUN`. After taking from the MVar, the function
+ -- returns to the continuation on the stack which is where the interpreter
+ -- was stopped.
takeMVar breakMVar
resetBreakAction stablePtr = do
=====================================
rts/Interpreter.c
=====================================
@@ -207,6 +207,19 @@ See also Note [Width of parameters] for some more motivation.
// Perhaps confusingly this still reads a full word, merely the offset is in bytes.
#define ReadSpB(n) (*((StgWord*) SafeSpBP(n)))
+/*
+ * SLIDE "n" words "by" words
+ * a_1 ... a_n, b_1 ... b_by, k
+ * =>
+ * a_1 ... a_n, k
+ */
+#define SpSlide(n, by) \
+ while(n-- > 0) { \
+ SpW(n+by) = ReadSpW(n); \
+ } \
+ Sp_addW(by); \
+
+
/* Note [PUSH_L underflow]
~~~~~~~~~~~~~~~~~~~~~~~
BCOs can be nested, resulting in nested BCO stack frames where the inner most
@@ -284,6 +297,18 @@ allocate_NONUPD (Capability *cap, int n_words)
return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
+STATIC_INLINE int
+is_ctoi_nontuple_frame(const StgPtr frame_head) {
+ return (
+ (W_)frame_head == (W_)&stg_ctoi_R1p_info ||
+ (W_)frame_head == (W_)&stg_ctoi_R1n_info ||
+ (W_)frame_head == (W_)&stg_ctoi_F1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_D1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_L1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_V_info
+ );
+}
+
int rts_stop_on_exception = 0;
/* ---------------------------------------------------------------------------
@@ -844,7 +869,6 @@ eval_obj:
debugBelch("\n\n");
);
-// IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
IF_DEBUG(sanity,checkStackFrame(Sp));
switch ( get_itbl(obj)->type ) {
@@ -1086,11 +1110,31 @@ do_return_pointer:
// Returning to an interpreted continuation: put the object on
// the stack, and start executing the BCO.
INTERP_TICK(it_retto_BCO);
- Sp_subW(1);
- SpW(0) = (W_)tagged_obj;
- obj = (StgClosure*)ReadSpW(2);
+ obj = (StgClosure*)ReadSpW(1);
ASSERT(get_itbl(obj)->type == BCO);
- goto run_BCO_return_pointer;
+
+ // Heap check
+ if (doYouWantToGC(cap)) {
+ Sp_subW(2);
+ SpW(1) = (W_)tagged_obj;
+ SpW(0) = (W_)&stg_ret_p_info;
+ RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
+ }
+ else {
+
+ // Stack checks aren't necessary at return points, the stack use
+ // is aggregated into the enclosing function entry point.
+
+ // Make sure stack is headed by a ctoi R1p frame when returning a pointer
+ ASSERT(ReadSpW(0) == (W_)&stg_ctoi_R1p_info);
+
+ // Add the return frame on top of the args
+ Sp_subW(2);
+ SpW(1) = (W_)tagged_obj;
+ SpW(0) = (W_)&stg_ret_p_info;
+ }
+
+ goto run_BCO;
default:
do_return_unrecognised:
@@ -1159,8 +1203,9 @@ do_return_nonpointer:
// get the offset of the header of the next stack frame
offset = stack_frame_sizeW((StgClosure *)Sp);
+ StgClosure* next_frame = (StgClosure*)(SafeSpWP(offset));
- switch (get_itbl((StgClosure*)(SafeSpWP(offset)))->type) {
+ switch (get_itbl(next_frame)->type) {
case RET_BCO:
// Returning to an interpreted continuation: pop the return frame
@@ -1168,8 +1213,59 @@ do_return_nonpointer:
// executing the BCO.
INTERP_TICK(it_retto_BCO);
obj = (StgClosure*)ReadSpW(offset+1);
+
ASSERT(get_itbl(obj)->type == BCO);
- goto run_BCO_return_nonpointer;
+
+ // Heap check
+ if (doYouWantToGC(cap)) {
+ RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
+ }
+ else {
+ // Stack checks aren't necessary at return points, the stack use
+ // is aggregated into the enclosing function entry point.
+
+#if defined(PROFILING)
+ /*
+ Restore the current cost centre stack if a tuple is being returned.
+
+ When a "simple" unlifted value is returned, the cccs is restored with
+ an stg_restore_cccs frame on the stack, for example:
+
+ ...
+ stg_ctoi_D1
+ <CCCS>
+ stg_restore_cccs
+
+ But stg_restore_cccs cannot deal with tuples, which may have more
+ things on the stack. Therefore we store the CCCS inside the
+ stg_ctoi_t frame.
+
+ If we have a tuple being returned, the stack looks like this:
+
+ ...
+ <CCCS> <- to restore, Sp offset <next frame + 4 words>
+ tuple_BCO
+ tuple_info
+ cont_BCO
+ stg_ctoi_t <- next frame
+ tuple_data_1
+ ...
+ tuple_data_n
+ tuple_info
+ tuple_BCO
+ stg_ret_t <- Sp
+ */
+
+ if(SpW(0) == (W_)&stg_ret_t_info) {
+ cap->r.rCCCS = (CostCentreStack*)ReadSpW(offset + 4);
+ }
+#endif
+
+ /* Keep the stg_ret_*_info header (i.e. don't drop it)
+ * See Note [The Stack when running a Case Continuation BCO]
+ */
+ goto run_BCO;
+ }
default:
{
@@ -1336,8 +1432,8 @@ do_apply:
// Ok, we now have a bco (obj), and its arguments are all on the
// stack. We can start executing the byte codes.
//
- // The stack is in one of two states. First, if this BCO is a
- // function:
+ // The stack is in one of two states. First, if this BCO is a
+ // function
//
// | .... |
// +---------------+
@@ -1375,68 +1471,6 @@ do_apply:
// Sadly we have three different kinds of stack/heap/cswitch check
// to do:
-
-run_BCO_return_pointer:
- // Heap check
- if (doYouWantToGC(cap)) {
- Sp_subW(1); SpW(0) = (W_)&stg_ret_p_info;
- RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
- }
- // Stack checks aren't necessary at return points, the stack use
- // is aggregated into the enclosing function entry point.
-
- goto run_BCO;
-
-run_BCO_return_nonpointer:
- // Heap check
- if (doYouWantToGC(cap)) {
- RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
- }
- // Stack checks aren't necessary at return points, the stack use
- // is aggregated into the enclosing function entry point.
-
-#if defined(PROFILING)
- /*
- Restore the current cost centre stack if a tuple is being returned.
-
- When a "simple" unlifted value is returned, the cccs is restored with
- an stg_restore_cccs frame on the stack, for example:
-
- ...
- stg_ctoi_D1
- <CCCS>
- stg_restore_cccs
-
- But stg_restore_cccs cannot deal with tuples, which may have more
- things on the stack. Therefore we store the CCCS inside the
- stg_ctoi_t frame.
-
- If we have a tuple being returned, the stack looks like this:
-
- ...
- <CCCS> <- to restore, Sp offset <next frame + 4 words>
- tuple_BCO
- tuple_info
- cont_BCO
- stg_ctoi_t <- next frame
- tuple_data_1
- ...
- tuple_data_n
- tuple_info
- tuple_BCO
- stg_ret_t <- Sp
- */
-
- if(SpW(0) == (W_)&stg_ret_t_info) {
- cap->r.rCCCS = (CostCentreStack*)ReadSpW(stack_frame_sizeW((StgClosure *)Sp) + 4);
- }
-#endif
-
- if (SpW(0) != (W_)&stg_ret_t_info) {
- Sp_addW(1);
- }
- goto run_BCO;
-
run_BCO_fun:
IF_DEBUG(sanity,
Sp_subW(2);
@@ -1519,7 +1553,7 @@ run_BCO:
switch (bci & 0xFF) {
- /* check for a breakpoint on the beginning of a let binding */
+ /* check for a breakpoint on the beginning of a BCO */
case bci_BRK_FUN:
{
W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
@@ -1572,6 +1606,20 @@ run_BCO:
{
breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
+ W_ stack_head = ReadSpW(0);
+
+ // See Note [Stack layout when entering run_BCO blah]
+ // When the BRK_FUN is at the start of a case continuation BCO,
+ // the stack contains the frame returning the value at the start.
+ int is_case_cont_BCO =
+ stack_head == (W_)&stg_ret_t_info
+ || stack_head == (W_)&stg_ret_v_info
+ || stack_head == (W_)&stg_ret_p_info
+ || stack_head == (W_)&stg_ret_n_info
+ || stack_head == (W_)&stg_ret_f_info
+ || stack_head == (W_)&stg_ret_d_info
+ || stack_head == (W_)&stg_ret_l_info;
+
// stop the current thread if either `stop_next_breakpoint` is
// true OR if the ignore count for this particular breakpoint is zero
StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
@@ -1580,36 +1628,84 @@ run_BCO:
// decrement and write back ignore count
((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
- else if (stop_next_breakpoint == true || ignore_count == 0)
+ else if (
+ /* Doing step-in (but don't stop at case continuation BCOs,
+ * those are only useful when stepping out) */
+ (stop_next_breakpoint == true && !is_case_cont_BCO)
+ /* Or breakpoint is explicitly enabled */
+ || ignore_count == 0)
{
// make sure we don't automatically stop at the
// next breakpoint
rts_stop_next_breakpoint = 0;
cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
- // allocate memory for a new AP_STACK, enough to
- // store the top stack frame plus an
- // stg_apply_interp_info pointer and a pointer to
- // the BCO
- size_words = BCO_BITMAP_SIZE(obj) + 2;
- new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
- new_aps->size = size_words;
- new_aps->fun = &stg_dummy_ret_closure;
-
- // fill in the payload of the AP_STACK
- new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
- new_aps->payload[1] = (StgClosure *)obj;
-
- // copy the contents of the top stack frame into the AP_STACK
- for (i = 2; i < size_words; i++)
- {
- new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
+ // TODO: WRITE NOTE
+ if (is_case_cont_BCO) {
+
+ // TODO: WRITE NOTE
+ // A case cont. BCO is headed by a ret_frame with the returned value
+ // We need the frame here if we are going to yield to construct a well formed stack
+ // Then, just afterwards, we SLIDE the header off. This is generated code (see StgToByteCode)
+ int size_returned_frame =
+ (stack_head == (W_)&stg_ret_t_info)
+ ? 2 /* ret_t + tuple_BCO */
+ + /* Sp(2) is call_info which records the offset to the next frame
+ * See also Note [unboxed tuple bytecodes and tuple_BCO] */
+ ((ReadSpW(2) & 0xFF))
+ : 2; /* ret_* + return value */
+
+ StgPtr cont_frame_head
+ = (StgPtr)(SpW(size_returned_frame));
+ ASSERT(obj == UNTAG_CLOSURE((StgClosure*)ReadSpW(size_returned_frame+1)));
+
+ // stg_ctoi_*
+ int size_cont_frame_head =
+ is_ctoi_nontuple_frame(cont_frame_head)
+ ? 2 // info+bco
+#if defined(PROFILING)
+ : 5; // or info+bco+tuple_info+tuple_BCO+CCS
+#else
+ : 4; // or info+bco+tuple_info+tuple_BCO
+#endif
+
+ // Continuation stack is already well formed,
+ // so just copy it whole to the AP_STACK
+ size_words = size_returned_frame
+ + size_cont_frame_head
+ + BCO_BITMAP_SIZE(obj) /* payload of cont_frame */;
+ new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
+ new_aps->size = size_words;
+ new_aps->fun = &stg_dummy_ret_closure;
+
+ // (1) Fill in the payload of the AP_STACK:
+ for (i = 0; i < size_words; i++) {
+ new_aps->payload[i] = (StgClosure *)ReadSpW(i);
+ }
+ }
+ else {
+ // (1) Allocate memory for a new AP_STACK, enough to store
+ // the top stack frame plus an stg_apply_interp_info pointer
+ // and a pointer to the BCO
+ size_words = BCO_BITMAP_SIZE(obj) + 2;
+ new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
+ new_aps->size = size_words;
+ new_aps->fun = &stg_dummy_ret_closure;
+
+ // (1.1) the continuation frame
+ new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
+ new_aps->payload[1] = (StgClosure *)obj;
+
+ // (1.2.1) copy the args/free vars of the top stack frame into the AP_STACK
+ for (i = 2; i < size_words; i++) {
+ new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
+ }
}
// No write barrier is needed here as this is a new allocation
SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
- // Arrange the stack to call the breakpoint IO action, and
+ // (2) Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
// ioAction :: Addr# -- the breakpoint info module
@@ -1622,12 +1718,27 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(13);
- SpW(12) = (W_)obj;
- SpW(11) = (W_)&stg_apply_interp_info;
+ // (2.1) Construct the continuation to which we'll return in
+ // this thread after the `rts_breakpoint_io_action` returns.
+ //
+ // For case continuation BCOs, the continuation that re-runs
+ // it is always ready at the start of the BCO. It gets
+ // dropped soon after if we don't stop there by SLIDEing.
+ // See Note [TODO]
+ if (!is_case_cont_BCO) {
+ Sp_subW(2); // stg_apply_interp_info + StgBCO*
+
+ // (2.1.2) Write the continuation frame (above the stg_ret
+ // frame if one exists)
+ SpW(1) = (W_)obj;
+ SpW(0) = (W_)&stg_apply_interp_info;
+ }
+
+ // (2.2) The `rts_breakpoint_io_action` call
+ Sp_subW(11);
SpW(10) = (W_)new_aps;
- SpW(9) = (W_)False_closure; // True <=> an exception
- SpW(8) = (W_)&stg_ap_ppv_info;
+ SpW(9) = (W_)False_closure; // True <=> an exception
+ SpW(8) = (W_)&stg_ap_ppv_info;
SpW(7) = (W_)arg4_info_index;
SpW(6) = (W_)&stg_ap_n_info;
SpW(5) = (W_)BCO_LIT(arg3_info_mod_id);
@@ -1981,15 +2092,7 @@ run_BCO:
case bci_SLIDE: {
W_ n = BCO_GET_LARGE_ARG;
W_ by = BCO_GET_LARGE_ARG;
- /*
- * a_1 ... a_n, b_1 ... b_by, k
- * =>
- * a_1 ... a_n, k
- */
- while(n-- > 0) {
- SpW(n+by) = ReadSpW(n);
- }
- Sp_addW(by);
+ SpSlide(n, by);
INTERP_TICK(it_slides);
goto nextInsn;
}
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.hs
=====================================
@@ -0,0 +1,13 @@
+
+module Main where
+
+main = do
+ putStrLn "hello1"
+ f
+ putStrLn "hello3"
+ putStrLn "hello4"
+
+f = do
+ putStrLn "hello2.1"
+ putStrLn "hello2.2"
+{-# NOINLINE f #-}
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.script
=====================================
@@ -0,0 +1,12 @@
+:load T26042d2.hs
+
+:break 11
+main
+:list
+:stepout
+:list
+:stepout
+
+-- should exit! we compile this test case with -O1 to make sure the monad >> are inlined
+-- and thus the test relies on the filtering behavior based on SrcSpans for stepout
+
=====================================
testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
=====================================
@@ -0,0 +1,16 @@
+Breakpoint 0 activated at T26042d2.hs:11:3-21
+hello1
+Stopped in Main.f, T26042d2.hs:11:3-21
+_result ::
+ GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
+ -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
+ () #) = _
+10 f = do
+11 putStrLn "hello2.1"
+ ^^^^^^^^^^^^^^^^^^^
+12 putStrLn "hello2.2"
+hello2.1
+hello2.2
+<--- should break here too
+hello3
+hello4
=====================================
testsuite/tests/ghci.debugger/scripts/T26042g.stdout
=====================================
@@ -6,10 +6,13 @@ x :: Int = 14
11 succ x = (-) (x - 2) (x + 1)
^^^^^^^^^^^^^^^^^^^
12
-Stopped in T9.top, T26042g.hs:8:10-21
+Stopped in T9., T26042g.hs:(6,3)-(8,21)
_result :: Int = _
+5 top = do
+ vv
+6 case succ 14 of
7 5 -> 5
8 _ -> 6 + other 55
- ^^^^^^^^^^^^
+ ^^
9
171
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -147,8 +147,9 @@ test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script'])
# Step out tests
test('T26042b', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042b.hs'])], ghci_script, ['T26042b.script'])
-test('T26042c', [expect_broken(26042),extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
+test('T26042c', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
test('T26042d', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d.hs'])], ghci_script, ['T26042d.script'])
+test('T26042d2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d2.hs'])], ghci_script, ['T26042d2.script'])
test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop
test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042f.hs', 'T26042f.script'])], ghci_script, ['T26042f.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67e50cb9f350969d0c769d76ee6765…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67e50cb9f350969d0c769d76ee6765…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/remove-deprecated-unstable-heap-representation-details] 2 commits: Remove deprecated functions from the ghci package
by Hannes Siebenhandl (＠fendor) 23 Jul '25
by Hannes Siebenhandl (＠fendor) 23 Jul '25
23 Jul '25
Hannes Siebenhandl pushed to branch wip/fendor/remove-deprecated-unstable-heap-representation-details at Glasgow Haskell Compiler / GHC
Commits:
46f9b063 by fendor at 2025-07-23T18:59:26+02:00
Remove deprecated functions from the ghci package
- - - - -
070008a4 by fendor at 2025-07-23T18:59:26+02:00
base: Remove unstable heap representation details from GHC.Exts
- - - - -
8 changed files:
- libraries/base/src/GHC/Exts.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/TH.hs
- libraries/ghci/ghci.cabal.in
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
Changes:
=====================================
libraries/base/src/GHC/Exts.hs
=====================================
@@ -26,12 +26,6 @@ module GHC.Exts
-- ** Legacy interface for arrays of arrays
module GHC.Internal.ArrayArray,
-- * Primitive operations
- {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
- Prim.BCO,
- {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
- Prim.mkApUpd0#,
- {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
- Prim.newBCO#,
module GHC.Prim,
module GHC.Prim.Ext,
-- ** Running 'RealWorld' state thread
@@ -131,9 +125,6 @@ import GHC.Prim hiding
, whereFrom#
, isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned#
- -- deprecated
- , BCO, mkApUpd0#, newBCO#
-
-- Don't re-export vector FMA instructions
, fmaddFloatX4#
, fmsubFloatX4#
@@ -256,8 +247,6 @@ import GHC.Prim hiding
, minWord8X32#
, minWord8X64#
)
-import qualified GHC.Prim as Prim
- ( BCO, mkApUpd0#, newBCO# )
import GHC.Prim.Ext
=====================================
libraries/ghci/GHCi/CreateBCO.hs
=====================================
@@ -6,10 +6,6 @@
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
--- TODO We want to import GHC.Internal.Base (BCO, mkApUpd0#, newBCO#) instead
--- of from GHC.Exts when we can require of the bootstrap compiler to have
--- ghc-internal.
--
-- (c) The University of Glasgow 2002-2006
@@ -30,7 +26,8 @@ import Data.Array.Base
import Foreign hiding (newArray)
import Unsafe.Coerce (unsafeCoerce)
import GHC.Arr ( Array(..) )
-import GHC.Exts
+import GHC.Exts hiding ( BCO, mkApUpd0#, newBCO# )
+import GHC.Internal.Base ( BCO, mkApUpd0#, newBCO# )
import GHC.IO
import Control.Exception ( ErrorCall(..) )
=====================================
libraries/ghci/GHCi/TH.hs
=====================================
@@ -1,9 +1,6 @@
{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, DeriveGeneric,
TupleSections, RecordWildCards, InstanceSigs, CPP #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
--- TODO We want to import GHC.Internal.Desugar instead of GHC.Desugar when we
--- can require of the bootstrap compiler to have ghc-internal.
-- |
-- Running TH splices
@@ -112,7 +109,7 @@ import Data.IORef
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
-import GHC.Desugar (AnnotationWrapper(..))
+import GHC.Internal.Desugar (AnnotationWrapper(..))
import qualified GHC.Boot.TH.Syntax as TH
import Unsafe.Coerce
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -86,11 +86,7 @@ library
rts,
array == 0.5.*,
base >= 4.8 && < 4.23,
- -- ghc-internal == @ProjectVersionForLib@.*
- -- TODO: Use GHC.Internal.Desugar and GHC.Internal.Base from
- -- ghc-internal instead of ignoring the deprecation warning in GHCi.TH
- -- and GHCi.CreateBCO when we require ghc-internal of the bootstrap
- -- compiler
+ ghc-internal >= 9.1001.0 && <=@ProjectVersionForLib@.0,
ghc-prim >= 0.5.0 && < 0.14,
binary == 0.8.*,
bytestring >= 0.10 && < 0.13,
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -3221,8 +3221,6 @@ module GHC.Base where
{-# MINIMAL pure, ((<*>) | liftA2) #-}
type Array# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType
data Array# a
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -4115,7 +4113,6 @@ module GHC.Base where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
modInt :: Int -> Int -> Int
@@ -4174,7 +4171,6 @@ module GHC.Base where
negateInt8X64# :: Int8X64# -> Int8X64#
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
@@ -5398,8 +5394,6 @@ module GHC.Exts where
data Array# a
type ArrayArray# :: UnliftedType
newtype ArrayArray# = ArrayArray# (Array# ByteArray#)
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -6210,7 +6204,6 @@ module GHC.Exts where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mulIntMayOflo# :: Int# -> Int# -> Int#
@@ -6262,7 +6255,6 @@ module GHC.Exts where
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArrayArray# :: forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -3221,8 +3221,6 @@ module GHC.Base where
{-# MINIMAL pure, ((<*>) | liftA2) #-}
type Array# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType
data Array# a
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -4115,7 +4113,6 @@ module GHC.Base where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
modInt :: Int -> Int -> Int
@@ -4174,7 +4171,6 @@ module GHC.Base where
negateInt8X64# :: Int8X64# -> Int8X64#
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
@@ -5370,8 +5366,6 @@ module GHC.Exts where
data Array# a
type ArrayArray# :: UnliftedType
newtype ArrayArray# = ArrayArray# (Array# ByteArray#)
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -6182,7 +6176,6 @@ module GHC.Exts where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mulIntMayOflo# :: Int# -> Int# -> Int#
@@ -6234,7 +6227,6 @@ module GHC.Exts where
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArrayArray# :: forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -3221,8 +3221,6 @@ module GHC.Base where
{-# MINIMAL pure, ((<*>) | liftA2) #-}
type Array# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType
data Array# a
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -4118,7 +4116,6 @@ module GHC.Base where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
modInt :: Int -> Int -> Int
@@ -4177,7 +4174,6 @@ module GHC.Base where
negateInt8X64# :: Int8X64# -> Int8X64#
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
@@ -5538,8 +5534,6 @@ module GHC.Exts where
data Array# a
type ArrayArray# :: UnliftedType
newtype ArrayArray# = ArrayArray# (Array# ByteArray#)
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -6353,7 +6347,6 @@ module GHC.Exts where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mulIntMayOflo# :: Int# -> Int# -> Int#
@@ -6405,7 +6398,6 @@ module GHC.Exts where
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArrayArray# :: forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -3221,8 +3221,6 @@ module GHC.Base where
{-# MINIMAL pure, ((<*>) | liftA2) #-}
type Array# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType
data Array# a
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -4115,7 +4113,6 @@ module GHC.Base where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
modInt :: Int -> Int -> Int
@@ -4174,7 +4171,6 @@ module GHC.Base where
negateInt8X64# :: Int8X64# -> Int8X64#
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
@@ -5398,8 +5394,6 @@ module GHC.Exts where
data Array# a
type ArrayArray# :: UnliftedType
newtype ArrayArray# = ArrayArray# (Array# ByteArray#)
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -6210,7 +6204,6 @@ module GHC.Exts where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mulIntMayOflo# :: Int# -> Int# -> Int#
@@ -6262,7 +6255,6 @@ module GHC.Exts where
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArrayArray# :: forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b4788c6dcb8801126f0ad4b2ce864…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b4788c6dcb8801126f0ad4b2ce864…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/remove-stg_stackDecode] 4 commits: Move stack decoding logic from ghc-heap to ghc-internal
by Hannes Siebenhandl (＠fendor) 23 Jul '25
by Hannes Siebenhandl (＠fendor) 23 Jul '25
23 Jul '25
Hannes Siebenhandl pushed to branch wip/fendor/remove-stg_stackDecode at Glasgow Haskell Compiler / GHC
Commits:
a678e230 by fendor at 2025-07-23T18:45:43+02:00
Move stack decoding logic from ghc-heap to ghc-internal
The stack decoding logic in `ghc-heap` is more sophisticated than the one
currently employed in `CloneStack`. We want to use the stack decoding
implementation from `ghc-heap` in `base`.
We cannot simply depend on `ghc-heap` in `base` due do bootstrapping
issues.
Thus, we move the code that is necessary to implement stack decoding to
`ghc-internal`. This is the right location, as we don't want to add a
new API to `base`.
Moving the stack decoding logic and re-exposing it in ghc-heap is
insufficient, though, as we have a dependency cycle between.
* ghc-heap depends on stage1:ghc-internal
* stage0:ghc depends on stage0:ghc-heap
To fix this, we remove ghc-heap from the set of `stage0` dependencies.
This is not entirely straight-forward, as a couple of boot dependencies,
such as `ghci` depend on `ghc-heap`.
Luckily, the boot compiler of GHC is now >=9.10, so we can migrate `ghci`
to use `ghc-internal` instead of `ghc-heap`, which already exports the
relevant modules.
However, we cannot 100% remove ghc's dependency on `ghc-heap`, since
when we compile `stage0:ghc`, `stage1:ghc-internal` is not yet
available.
Thus, when we compile with the boot-compiler, we still depend on an
older version of `ghc-heap`, and only use the modules from `ghc-internal`,
if the `ghc-internal` version is recent enough.
- - - - -
b9d5f2ae by fendor at 2025-07-23T18:45:43+02:00
Implement `decode` in terms of `decodeStackWithIpe`
Uses the more efficient stack decoder implementation.
- - - - -
e15f7ba1 by fendor at 2025-07-23T18:45:43+02:00
Remove stg_decodeStackzh
- - - - -
ea120a65 by fendor at 2025-07-23T18:45:43+02:00
Remove deprecated functions from the ghci package
- - - - -
40 changed files:
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/ghc.cabal.in
- hadrian/src/Settings/Default.hs
- libraries/base/src/GHC/Stack/CloneStack.hs
- + libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hsc
- libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs
- libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-heap/cbits/HeapPrim.cmm → libraries/ghc-internal/cbits/HeapPrim.cmm
- libraries/ghc-heap/cbits/Stack.cmm → libraries/ghc-internal/cbits/Stack.cmm
- libraries/ghc-internal/cbits/StackCloningDecoding.cmm
- libraries/ghc-heap/cbits/Stack_c.c → libraries/ghc-internal/cbits/Stack_c.c
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/jsbits/base.js
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- + libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/TH.hs
- libraries/ghci/ghci.cabal.in
- rts/CloneStack.c
- rts/CloneStack.h
- rts/RtsSymbols.c
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e1e3965451b55b1cd1f046818eb3f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e1e3965451b55b1cd1f046818eb3f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-11] Allow BRK_FUNs at the start of case continuation BCOs
by Rodrigo Mesquita (＠alt-romes) 23 Jul '25
by Rodrigo Mesquita (＠alt-romes) 23 Jul '25
23 Jul '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC
Commits:
67e50cb9 by Rodrigo Mesquita at 2025-07-23T17:42:40+01:00
Allow BRK_FUNs at the start of case continuation BCOs
...and insert BRK_FUNS for case continuations: TODO: SPLIT THE TICK
PARTS OUT
Working on making BRK_FUNs for case cont. BCO
Remove bad
Beautiful
Fix...
More right-trackking
TODO: Test step-out from a continuation which receives an unboxed tuple as an argument
Fix again
Beautiful again
Almost there
- - - - -
10 changed files:
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Run.hs
- rts/Interpreter.c
- testsuite/tests/ghci.debugger/scripts/T26042g.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
Changes:
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DerivingStrategies #-}
-- | Breakpoint information constructed during ByteCode generation.
--
@@ -15,6 +16,7 @@ module GHC.ByteCode.Breakpoints
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
+ , InternalBreakLoc(..)
-- * Operations
@@ -23,7 +25,7 @@ module GHC.ByteCode.Breakpoints
-- ** Source-level information operations
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
- , getBreakSourceId
+ , getBreakSourceId, getBreakSourceMod
-- * Utils
, seqInternalModBreaks
@@ -165,7 +167,7 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
- , cgb_tick_id :: !BreakpointId
+ , cgb_tick_id :: !(Either InternalBreakLoc BreakpointId)
-- ^ This field records the original breakpoint tick identifier for this
-- internal breakpoint info. It is used to convert a breakpoint
-- *occurrence* index ('InternalBreakpointId') into a *definition* index
@@ -173,9 +175,19 @@ data CgBreakInfo
--
-- The modules of breakpoint occurrence and breakpoint definition are not
-- necessarily the same: See Note [Breakpoint identifiers].
+ --
+ -- If there is no original tick identifier (that is, the breakpoint was
+ -- created during code generation), instead refer directly to the SrcSpan
+ -- we want to use for it. See Note [Internal Breakpoint Locations]
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
+-- | Breakpoints created during code generation don't have a source-level tick
+-- location. Instead, we come up with one ourselves.
+-- See Note [Internal Breakpoint Locations]
+newtype InternalBreakLoc = InternalBreakLoc SrcSpan
+ deriving newtype (Eq, Show, NFData, Outputable)
+
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak (InternalBreakpointId mod ix) imbs =
@@ -196,27 +208,36 @@ assert_modules_match ibi_mod imbs_mod =
-- | Get the source module and tick index for this breakpoint
-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
-getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
+getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> Either InternalBreakLoc BreakpointId
getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
assert_modules_match ibi_mod (imodBreaks_module imbs) $
let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
in cgb_tick_id cgb
+-- | Get the source module for this breakpoint (where the breakpoint is defined)
+getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module
+getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ in case cgb_tick_id cgb of
+ Left InternalBreakLoc{} -> imodBreaks_module imbs
+ Right BreakpointId{bi_tick_mod} -> bi_tick_mod
+
-- | Get the source span for this breakpoint
getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
-getBreakLoc = getBreakXXX modBreaks_locs
+getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
-- | Get the vars for this breakpoint
getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
-getBreakVars = getBreakXXX modBreaks_vars
+getBreakVars = getBreakXXX modBreaks_vars (const [])
-- | Get the decls for this breakpoint
getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
-getBreakDecls = getBreakXXX modBreaks_decls
+getBreakDecls = getBreakXXX modBreaks_decls (const [])
-- | Get the decls for this breakpoint
-getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
-getBreakCCS = getBreakXXX modBreaks_ccs
+getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
+getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
--
@@ -228,14 +249,17 @@ getBreakCCS = getBreakXXX modBreaks_ccs
-- 'ModBreaks'. When the tick module is different, we need to look up the
-- 'ModBreaks' in the HUG for that other module.
--
+-- When there is no tick module (the breakpoint was generated at codegen), use
+-- the function on internal mod breaks.
+--
-- To avoid cyclic dependencies, we instead receive a function that looks up
-- the 'ModBreaks' given a 'Module'
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
-getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
+getBreakXXX view viewInternal lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
case cgb_tick_id cgb of
- BreakpointId{bi_tick_mod, bi_tick_index}
+ Right BreakpointId{bi_tick_mod, bi_tick_index}
| bi_tick_mod == ibi_mod
-> do
let these_mbs = imodBreaks_modBreaks imbs
@@ -244,6 +268,8 @@ getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
-> do
other_mbs <- lookupModule bi_tick_mod
return $ view other_mbs ! bi_tick_index
+ Left l ->
+ return $ viewInternal l
--------------------------------------------------------------------------------
-- Instances
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -58,6 +58,7 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message (ConInfoTable(..), LoadedDLL)
+import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
import GHC.ByteCode.Asm
import GHC.ByteCode.Types
@@ -1711,8 +1712,10 @@ allocateCCS interp ce mbss
let count = 1 + (maybe 0 fst $ IM.lookupMax imodBreaks_breakInfo)
let ccs = IM.map
(\info ->
- fromMaybe (toRemotePtr nullPtr)
- (M.lookup (cgb_tick_id info) ccss)
+ case cgb_tick_id info of
+ Right bi -> fromMaybe (toRemotePtr nullPtr)
+ (M.lookup bi ccss)
+ Left InternalBreakLoc{} -> toRemotePtr nullPtr
)
imodBreaks_breakInfo
assertPpr (count == length ccs)
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -253,8 +253,11 @@ mkBreakpointOccurrences = do
let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
IntMap.foldrWithKey (\info_ix cgi bmp -> do
let ibi = InternalBreakpointId imod info_ix
- let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
- extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ case cgb_tick_id cgi of
+ Right (BreakpointId tick_mod tick_ix)
+ -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
+ Left _
+ -> bmp
) bmp0 (imodBreaks_breakInfo ibrks)
--------------------------------------------------------------------------------
@@ -287,7 +290,7 @@ getCurrentBreakModule = do
Nothing -> pure Nothing
Just ibi -> do
brks <- readIModBreaks hug ibi
- return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ Just $ getBreakSourceMod ibi brks
ix ->
Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -151,7 +151,7 @@ getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
getHistoryModule hug hist = do
let ibi = historyBreakpointId hist
brks <- readIModBreaks hug ibi
- return $ bi_tick_mod $ getBreakSourceId ibi brks
+ return $ getBreakSourceMod ibi brks
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -63,7 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
assertNonVoidIds, assertNonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
-import GHC.Runtime.Interpreter ( interpreterProfiled )
+import GHC.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks )
import GHC.Data.Bitmap
import GHC.Data.FlatBag as FlatBag
import GHC.Data.OrdList
@@ -99,6 +99,7 @@ import GHC.CoreToIface
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
+import Data.Array ((!))
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -393,26 +394,30 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
- code <- schemeE d 0 p rhs
- mb_current_mod_breaks <- getCurrentModBreaks
- case mb_current_mod_breaks of
- -- if we're not generating ModBreaks for this module for some reason, we
- -- can't store breakpoint occurrence information.
- Nothing -> pure code
- Just current_mod_breaks -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
-
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
+ platform <- profilePlatform <$> getProfile
+
+ code <- case rhs of
+ -- When we find a tick surrounding a case expression we introduce a new BRK_FUN
+ -- instruction at the start of the case *continuation*, in addition to the
+ -- usual BRK_FUN surrounding the StgCase)
+ -- See Note [TODO]
+ StgCase scrut bndr _ alts
+ -> doCase d 0 p (Just bp) scrut bndr alts
+ _ -> schemeE d 0 p rhs
+
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Right tick_id)
+
+ mibi <- newBreakInfo breakInfo
+
+ return $ case mibi of
+ Nothing -> code
+ Just ibi -> BRK_FUN ibi `consOL` code
- let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
- return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
@@ -614,7 +619,7 @@ schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut
schemeE d s p (StgCase scrut bndr _ alts)
- = doCase d s p scrut bndr alts
+ = doCase d s p Nothing scrut bndr alts
{-
@@ -1106,11 +1111,15 @@ doCase
:: StackDepth
-> Sequel
-> BCEnv
+ -> Maybe StgTickish
+ -- ^ The breakpoint surrounding the full case expression, if any (only
+ -- source-level cases get breakpoint ticks, and those are the only we care
+ -- about). See Note [TODO]
-> CgStgExpr
-> Id
-> [CgStgAlt]
-> BcM BCInstrList
-doCase d s p scrut bndr alts
+doCase d s p m_bid scrut bndr alts
= do
profile <- getProfile
hsc_env <- getHscEnv
@@ -1325,19 +1334,35 @@ doCase d s p scrut bndr alts
| ubx_tuple_frame = SLIDE 0 3 `consOL` alt_final1
| otherwise = SLIDE 0 1 `consOL` alt_final1
- -- when `BRK_FUN` in a case continuation BCO executes,
- -- the stack will already have a full continuation that just
- -- re-executes the BCO being stopped at (including the stg_ret and
- -- stg_ctoi frames)
- --
- -- right after the `BRK_FUN`, all case continuations will drop the
- -- stg_ret and stg_ctoi headers (see alt_final1, alt_final2), leaving
- -- the stack with the bound return values followed by the free variables
- alt_final
- | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
- -- See Note [Debugger: BRK_ALTS]
- = BRK_ALTS False `consOL` alt_final2
- | otherwise = alt_final2
+ -- when `BRK_FUN` in a case continuation BCO executes,
+ -- the stack will already have a full continuation that just
+ -- re-executes the BCO being stopped at (including the stg_ret and
+ -- stg_ctoi frames)
+ --
+ -- right after the `BRK_FUN`, all case continuations will drop the
+ -- stg_ret and stg_ctoi headers (see alt_final1, alt_final2), leaving
+ -- the stack with the bound return values followed by the free variables
+ alt_final <- case m_bid of
+ Just (Breakpoint tick_ty tick_id fvs)
+ | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
+ -- Construct an internal breakpoint to put at the start of this case
+ -- continuation BCO.
+ -- See Note [TODO]
+ -> do
+ internal_tick_loc <- makeCaseInternalBreakLoc tick_id
+
+ -- same fvs available in the case expression are available in the case continuation
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Left internal_tick_loc)
+
+ mibi <- newBreakInfo breakInfo
+ return $ case mibi of
+ Nothing -> alt_final2
+ Just ibi -> BRK_FUN ibi `consOL` alt_final2
+ _ -> pure alt_final2
add_bco_name <- shouldAddBcoName
let
@@ -1357,6 +1382,24 @@ doCase d s p scrut bndr alts
_ -> panic "schemeE(StgCase).push_alts"
in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
+makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
+makeCaseInternalBreakLoc bid = do
+ hug <- hsc_HUG <$> getHscEnv
+ curr_mod <- getCurrentModule
+ mb_mod_brks <- getCurrentModBreaks
+
+ -- TODO: Subtract the scrutinee loc from the case loc to get continuation loc
+ InternalBreakLoc <$> case bid of
+ BreakpointId{bi_tick_mod, bi_tick_index}
+ | bi_tick_mod == curr_mod
+ , Just these_mbs <- mb_mod_brks
+ -> do
+ return $ modBreaks_locs these_mbs ! bi_tick_index
+ | otherwise
+ -> do
+ other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod
+ return $ modBreaks_locs other_mbs ! bi_tick_index
+
{-
Note [Debugger: BRK_ALTS]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2677,14 +2720,19 @@ getLabelsBc n = BcM $ \_ st ->
let ctr = nextlabel st
in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
-newBreakInfo :: CgBreakInfo -> BcM Int
-newBreakInfo info = BcM $ \_ st ->
- let ix = breakInfoIdx st
- st' = st
- { breakInfo = IntMap.insert ix info (breakInfo st)
- , breakInfoIdx = ix + 1
- }
- in return (ix, st')
+newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
+newBreakInfo info = BcM $ \env st -> do
+ -- if we're not generating ModBreaks for this module for some reason, we
+ -- can't store breakpoint occurrence information.
+ case modBreaks env of
+ Nothing -> pure (Nothing, st)
+ Just modBreaks -> do
+ let ix = breakInfoIdx st
+ st' = st
+ { breakInfo = IntMap.insert ix info (breakInfo st)
+ , breakInfoIdx = ix + 1
+ }
+ return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
getCurrentModule :: BcM Module
getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
@@ -2697,7 +2745,7 @@ tickFS = fsLit "ticked"
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
import GHC.Runtime.Eval.Utils
-- The GHC interface
-import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
+import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId, getBreakSourceMod)
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
@@ -1621,7 +1621,7 @@ toBreakIdAndLocation (Just inf) = do
brks <- liftIO $ readIModBreaks hug inf
let bi = getBreakSourceId inf brks
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakId loc == bi ]
+ Right (breakId loc) == bi ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
@@ -3825,7 +3825,7 @@ pprStopped res = do
hug <- hsc_HUG <$> GHC.getSession
brks <- liftIO $ readIModBreaks hug ibi
return $ Just $ moduleName $
- bi_tick_mod $ getBreakSourceId ibi brks
+ getBreakSourceMod ibi brks
return $
text "Stopped in"
<+> ((case mb_mod_name of
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -362,6 +362,14 @@ withBreakAction opts breakMVar statusMVar mtid act
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
+
+ -- Block until this thread is resumed (by the thread which took the
+ -- `ResumeContext` from the `statusMVar`).
+ --
+ -- The `onBreak` function must have been called from `rts/Interpreter.c`
+ -- when interpreting a `BRK_FUN`. After taking from the MVar, the function
+ -- returns to the continuation on the stack which is where the interpreter
+ -- was stopped.
takeMVar breakMVar
resetBreakAction stablePtr = do
=====================================
rts/Interpreter.c
=====================================
@@ -297,18 +297,17 @@ allocate_NONUPD (Capability *cap, int n_words)
return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
-// STATIC_INLINE int
-// is_ctoi_nontuple_frame(const StgClosure* frame) {
-// const StgInfoTable* info = frame->header.info;
-// return (
-// (W_)info == (W_)&stg_ctoi_R1p_info ||
-// (W_)info == (W_)&stg_ctoi_R1n_info ||
-// (W_)info == (W_)&stg_ctoi_F1_info ||
-// (W_)info == (W_)&stg_ctoi_D1_info ||
-// (W_)info == (W_)&stg_ctoi_L1_info ||
-// (W_)info == (W_)&stg_ctoi_V_info
-// );
-// }
+STATIC_INLINE int
+is_ctoi_nontuple_frame(const StgPtr frame_head) {
+ return (
+ (W_)frame_head == (W_)&stg_ctoi_R1p_info ||
+ (W_)frame_head == (W_)&stg_ctoi_R1n_info ||
+ (W_)frame_head == (W_)&stg_ctoi_F1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_D1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_L1_info ||
+ (W_)frame_head == (W_)&stg_ctoi_V_info
+ );
+}
int rts_stop_on_exception = 0;
@@ -1264,7 +1263,7 @@ do_return_nonpointer:
*/
if(SpW(0) == (W_)&stg_ret_t_info) {
- cap->r.rCCCS = (CostCentreStack*)ReadSpW(stack_frame_sizeW((StgClosure *)Sp) + 4);
+ cap->r.rCCCS = (CostCentreStack*)ReadSpW(offset + 4);
}
#endif
/* Drop the RET_BCO header (next_frame),
@@ -1571,7 +1570,7 @@ run_BCO:
switch (bci & 0xFF) {
- /* check for a breakpoint on the beginning of a let binding */
+ /* check for a breakpoint on the beginning of a BCO */
case bci_BRK_FUN:
{
W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
@@ -1624,6 +1623,20 @@ run_BCO:
{
breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
+ W_ stack_head = ReadSpW(0);
+
+ // See Note [Stack layout when entering run_BCO blah]
+ // When the BRK_FUN is at the start of a case continuation BCO,
+ // the stack contains the frame returning the value at the start.
+ int is_case_cont_BCO =
+ stack_head == (W_)&stg_ret_t_info
+ || stack_head == (W_)&stg_ret_v_info
+ || stack_head == (W_)&stg_ret_p_info
+ || stack_head == (W_)&stg_ret_n_info
+ || stack_head == (W_)&stg_ret_f_info
+ || stack_head == (W_)&stg_ret_d_info
+ || stack_head == (W_)&stg_ret_l_info;
+
// stop the current thread if either `stop_next_breakpoint` is
// true OR if the ignore count for this particular breakpoint is zero
StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
@@ -1632,36 +1645,83 @@ run_BCO:
// decrement and write back ignore count
((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
- else if (stop_next_breakpoint == true || ignore_count == 0)
+ else if (
+ /* Doing :step (but don't stop at case continuation BCOs) */
+ (stop_next_breakpoint == true && !is_case_cont_BCO)
+ /* Or breakpoint is explicitly enabled */
+ || ignore_count == 0)
{
// make sure we don't automatically stop at the
// next breakpoint
rts_stop_next_breakpoint = 0;
cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
- // allocate memory for a new AP_STACK, enough to
- // store the top stack frame plus an
- // stg_apply_interp_info pointer and a pointer to
- // the BCO
- size_words = BCO_BITMAP_SIZE(obj) + 2;
- new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
- new_aps->size = size_words;
- new_aps->fun = &stg_dummy_ret_closure;
-
- // fill in the payload of the AP_STACK
- new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
- new_aps->payload[1] = (StgClosure *)obj;
-
- // copy the contents of the top stack frame into the AP_STACK
- for (i = 2; i < size_words; i++)
- {
- new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
+ // TODO: WRITE NOTE
+ if (is_case_cont_BCO) {
+
+ // TODO: WRITE NOTE
+ // A case cont. BCO is headed by a ret_frame with the returned value
+ // We need the frame here if we are going to yield to construct a well formed stack
+ // Then, just afterwards, we SLIDE the header off. This is generated code (see StgToByteCode)
+ int size_returned_frame =
+ (stack_head == (W_)&stg_ret_t_info)
+ ? 2 /* ret_t + tuple_BCO */
+ + /* Sp(2) is call_info which records the offset to the next frame
+ * See also Note [unboxed tuple bytecodes and tuple_BCO] */
+ ((ReadSpW(2) & 0xFF))
+ : 2; /* ret_* + return value */
+
+ StgPtr cont_frame_head
+ = (StgPtr)(SpW(size_returned_frame));
+ ASSERT(obj == UNTAG_CLOSURE((StgClosure*)ReadSpW(size_returned_frame+1)));
+
+ // stg_ctoi_*
+ int size_cont_frame_head =
+ is_ctoi_nontuple_frame(cont_frame_head)
+ ? 2 // info+bco
+#if defined(PROFILING)
+ : 5; // or info+bco+tuple_info+tuple_BCO+CCS
+#else
+ : 4; // or info+bco+tuple_info+tuple_BCO
+#endif
+
+ // Continuation stack is already well formed,
+ // so just copy it whole to the AP_STACK
+ size_words = size_returned_frame
+ + size_cont_frame_head
+ + BCO_BITMAP_SIZE(obj) /* payload of cont_frame */;
+ new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
+ new_aps->size = size_words;
+ new_aps->fun = &stg_dummy_ret_closure;
+
+ // (1) Fill in the payload of the AP_STACK:
+ for (i = 0; i < size_words; i++) {
+ new_aps->payload[i] = (StgClosure *)ReadSpW(i);
+ }
+ }
+ else {
+ // (1) Allocate memory for a new AP_STACK, enough to store
+ // the top stack frame plus an stg_apply_interp_info pointer
+ // and a pointer to the BCO
+ size_words = BCO_BITMAP_SIZE(obj) + 2;
+ new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
+ new_aps->size = size_words;
+ new_aps->fun = &stg_dummy_ret_closure;
+
+ // (1.1) the continuation frame
+ new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
+ new_aps->payload[1] = (StgClosure *)obj;
+
+ // (1.2.1) copy the args/free vars of the top stack frame into the AP_STACK
+ for (i = 2; i < size_words; i++) {
+ new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
+ }
}
// No write barrier is needed here as this is a new allocation
SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
- // Arrange the stack to call the breakpoint IO action, and
+ // (2) Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
// ioAction :: Addr# -- the breakpoint info module
@@ -1674,12 +1734,27 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(13);
- SpW(12) = (W_)obj;
- SpW(11) = (W_)&stg_apply_interp_info;
+ // (2.1) Construct the continuation to which we'll return in
+ // this thread after the `rts_breakpoint_io_action` returns.
+ //
+ // For case continuation BCOs, the continuation that re-runs
+ // it is always ready at the start of the BCO. It gets
+ // dropped soon after if we don't stop there by SLIDEing.
+ // See Note [TODO]
+ if (!is_case_cont_BCO) {
+ Sp_subW(2); // stg_apply_interp_info + StgBCO*
+
+ // (2.1.2) Write the continuation frame (above the stg_ret
+ // frame if one exists)
+ SpW(1) = (W_)obj;
+ SpW(0) = (W_)&stg_apply_interp_info;
+ }
+
+ // (2.2) The `rts_breakpoint_io_action` call
+ Sp_subW(11);
SpW(10) = (W_)new_aps;
- SpW(9) = (W_)False_closure; // True <=> an exception
- SpW(8) = (W_)&stg_ap_ppv_info;
+ SpW(9) = (W_)False_closure; // True <=> an exception
+ SpW(8) = (W_)&stg_ap_ppv_info;
SpW(7) = (W_)arg4_info_index;
SpW(6) = (W_)&stg_ap_n_info;
SpW(5) = (W_)BCO_LIT(arg3_info_mod_id);
=====================================
testsuite/tests/ghci.debugger/scripts/T26042g.stdout
=====================================
@@ -6,10 +6,13 @@ x :: Int = 14
11 succ x = (-) (x - 2) (x + 1)
^^^^^^^^^^^^^^^^^^^
12
-Stopped in T9.top, T26042g.hs:8:10-21
+Stopped in T9., T26042g.hs:(6,3)-(8,21)
_result :: Int = _
+5 top = do
+ vv
+6 case succ 14 of
7 5 -> 5
8 _ -> 6 + other 55
- ^^^^^^^^^^^^
+ ^^
9
171
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -147,7 +147,7 @@ test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script'])
# Step out tests
test('T26042b', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042b.hs'])], ghci_script, ['T26042b.script'])
-test('T26042c', [expect_broken(26042),extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
+test('T26042c', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
test('T26042d', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d.hs'])], ghci_script, ['T26042d.script'])
test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67e50cb9f350969d0c769d76ee6765f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67e50cb9f350969d0c769d76ee6765f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/ann-frame] Add primop to annotate the call stack with arbitrary data
by Hannes Siebenhandl (＠fendor) 23 Jul '25
by Hannes Siebenhandl (＠fendor) 23 Jul '25
23 Jul '25
Hannes Siebenhandl pushed to branch wip/fendor/ann-frame at Glasgow Haskell Compiler / GHC
Commits:
fa64fa3e by Ben Gamari at 2025-07-23T18:40:42+02:00
Add primop to annotate the call stack with arbitrary data
We introduce a new primop `annotateStack#` which allows us to push
arbitrary data onto the call-stack.
This allows us to extract the data later when decoding the stack, for
example when an exception is thrown, showing more information to the
user without having to annotate the full call-stack with `HasCallStack`
constraints.
A new stack frame value is introduced `AnnFrame`, which consists of
nothing but a generic payload.
The primop has a small wrapper API that allows users to annotate their
call-stack in programs.
There is a pure API and an IO-based one. The former is a little bit
dubious, as it affects the evaluation of a program, so use with care.
The latter is "safe", as it doesn't change the evaluation of the
program.
The stack annotation mechanism is similarly implemented to the
`ExceptionAnnotation` and `Exception`, there is a typeclass to indicate
something can be pushed onto the call-stack and all values are wrapped
in the existential `SomeStackAnnotation`, which recover the type of the
annotation payload.
There is currently no builtin way to show the stack annotations when
`Backtraces` are displayed (i.e., when showing stack traces to the user),
which we will address in a follow-up MR.
- - - - -
45 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- libraries/ghc-experimental/ghc-experimental.cabal.in
- + libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Stack.hs
- libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- + libraries/ghc-heap/tests/stack-annotation/Makefile
- + libraries/ghc-heap/tests/stack-annotation/TestUtils.hs
- + libraries/ghc-heap/tests/stack-annotation/all.T
- + libraries/ghc-heap/tests/stack-annotation/ann_frame001.hs
- + libraries/ghc-heap/tests/stack-annotation/ann_frame001.stdout
- + libraries/ghc-heap/tests/stack-annotation/ann_frame002.hs
- + libraries/ghc-heap/tests/stack-annotation/ann_frame002.stdout
- + libraries/ghc-heap/tests/stack-annotation/ann_frame003.hs
- + libraries/ghc-heap/tests/stack-annotation/ann_frame003.stdout
- + libraries/ghc-heap/tests/stack-annotation/ann_frame004.hs
- + libraries/ghc-heap/tests/stack-annotation/ann_frame004.stdout
- libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
- rts/ClosureFlags.c
- rts/LdvProfile.c
- rts/PrimOps.cmm
- rts/Printer.c
- rts/RetainerProfile.c
- rts/TraverseHeap.c
- rts/include/rts/storage/ClosureTypes.h
- rts/include/rts/storage/Closures.h
- rts/js/profiling.js
- rts/sm/Compact.c
- rts/sm/Evac.c
- rts/sm/NonMovingMark.c
- rts/sm/Sanity.c
- rts/sm/Scav.c
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- utils/deriveConstants/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa64fa3ebae3cea55798c29fded3ba1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa64fa3ebae3cea55798c29fded3ba1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/remove-deprecated-unstable-heap-representation-details] base: Remove unstable heap representation details from GHC.Exts
by Hannes Siebenhandl (＠fendor) 23 Jul '25
by Hannes Siebenhandl (＠fendor) 23 Jul '25
23 Jul '25
Hannes Siebenhandl pushed to branch wip/fendor/remove-deprecated-unstable-heap-representation-details at Glasgow Haskell Compiler / GHC
Commits:
7b4788c6 by fendor at 2025-07-23T18:21:57+02:00
base: Remove unstable heap representation details from GHC.Exts
- - - - -
5 changed files:
- libraries/base/src/GHC/Exts.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
Changes:
=====================================
libraries/base/src/GHC/Exts.hs
=====================================
@@ -26,12 +26,6 @@ module GHC.Exts
-- ** Legacy interface for arrays of arrays
module GHC.Internal.ArrayArray,
-- * Primitive operations
- {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
- Prim.BCO,
- {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
- Prim.mkApUpd0#,
- {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
- Prim.newBCO#,
module GHC.Prim,
module GHC.Prim.Ext,
-- ** Running 'RealWorld' state thread
@@ -131,9 +125,6 @@ import GHC.Prim hiding
, whereFrom#
, isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned#
- -- deprecated
- , BCO, mkApUpd0#, newBCO#
-
-- Don't re-export vector FMA instructions
, fmaddFloatX4#
, fmsubFloatX4#
@@ -256,8 +247,6 @@ import GHC.Prim hiding
, minWord8X32#
, minWord8X64#
)
-import qualified GHC.Prim as Prim
- ( BCO, mkApUpd0#, newBCO# )
import GHC.Prim.Ext
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -3221,8 +3221,6 @@ module GHC.Base where
{-# MINIMAL pure, ((<*>) | liftA2) #-}
type Array# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType
data Array# a
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -4115,7 +4113,6 @@ module GHC.Base where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
modInt :: Int -> Int -> Int
@@ -4174,7 +4171,6 @@ module GHC.Base where
negateInt8X64# :: Int8X64# -> Int8X64#
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
@@ -5398,8 +5394,6 @@ module GHC.Exts where
data Array# a
type ArrayArray# :: UnliftedType
newtype ArrayArray# = ArrayArray# (Array# ByteArray#)
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -6210,7 +6204,6 @@ module GHC.Exts where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mulIntMayOflo# :: Int# -> Int# -> Int#
@@ -6262,7 +6255,6 @@ module GHC.Exts where
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArrayArray# :: forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -3221,8 +3221,6 @@ module GHC.Base where
{-# MINIMAL pure, ((<*>) | liftA2) #-}
type Array# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType
data Array# a
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -4115,7 +4113,6 @@ module GHC.Base where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
modInt :: Int -> Int -> Int
@@ -4174,7 +4171,6 @@ module GHC.Base where
negateInt8X64# :: Int8X64# -> Int8X64#
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
@@ -5370,8 +5366,6 @@ module GHC.Exts where
data Array# a
type ArrayArray# :: UnliftedType
newtype ArrayArray# = ArrayArray# (Array# ByteArray#)
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -6182,7 +6176,6 @@ module GHC.Exts where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mulIntMayOflo# :: Int# -> Int# -> Int#
@@ -6234,7 +6227,6 @@ module GHC.Exts where
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArrayArray# :: forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -3221,8 +3221,6 @@ module GHC.Base where
{-# MINIMAL pure, ((<*>) | liftA2) #-}
type Array# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType
data Array# a
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -4118,7 +4116,6 @@ module GHC.Base where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
modInt :: Int -> Int -> Int
@@ -4177,7 +4174,6 @@ module GHC.Base where
negateInt8X64# :: Int8X64# -> Int8X64#
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
@@ -5538,8 +5534,6 @@ module GHC.Exts where
data Array# a
type ArrayArray# :: UnliftedType
newtype ArrayArray# = ArrayArray# (Array# ByteArray#)
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -6353,7 +6347,6 @@ module GHC.Exts where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mulIntMayOflo# :: Int# -> Int# -> Int#
@@ -6405,7 +6398,6 @@ module GHC.Exts where
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArrayArray# :: forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -3221,8 +3221,6 @@ module GHC.Base where
{-# MINIMAL pure, ((<*>) | liftA2) #-}
type Array# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType
data Array# a
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -4115,7 +4113,6 @@ module GHC.Base where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
modInt :: Int -> Int -> Int
@@ -4174,7 +4171,6 @@ module GHC.Base where
negateInt8X64# :: Int8X64# -> Int8X64#
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
@@ -5398,8 +5394,6 @@ module GHC.Exts where
data Array# a
type ArrayArray# :: UnliftedType
newtype ArrayArray# = ArrayArray# (Array# ByteArray#)
- type BCO :: *
- data BCO
type Bool :: *
data Bool = False | True
type ByteArray# :: UnliftedType
@@ -6210,7 +6204,6 @@ module GHC.Exts where
minusWord8X16# :: Word8X16# -> Word8X16# -> Word8X16#
minusWord8X32# :: Word8X32# -> Word8X32# -> Word8X32#
minusWord8X64# :: Word8X64# -> Word8X64# -> Word8X64#
- mkApUpd0# :: forall a. BCO -> (# a #)
mkWeak# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# :: forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mulIntMayOflo# :: Int# -> Int# -> Int#
@@ -6262,7 +6255,6 @@ module GHC.Exts where
newAlignedPinnedByteArray# :: forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArrayArray# :: forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #)
- newBCO# :: forall a d. ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# d -> (# State# d, BCO #)
newByteArray# :: forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newIOPort# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, IOPort# d a #)
newMVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). State# d -> (# State# d, MVar# d a #)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b4788c6dcb8801126f0ad4b2ce864f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b4788c6dcb8801126f0ad4b2ce864f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/fendor/remove-deprecated-unstable-heap-representation-details
by Hannes Siebenhandl (＠fendor) 23 Jul '25
by Hannes Siebenhandl (＠fendor) 23 Jul '25
23 Jul '25
Hannes Siebenhandl pushed new branch wip/fendor/remove-deprecated-unstable-heap-representation-details at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/remove-deprecated-unst…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/remove-stg_stackDecode] 4 commits: Move stack decoding logic from ghc-heap to ghc-internal
by Hannes Siebenhandl (＠fendor) 23 Jul '25
by Hannes Siebenhandl (＠fendor) 23 Jul '25
23 Jul '25
Hannes Siebenhandl pushed to branch wip/fendor/remove-stg_stackDecode at Glasgow Haskell Compiler / GHC
Commits:
904e49c3 by fendor at 2025-07-23T18:04:20+02:00
Move stack decoding logic from ghc-heap to ghc-internal
The stack decoding logic in `ghc-heap` is more sophisticated than the one
currently employed in `CloneStack`. We want to use the stack decoding
implementation from `ghc-heap` in `base`.
We cannot simply depend on `ghc-heap` in `base` due do bootstrapping
issues.
Thus, we move the code that is necessary to implement stack decoding to
`ghc-internal`. This is the right location, as we don't want to add a
new API to `base`.
Moving the stack decoding logic and re-exposing it in ghc-heap is
insufficient, though, as we have a dependency cycle between.
* ghc-heap depends on stage1:ghc-internal
* stage0:ghc depends on stage0:ghc-heap
To fix this, we remove ghc-heap from the set of `stage0` dependencies.
This is not entirely straight-forward, as a couple of boot dependencies,
such as `ghci` depend on `ghc-heap`.
Luckily, the boot compiler of GHC is now >=9.10, so we can migrate `ghci`
to use `ghc-internal` instead of `ghc-heap`, which already exports the
relevant modules.
However, we cannot 100% remove ghc's dependency on `ghc-heap`, since
when we compile `stage0:ghc`, `stage1:ghc-internal` is not yet
available.
Thus, when we compile with the boot-compiler, we still depend on an
older version of `ghc-heap`, and only use the modules from `ghc-internal`,
if the `ghc-internal` version is recent enough.
- - - - -
96ce880b by fendor at 2025-07-23T18:04:20+02:00
Implement `decode` in terms of `decodeStackWithIpe`
Uses the more efficient stack decoder implementation.
- - - - -
ca7fe070 by fendor at 2025-07-23T18:04:20+02:00
Remove stg_decodeStackzh
- - - - -
1e1e3965 by fendor at 2025-07-23T18:04:20+02:00
Remove deprecated functions from the ghci package
- - - - -
40 changed files:
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/ghc.cabal.in
- hadrian/src/Settings/Default.hs
- libraries/base/src/GHC/Stack/CloneStack.hs
- + libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hsc
- libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs
- libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-heap/cbits/HeapPrim.cmm → libraries/ghc-internal/cbits/HeapPrim.cmm
- libraries/ghc-heap/cbits/Stack.cmm → libraries/ghc-internal/cbits/Stack.cmm
- libraries/ghc-internal/cbits/StackCloningDecoding.cmm
- libraries/ghc-heap/cbits/Stack_c.c → libraries/ghc-internal/cbits/Stack_c.c
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/jsbits/base.js
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- + libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/TH.hs
- libraries/ghci/ghci.cabal.in
- rts/CloneStack.c
- rts/CloneStack.h
- rts/RtsSymbols.c
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee56ee36f8e54400daf112b38a0e2e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee56ee36f8e54400daf112b38a0e2e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/remove-stg_stackDecode] 4 commits: Move stack decoding logic from ghc-heap to ghc-internal
by Hannes Siebenhandl (＠fendor) 23 Jul '25
by Hannes Siebenhandl (＠fendor) 23 Jul '25
23 Jul '25
Hannes Siebenhandl pushed to branch wip/fendor/remove-stg_stackDecode at Glasgow Haskell Compiler / GHC
Commits:
dbc73039 by fendor at 2025-07-23T17:48:48+02:00
Move stack decoding logic from ghc-heap to ghc-internal
The stack decoding logic in `ghc-heap` is more sophisticated than the one
currently employed in `CloneStack`. We want to use the stack decoding
implementation from `ghc-heap` in `base`.
We cannot simply depend on `ghc-heap` in `base` due do bootstrapping
issues.
Thus, we move the code that is necessary to implement stack decoding to
`ghc-internal`. This is the right location, as we don't want to add a
new API to `base`.
Moving the stack decoding logic and re-exposing it in ghc-heap is
insufficient, though, as we have a dependency cycle between.
* ghc-heap depends on stage1:ghc-internal
* stage0:ghc depends on stage0:ghc-heap
To fix this, we remove ghc-heap from the set of `stage0` dependencies.
This is not entirely straight-forward, as a couple of boot dependencies,
such as `ghci` depend on `ghc-heap`.
Luckily, the boot compiler of GHC is now >=9.10, so we can migrate `ghci`
to use `ghc-internal` instead of `ghc-heap`, which already exports the
relevant modules.
However, we cannot 100% remove ghc's dependency on `ghc-heap`, since
when we compile `stage0:ghc`, `stage1:ghc-internal` is not yet
available.
Thus, when we compile with the boot-compiler, we still depend on an
older version of `ghc-heap`, and only use the modules from `ghc-internal`,
if the `ghc-internal` version is recent enough.
- - - - -
5636cf4e by fendor at 2025-07-23T17:48:52+02:00
Implement `decode` in terms of `decodeStackWithIpe`
Uses the more efficient stack decoder implementation.
- - - - -
a54842d4 by fendor at 2025-07-23T17:48:52+02:00
Remove stg_decodeStackzh
- - - - -
ee56ee36 by fendor at 2025-07-23T17:48:52+02:00
Remove deprecated functions from the ghci package
- - - - -
40 changed files:
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/ghc.cabal.in
- hadrian/src/Settings/Default.hs
- libraries/base/src/GHC/Stack/CloneStack.hs
- + libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hsc
- libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs
- libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-heap/cbits/HeapPrim.cmm → libraries/ghc-internal/cbits/HeapPrim.cmm
- libraries/ghc-heap/cbits/Stack.cmm → libraries/ghc-internal/cbits/Stack.cmm
- libraries/ghc-internal/cbits/StackCloningDecoding.cmm
- libraries/ghc-heap/cbits/Stack_c.c → libraries/ghc-internal/cbits/Stack_c.c
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/jsbits/base.js
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- + libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/TH.hs
- libraries/ghci/ghci.cabal.in
- rts/CloneStack.c
- rts/CloneStack.h
- rts/RtsSymbols.c
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ad94b6ccd3611027fe63db870b66c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ad94b6ccd3611027fe63db870b66c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0