Rodrigo Mesquita pushed to branch wip/romes/step-out-8 at Glasgow Haskell Compiler / GHC Commits: 6986f25d by Rodrigo Mesquita at 2025-06-27T16:19:01+01:00 Fixes - - - - - 03235e46 by Rodrigo Mesquita at 2025-06-27T16:43:36+01:00 Tweaks - - - - - 5851082d by Rodrigo Mesquita at 2025-06-27T17:21:06+01:00 Checkpoint but segfaults in GC - - - - - 748ddd68 by Rodrigo Mesquita at 2025-06-27T17:51:51+01:00 Start part 4.... - - - - - 11 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Breakpoints.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/Types.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Types/Tickish.hs - ghc/GHCi/UI.hs - rts/Interpreter.c Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -72,8 +72,6 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64) import qualified Data.List as List ( any ) import GHC.Exts -import GHC.HsToCore.Breakpoints (ModBreaks(..)) - -- ----------------------------------------------------------------------------- -- Unlinked BCOs @@ -110,14 +108,14 @@ assembleBCOs -> FlatBag (ProtoBCO Name) -> [TyCon] -> [(Name, ByteString)] - -> Maybe (InternalModBreaks, ModBreaks) + -> InternalModBreaks -> [SptEntry] -> IO CompiledByteCode assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do -- TODO: the profile should be bundled with the interpreter: the rts ways are -- fixed for an interpreter let itbls = mkITbls profile tycons - bcos <- mapM (assembleBCO (profilePlatform profile)) proto_bcos + bcos <- mapM (assembleBCO (profilePlatform profile)) proto_bcos return CompiledByteCode { bc_bcos = bcos , bc_itbls = itbls ===================================== compiler/GHC/ByteCode/Breakpoints.hs ===================================== @@ -13,12 +13,17 @@ module GHC.ByteCode.Breakpoints InternalModBreaks(..), CgBreakInfo(..) , mkInternalModBreaks - -- ** Operations - , getInternalBreak, addInternalBreak - -- ** Internal breakpoint identifier , InternalBreakpointId(..), BreakInfoIndex + -- * Operations + + -- ** Internal-level operations + , getInternalBreak, addInternalBreak + + -- ** Source-level information operations + , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS + -- * Utils , seqInternalModBreaks @@ -26,16 +31,19 @@ module GHC.ByteCode.Breakpoints where import GHC.Prelude +import GHC.Types.SrcLoc +import GHC.Types.Name.Occurrence import Control.DeepSeq import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IM +import GHC.HsToCore.Breakpoints import GHC.Iface.Syntax -import GHC.Types.Tickish import GHC.Unit.Module (Module) import GHC.Utils.Outputable import GHC.Utils.Panic +import Data.Array {- Note [ModBreaks vs InternalModBreaks] @@ -120,11 +128,19 @@ data InternalModBreaks = InternalModBreaks , imodBreaks_module :: !Module -- ^ Also cache the module corresponding to these 'InternalModBreaks', -- for instance for internal sanity checks. + + , imodBreaks_modBreaks :: !(Maybe ModBreaks) + -- ^ Store the original ModBreaks for this module, unchanged. + -- Allows us to query about source-level breakpoint information using + -- an internal breakpoint id. } -- | Construct an 'InternalModBreaks' -mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> InternalModBreaks -mkInternalModBreaks mod im = InternalModBreaks im mod +mkInternalModBreaks :: Module -> Maybe ModBreaks -> InternalModBreaks +mkInternalModBreaks mod mbs = + assertPpr (Just mod == (modBreaks_module <$> mbs)) + (text "Constructing InternalModBreaks with the ModBreaks of a different module!") $ + InternalModBreaks mempty mod mbs -- | Information about a breakpoint that we know at code-generation time -- In order to be used, this needs to be hydrated relative to the current HscEnv by @@ -161,6 +177,34 @@ assert_modules_match ibi_mod imbs_mod = (text "Tried to query the InternalModBreaks of module" <+> ppr imbs_mod <+> text "with an InternalBreakpointId for module" <+> ppr ibi_mod) +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- + +-- | Get the source span for this breakpoint +getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> Maybe SrcSpan +getBreakLoc = getBreakXXX modBreaks_locs + +-- | Get the vars for this breakpoint +getBreakVars :: InternalBreakpointId -> InternalModBreaks -> Maybe [OccName] +getBreakVars = getBreakXXX modBreaks_vars + +-- | Get the decls for this breakpoint +getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> Maybe [String] +getBreakDecls = getBreakXXX modBreaks_decls + +-- | Get the decls for this breakpoint +getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> Maybe (String, String) +getBreakCCS = getBreakXXX modBreaks_ccs + +-- | Internal utility to access a ModBreaks field at a particular breakpoint index +getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> Maybe a +getBreakXXX view (InternalBreakpointId ibi_mod ibi_ix) imbs = + assert_modules_match ibi_mod (imodBreaks_module imbs) $ do + let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix + mbs <- imodBreaks_modBreaks imbs + Just $ view mbs ! bi_tick_index (cgb_tick_id cgb) + -------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------- ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -46,7 +46,6 @@ import Foreign import Data.ByteString (ByteString) import qualified GHC.Exts.Heap as Heap import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList ) -import GHC.HsToCore.Breakpoints (ModBreaks) import GHC.Unit.Module -- ----------------------------------------------------------------------------- @@ -62,9 +61,8 @@ data CompiledByteCode = CompiledByteCode , bc_strs :: [(Name, ByteString)] -- ^ top-level strings (heap allocated) - , bc_breaks :: (Maybe (InternalModBreaks, ModBreaks)) - -- ^ All (internal and tick-level) breakpoint information (no information - -- if breakpoints are disabled). + , bc_breaks :: InternalModBreaks + -- ^ All breakpoint information (no information if breakpoints are disabled). -- -- This information is used when loading a bytecode object: we will -- construct the arrays to be used at runtime to trigger breakpoints then @@ -74,10 +72,6 @@ data CompiledByteCode = CompiledByteCode -- breakpoint information indexed by the internal breakpoint id here (in -- 'getModBreaks'). - -- TODO: If ModBreaks is serialized and reconstructed as part of ModDetails - -- we don't need to keep it in bc_breaks as it can be fetched from the - -- 'HomeModInfo' directly, right? - , bc_spt_entries :: ![SptEntry] -- ^ Static pointer table entries which should be loaded along with the -- BCOs. See Note [Grand plan for static forms] in ===================================== compiler/GHC/HsToCore/Breakpoints.hs ===================================== @@ -17,10 +17,6 @@ module GHC.HsToCore.Breakpoints ( -- * ModBreaks mkModBreaks, ModBreaks(..) - -- ** Queries - -- TODO: See where we could use these rather than using the arrays directly. - , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS - -- ** Re-exports BreakpointId , BreakpointId(..), BreakTickIndex ) where @@ -35,7 +31,6 @@ import GHC.Types.Name (OccName) import GHC.Types.Tickish (BreakTickIndex, BreakpointId(..)) import GHC.Unit.Module (Module) import GHC.Utils.Outputable -import GHC.Utils.Panic import Data.List (intersperse) -------------------------------------------------------------------------------- @@ -103,34 +98,6 @@ mkModBreaks interpreterProfiled modl extendedMixEntries , modBreaks_module = modl } --- | Get the source span for this breakpoint -getBreakLoc :: BreakpointId -> ModBreaks -> SrcSpan -getBreakLoc = getBreakXXX modBreaks_locs - --- | Get the vars for this breakpoint -getBreakVars :: BreakpointId -> ModBreaks -> [OccName] -getBreakVars = getBreakXXX modBreaks_vars - --- | Get the decls for this breakpoint -getBreakDecls :: BreakpointId -> ModBreaks -> [String] -getBreakDecls = getBreakXXX modBreaks_decls - --- | Get the decls for this breakpoint -getBreakCCS :: BreakpointId -> ModBreaks -> (String, String) -getBreakCCS = getBreakXXX modBreaks_ccs - --- | Internal utility to access a ModBreaks field at a particular breakpoint index -getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> BreakpointId -> ModBreaks -> a -getBreakXXX view (BreakpointId bid_mod ix) mbs = - assert_modules_match bid_mod (modBreaks_module mbs) $ view mbs ! ix - --- | Assert that the module in the 'BreakpointId' and in 'ModBreaks' match. -assert_modules_match :: Module -> Module -> a -> a -assert_modules_match bid_mod mbs_mod = - assertPpr (bid_mod == mbs_mod) - (text "Tried to query the ModBreaks of module" <+> ppr mbs_mod - <+> text "with a BreakpointId for module" <+> ppr bid_mod) - {- Note [Field modBreaks_decls] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -128,7 +128,6 @@ import GHC.Tc.Utils.Monad import GHC.IfaceToCore import GHC.HsToCore.Breakpoints -import GHC.ByteCode.Breakpoints import Control.Monad import Data.Array @@ -157,7 +156,7 @@ getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan getHistorySpan hug hist = do let bid = historyBreakpointId hist (_, brks) <- readModBreaks hug (bi_tick_mod bid) - return $ modBreaks_locs brks ! bi_tick_index bid + return $ getBreakLoc bid brks {- | Finds the enclosing top level function name -} -- ToDo: a better way to do this would be to keep hold of the decl_path computed @@ -358,7 +357,7 @@ handleRunStatus step expr bindings final_ids status history0 = do (_, tick_brks) <- liftIO $ readModBreaks hug (bi_tick_mod bid) breakArray <- getBreakArray interp ibi let - span = modBreaks_locs tick_brks ! bi_tick_index bid + span = getBreakLoc bid tick_brks decl = intercalate "." $ modBreaks_decls tick_brks ! bi_tick_index bid -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)? @@ -450,7 +449,7 @@ resumeExec step mbCnt -- When the user specified a break ignore count, set it -- in the interpreter case (mb_brkpt, mbCnt) of - (Just (bid, ibi), Just cnt) -> + (Just (_bid, ibi), Just cnt) -> setupBreakpoint interp ibi cnt _ -> return () @@ -476,6 +475,7 @@ getBreakArray :: GhcMonad m => Interp -> InternalBreakpointId -> m (ForeignRef B getBreakArray interp InternalBreakpointId{ibi_info_mod} = do breakArrays <- liftIO $ breakarray_env . linker_env . expectJust <$> Loader.getLoaderState interp + pprTraceM "hello" (ppr $ moduleEnvKeys breakArrays) return $ expectJust $ lookupModuleEnv breakArrays ibi_info_mod back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) @@ -506,7 +506,7 @@ moveHist fn = do Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>") Just (bid, _ibi) -> liftIO $ do (_, brks) <- readModBreaks (hsc_HUG hsc_env) (bi_tick_mod bid) - return $ modBreaks_locs brks ! bi_tick_index bid -- todo: getBreakLoc + return $ getBreakLoc bid brks (hsc_env1, names) <- liftIO $ bindLocalsAtBreakpoint hsc_env apStack span (snd <$> mb_info) let ic = hsc_IC hsc_env1 ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -28,10 +28,8 @@ module GHC.Runtime.Interpreter , whereFrom , getModBreaks , readModBreaks - , readModBreaksMaybe , seqHValue , evalBreakpointToId - , internalBreakIdToBreakId -- * The object-code linker , initObjLinker @@ -76,7 +74,6 @@ import GHCi.Message import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHCi.BreakArray (BreakArray) -import GHC.HsToCore.Breakpoints import GHC.ByteCode.Breakpoints import GHC.ByteCode.Types @@ -95,12 +92,10 @@ import GHC.Utils.Fingerprint import GHC.Unit.Module import GHC.Unit.Home.ModInfo -import GHC.Unit.Home.Graph (lookupHugByModule) import GHC.Unit.Env #if defined(HAVE_INTERNAL_INTERPRETER) import GHCi.Run -import GHC.Platform.Ways #endif import Control.Concurrent @@ -109,10 +104,8 @@ import Control.Monad.IO.Class import Control.Monad.Catch as MC (mask) import Data.Binary import Data.ByteString (ByteString) -import Data.Array ((!)) import Foreign hiding (void) import qualified GHC.Exts.Heap as Heap -import GHC.Stack.CCS (CostCentre,CostCentreStack) import System.Directory import System.Process import qualified GHC.InfoProv as InfoProv @@ -123,6 +116,7 @@ import qualified GHC.Unit.Home.Graph as HUG -- Standard libraries import GHC.Exts +import GHC.Stack {- Note [Remote GHCi] ~~~~~~~~~~~~~~~~~~ @@ -423,20 +417,6 @@ evalBreakpointToId eval_break = , ibi_info_index = eb_info_index eval_break } --- | An @'InternalBreakpointId'@ is an index into the @IntMap 'CgBreakInfo'@ of --- a specific module's @'ModBreaks'@. --- --- To get the @'BreakpointId'@, an index from the Core-level ticks to the --- associated SrcSpans and other source-level relevant details, lookup it up in --- the @'CgBreakInfo'@ of this internal id's module. --- --- See also Note [Breakpoint identifiers] -internalBreakIdToBreakId :: HomeUnitGraph -> InternalBreakpointId -> IO BreakpointId -internalBreakIdToBreakId hug ibi = do - (imbs, _) <- readModBreaks hug (ibi_info_mod ibi) - let CgBreakInfo{cgb_tick_id} = getInternalBreak ibi imbs - return cgb_tick_id - -- | Process the result of a Seq or ResumeSeq message. #2950 handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ()) handleSeqHValueStatus interp unit_env eval_status = @@ -456,16 +436,15 @@ handleSeqHValueStatus interp unit_env eval_status = Just break -> do let ibi = evalBreakpointToId break hug = ue_home_unit_graph unit_env - bi <- internalBreakIdToBreakId hug ibi -- Just case: Stopped at a breakpoint, extract SrcSpan information -- from the breakpoint. - mb_modbreaks <- getModBreaks . expectJust <$> lookupHugByModule (bi_tick_mod bi) hug + mb_modbreaks <- readModBreaks hug ibi case mb_modbreaks of -- Nothing case - should not occur! We should have the appropriate -- breakpoint information Nothing -> nothing_case - Just (_, modbreaks) -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! bi_tick_index bi + Just modbreaks -> put $ brackets . ppr $ getBreakLoc ibi modbreaks -- resume the seq (:force) processing in the iserv process withForeignRef resume_ctxt_fhv $ \hval -> do @@ -751,22 +730,19 @@ wormholeRef interp _r = case interpInstance interp of -- | Get the breakpoint information from the ByteCode object associated to this -- 'HomeModInfo'. -getModBreaks :: HomeModInfo -> Maybe (InternalModBreaks, ModBreaks) +getModBreaks :: HomeModInfo -> Maybe InternalModBreaks getModBreaks hmi | Just linkable <- homeModInfoByteCode hmi, -- The linkable may have 'DotO's as well; only consider BCOs. See #20570. [cbc] <- linkableBCOs linkable - = bc_breaks cbc + = Just $ bc_breaks cbc | otherwise = Nothing -- probably object code -- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module' -- from the 'HomeUnitGraph'. -readModBreaks :: HomeUnitGraph -> Module -> IO (InternalModBreaks, ModBreaks) -readModBreaks hug mod = expectJust <$> readModBreaksMaybe hug mod - -readModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe (InternalModBreaks, ModBreaks)) -readModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug +readModBreaks :: HasCallStack => HomeUnitGraph -> InternalBreakpointId -> IO (Maybe InternalModBreaks) +readModBreaks hug ibi = getModBreaks . expectJust <$> HUG.lookupHugByModule (ibi_info_mod ibi) hug -- ----------------------------------------------------------------------------- -- Misc utils ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -49,6 +49,9 @@ import GHCi.RemoteTypes import GHCi.Message ( Pipe ) import GHC.Platform +#if defined(HAVE_INTERNAL_INTERPRETER) +import GHC.Platform.Ways +#endif import GHC.Utils.TmpFs import GHC.Utils.Logger import GHC.Unit.Env ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -124,7 +124,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries flattenBind (StgRec bs) = bs (proto_bcos, BcM_State{..}) <- - runBc hsc_env this_mod $ do + runBc hsc_env this_mod mb_modBreaks $ do let flattened_binds = concatMap flattenBind (reverse lifted_binds) FlatBag.fromList (fromIntegral $ length flattened_binds) <$> mapM schemeTopBind flattened_binds @@ -132,13 +132,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries "Proto-BCOs" FormatByteCode (vcat (intersperse (char ' ') (map ppr $ elemsFlatBag proto_bcos))) - let all_mod_breaks = case mb_modBreaks of - Just modBreaks -> Just (internalBreaks, modBreaks) - Nothing -> Nothing - -- no modBreaks, thus drop all - -- internalBreaks? Will we ever want to have internal breakpoints in - -- a module for which we're not doing breakpoints at all? probably - cbc <- assembleBCOs profile proto_bcos tycs strings all_mod_breaks spt_entries + cbc <- assembleBCOs profile proto_bcos tycs strings internalBreaks spt_entries -- Squash space leaks in the CompiledByteCode. This is really -- important, because when loading a set of modules into GHCi @@ -397,44 +391,21 @@ schemeR_wrk fvs nm original_body (args, body) 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 - hsc_env <- getHscEnv - current_mod <- getCurrentModule - liftIO (readModBreaksMaybe (hsc_HUG hsc_env) current_mod) >>= \case - Nothing -> pure code - Just _ -> 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 - - ibi <- newBreakInfo breakInfo + 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 + + -- TODO: Lookup tick_id in InternalBreakMods and if it returns Nothing then + -- we don't have Breakpoint information for this Breakpoint so might as well + -- not emit the instruction. + ibi <- newBreakInfo breakInfo + return $ BRK_FUN ibi `consOL` code - return $ BRK_FUN ibi `consOL` code schemeER_wrk d p rhs = schemeE d 0 p rhs --- TODO: WHERE TO PUT --- Determine the GHCi-allocated 'BreakArray' and module pointer for the module --- from which the breakpoint originates. --- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs --- to refer to pointers in GHCi's address space. --- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by --- 'GHC.HsToCore.deSugar'. --- --- Breakpoints might be disabled because we're in TH, because --- @-fno-break-points@ was specified, or because a module was reloaded without --- reinitializing 'ModBreaks'. --- --- If the module stored in the breakpoint is the currently processed module, use --- the 'ModBreaks' from the state. --- If that is 'Nothing', consider breakpoints to be disabled and skip the --- instruction. --- --- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph). --- If the module doesn't exist there, or if the 'ModBreaks' value is --- uninitialized, skip the instruction (i.e. return Nothing). - getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)] getVarOffSets platform depth env = map getOffSet where @@ -2630,9 +2601,9 @@ newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (r, BcM_State)) deriving (Functor, Applicative, Monad, MonadIO) via (ReaderT BcM_Env (StateT BcM_State IO)) -runBc :: HscEnv -> Module -> BcM r -> IO (r, BcM_State) -runBc hsc_env this_mod (BcM m) - = m (BcM_Env hsc_env this_mod) (BcM_State 0 0 (mkInternalModBreaks this_mod mempty)) +runBc :: HscEnv -> Module -> Maybe ModBreaks -> BcM r -> IO (r, BcM_State) +runBc hsc_env this_mod mbs (BcM m) + = m (BcM_Env hsc_env this_mod) (BcM_State 0 0 (mkInternalModBreaks this_mod mbs)) instance HasDynFlags BcM where getDynFlags = hsc_dflags <$> getHscEnv ===================================== compiler/GHC/Types/Tickish.hs ===================================== @@ -45,6 +45,7 @@ import Language.Haskell.Syntax.Extension ( NoExtField ) import Data.Data import GHC.Utils.Outputable (Outputable (ppr), text, (<+>)) +import Data.Array {- ********************************************************************* * * @@ -179,6 +180,8 @@ deriving instance Data (GenTickish 'TickishPassCmm) -------------------------------------------------------------------------------- -- | Breakpoint tick index +-- newtype BreakTickIndex = BreakTickIndex Int +-- deriving (Eq, Ord, Data, Ix, NFData, Outputable) type BreakTickIndex = Int -- | Breakpoint identifier. ===================================== ghc/GHCi/UI.hs ===================================== @@ -66,7 +66,8 @@ import qualified GHC import GHC ( LoadHowMuch(..), Target(..), TargetId(..), Resume, SingleStep, Ghc, GetDocsFailure(..), pushLogHookM, - getModuleGraph, handleSourceError ) + getModuleGraph, handleSourceError, + InternalBreakpointId(..) ) import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation) import GHC.Hs.ImpExp import GHC.Hs @@ -78,7 +79,6 @@ import GHC.Core.TyCo.Ppr import GHC.Types.SafeHaskell ( getSafeMode ) import GHC.Types.SourceError ( SourceError ) import GHC.Types.Name -import GHC.Types.Breakpoint import GHC.Types.Var ( varType ) import GHC.Iface.Syntax ( showToHeader ) import GHC.Builtin.Names @@ -1572,11 +1572,9 @@ afterRunStmt step run_result = do Right names -> do show_types <- isOptionSet ShowType when show_types $ printTypeOfNames names - GHC.ExecBreak names mb_info + GHC.ExecBreak names mibi | first_resume : _ <- resumes - -> do mbid <- maybe (pure Nothing) - (fmap Just . liftIO . internalBreakIdToBreakId hug) mb_info - mb_id_loc <- toBreakIdAndLocation mbid + -> do mb_id_loc <- toBreakIdAndLocation mibi let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc if (null bCmd) then printStoppedAtBreakInfo first_resume names @@ -1609,13 +1607,13 @@ runAllocs m = do _ -> Nothing toBreakIdAndLocation :: GhciMonad m - => Maybe GHC.BreakpointId -> m (Maybe (Int, BreakLocation)) + => Maybe GHC.InternalBreakpointId -> m (Maybe (Int, BreakLocation)) toBreakIdAndLocation Nothing = return Nothing toBreakIdAndLocation (Just inf) = do st <- getGHCiState return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st), - breakModule loc == bi_tick_mod inf, - breakTick loc == bi_tick_index inf ] + breakModule loc == ibi_info_mod inf, + breakTick loc == ibi_info_index inf ] printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m () printStoppedAtBreakInfo res names = do @@ -3795,7 +3793,7 @@ pprStopped res = <> text (GHC.resumeDecl res)) <> char ',' <+> ppr (GHC.resumeSpan res) where - mb_mod_name = moduleName . bi_tick_mod . fst <$> GHC.resumeBreakpointId res + mb_mod_name = moduleName . ibi_info_mod . snd <$> GHC.resumeBreakpointId res showUnits :: GHC.GhcMonad m => m () showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do @@ -4350,11 +4348,11 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do case result of Left sdoc -> printForUser sdoc Right (loc, count) -> do - let bi = GHC.BreakpointId - { bi_tick_mod = breakModule loc - , bi_tick_index = breakTick loc + let ibi = GHC.InternalBreakpointId + { ibi_info_mod = breakModule loc + , ibi_info_index = breakTick loc } - setupBreakpoint bi count + setupBreakpoint ibi count ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int)) ignoreSwitch [break, count] = do @@ -4371,10 +4369,10 @@ getIgnoreCount str = where sdocIgnore = text "Ignore count" <+> quotes (text str) -setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m() +setupBreakpoint :: GhciMonad m => GHC.InternalBreakpointId -> Int -> m() setupBreakpoint loc count = do hsc_env <- GHC.getSession - GHC.setupBreakpoint hsc_env loc count + GHC.setupBreakpoint (hscInterp hsc_env) loc count backCmd :: GhciMonad m => String -> m () backCmd arg @@ -4450,7 +4448,7 @@ breakById inp = do Left sdoc -> printForUser sdoc Right (mod, mod_info, fun_str) -> do let modBreaks = expectJust (GHC.modInfoModBreaks mod_info) - findBreakAndSet mod $ \_ -> findBreakForBind fun_str modBreaks + findBreakAndSet mod $ \_ -> findBreakForBind fun_str (snd modBreaks) breakSyntax :: a breakSyntax = throwGhcException $ CmdLineError ("Syntax: :break [<mod>.]<func>[.<func>]\n" @@ -4729,10 +4727,10 @@ turnBreakOnOff onOff loc return loc { breakEnabled = onOff } setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m () -setBreakFlag md ix enaDisa = do +setBreakFlag md ix enaDisa = do let enaDisaToCount True = breakOn enaDisaToCount False = breakOff - setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa + setupBreakpoint (GHC.InternalBreakpointId md ix) $ enaDisaToCount enaDisa -- --------------------------------------------------------------------------- -- User code exception handling ===================================== rts/Interpreter.c ===================================== @@ -1454,9 +1454,9 @@ run_BCO: /* check for a breakpoint on the beginning of a let binding */ case bci_BRK_FUN: { - int arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index; + W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index; #if defined(PROFILING) - int arg5_cc; + W_ arg5_cc; #endif StgArrBytes *breakPoints; int returning_from_break, stop_next_breakpoint; @@ -1473,7 +1473,7 @@ run_BCO: arg1_brk_array = BCO_GET_LARGE_ARG; arg2_info_mod_name = BCO_GET_LARGE_ARG; arg3_info_mod_id = BCO_GET_LARGE_ARG; - arg4_info_index = BCO_GET_LARGE_ARG; + arg4_info_index = BCO_LIT(BCO_GET_LARGE_ARG); #if defined(PROFILING) arg5_cc = BCO_GET_LARGE_ARG; #else @@ -1506,11 +1506,11 @@ run_BCO: // 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)[BCO_LIT(arg4_info_index)]; + StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index]; if (stop_next_breakpoint == false && ignore_count > 0) { // decrement and write back ignore count - ((StgInt*)breakPoints->payload)[BCO_LIT(arg4_info_index)] = --ignore_count; + ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count; } else if (stop_next_breakpoint == true || ignore_count == 0) { @@ -1560,7 +1560,7 @@ run_BCO: SpW(10) = (W_)new_aps; SpW(9) = (W_)False_closure; // True <=> an exception SpW(8) = (W_)&stg_ap_ppv_info; - SpW(7) = (W_)BCO_LIT(arg4_info_index); + SpW(7) = (W_)arg4_info_index; SpW(6) = (W_)&stg_ap_n_info; SpW(5) = (W_)BCO_LIT(arg3_info_mod_id); SpW(4) = (W_)&stg_ap_n_info; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a1ba3e64481e43efc1f40cf9001abc... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a1ba3e64481e43efc1f40cf9001abc... You're receiving this email because of your account on gitlab.haskell.org.