Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC Commits: 84d921d8 by Rodrigo Mesquita at 2025-07-21T12:14:55+01:00 cleanup: Move dehydrateCgBreakInfo to Stg2Bc This no longer has anything to do with Core. - - - - - d4b7cf54 by Ben Gamari at 2025-07-21T12:14:55+01:00 rts/Interpreter: Factor out ctoi tuple info tables into data Instead of a massive case let's put this into data which we can reuse elsewhere. - - - - - 0e1bbc4d by Rodrigo Mesquita at 2025-07-21T12:14:55+01:00 rts/Disassembler: Fix spacing of BRK_FUN - - - - - 04e8b22f by Rodrigo Mesquita at 2025-07-22T08:32:55+01:00 debugger: Fix bciPtr in Step-out We need to use `BCO_NEXT` to move bciPtr to ix=1, because ix=0 points to the instruction itself! I do not understand how this didn't crash before. - - - - - f9c45e55 by Rodrigo Mesquita at 2025-07-22T08:32:55+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. - - - - - a44c38a4 by Rodrigo Mesquita at 2025-07-22T16:05:10+01:00 Making stg_ret_*_ stay at the start of the BCO - - - - - 9acb2611 by Rodrigo Mesquita at 2025-07-22T18:34:27+01:00 Actually, do add the ctoi frame header but remove it with static slides always in case conts - - - - - d21e2c6e by Rodrigo Mesquita at 2025-07-22T18:34:27+01:00 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 - - - - - 83386a54 by Rodrigo Mesquita at 2025-07-22T18:51:16+01:00 Beautiful again - - - - - 8c0283cd by Rodrigo Mesquita at 2025-07-22T19:10:32+01:00 Almost there - - - - - 13 changed files: - compiler/GHC/ByteCode/Breakpoints.hs - compiler/GHC/CoreToIface.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/Disassembler.c - rts/Interpreter.c - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.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/CoreToIface.hs ===================================== @@ -44,16 +44,12 @@ module GHC.CoreToIface -- * Other stuff , toIfaceLFInfo , toIfaceBooleanFormula - -- * CgBreakInfo - , dehydrateCgBreakInfo ) where import GHC.Prelude import GHC.StgToCmm.Types -import GHC.ByteCode.Types - import GHC.Core import GHC.Core.TyCon hiding ( pprPromotionQuote ) import GHC.Core.Coercion.Axiom @@ -702,16 +698,6 @@ toIfaceLFInfo nm lfi = case lfi of LFLetNoEscape -> panic "toIfaceLFInfo: LFLetNoEscape" --- Dehydrating CgBreakInfo - -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo -dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid = - CgBreakInfo - { cgb_tyvars = map toIfaceTvBndr ty_vars - , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets - , cgb_resty = toIfaceType tick_ty - , cgb_tick_id = bid - } {- Note [Inlining and hs-boot files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== 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) @@ -2684,3 +2742,14 @@ getCurrentModBreaks = BcM $ \env st -> return (modBreaks env, st) tickFS :: FastString tickFS = fsLit "ticked" + +-- Dehydrating 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 + , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets + , cgb_resty = toIfaceType tick_ty + , cgb_tick_id = bid + } ===================================== 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/Disassembler.c ===================================== @@ -92,9 +92,9 @@ disInstr ( StgBCO *bco, int pc ) info_wix = BCO_NEXT; np = BCO_GET_LARGE_ARG; debugBelch ("BRK_FUN " ); printPtr( ptrs[p1] ); - debugBelch("%" FMT_Word, literals[info_mod] ); - debugBelch("%" FMT_Word, literals[info_unit_id] ); - debugBelch("%" FMT_Word, info_wix ); + debugBelch(" %" FMT_Word, literals[info_mod] ); + debugBelch(" %" FMT_Word, literals[info_unit_id] ); + debugBelch(" %" FMT_Word, info_wix ); CostCentre* cc = (CostCentre*)literals[np]; if (cc) { debugBelch(" %s", cc->label); ===================================== 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,19 @@ 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 + ); +} + int rts_stop_on_exception = 0; /* --------------------------------------------------------------------------- @@ -473,6 +499,72 @@ void interp_shutdown( void ){ #endif +const StgPtr ctoi_tuple_infos[] = { + (StgPtr) &stg_ctoi_t0_info, + (StgPtr) &stg_ctoi_t1_info, + (StgPtr) &stg_ctoi_t2_info, + (StgPtr) &stg_ctoi_t3_info, + (StgPtr) &stg_ctoi_t4_info, + (StgPtr) &stg_ctoi_t5_info, + (StgPtr) &stg_ctoi_t6_info, + (StgPtr) &stg_ctoi_t7_info, + (StgPtr) &stg_ctoi_t8_info, + (StgPtr) &stg_ctoi_t9_info, + (StgPtr) &stg_ctoi_t10_info, + (StgPtr) &stg_ctoi_t11_info, + (StgPtr) &stg_ctoi_t12_info, + (StgPtr) &stg_ctoi_t13_info, + (StgPtr) &stg_ctoi_t14_info, + (StgPtr) &stg_ctoi_t15_info, + (StgPtr) &stg_ctoi_t16_info, + (StgPtr) &stg_ctoi_t17_info, + (StgPtr) &stg_ctoi_t18_info, + (StgPtr) &stg_ctoi_t19_info, + (StgPtr) &stg_ctoi_t20_info, + (StgPtr) &stg_ctoi_t21_info, + (StgPtr) &stg_ctoi_t22_info, + (StgPtr) &stg_ctoi_t23_info, + (StgPtr) &stg_ctoi_t24_info, + (StgPtr) &stg_ctoi_t25_info, + (StgPtr) &stg_ctoi_t26_info, + (StgPtr) &stg_ctoi_t27_info, + (StgPtr) &stg_ctoi_t28_info, + (StgPtr) &stg_ctoi_t29_info, + (StgPtr) &stg_ctoi_t30_info, + (StgPtr) &stg_ctoi_t31_info, + (StgPtr) &stg_ctoi_t32_info, + (StgPtr) &stg_ctoi_t33_info, + (StgPtr) &stg_ctoi_t34_info, + (StgPtr) &stg_ctoi_t35_info, + (StgPtr) &stg_ctoi_t36_info, + (StgPtr) &stg_ctoi_t37_info, + (StgPtr) &stg_ctoi_t38_info, + (StgPtr) &stg_ctoi_t39_info, + (StgPtr) &stg_ctoi_t40_info, + (StgPtr) &stg_ctoi_t41_info, + (StgPtr) &stg_ctoi_t42_info, + (StgPtr) &stg_ctoi_t43_info, + (StgPtr) &stg_ctoi_t44_info, + (StgPtr) &stg_ctoi_t45_info, + (StgPtr) &stg_ctoi_t46_info, + (StgPtr) &stg_ctoi_t47_info, + (StgPtr) &stg_ctoi_t48_info, + (StgPtr) &stg_ctoi_t49_info, + (StgPtr) &stg_ctoi_t50_info, + (StgPtr) &stg_ctoi_t51_info, + (StgPtr) &stg_ctoi_t52_info, + (StgPtr) &stg_ctoi_t53_info, + (StgPtr) &stg_ctoi_t54_info, + (StgPtr) &stg_ctoi_t55_info, + (StgPtr) &stg_ctoi_t56_info, + (StgPtr) &stg_ctoi_t57_info, + (StgPtr) &stg_ctoi_t58_info, + (StgPtr) &stg_ctoi_t59_info, + (StgPtr) &stg_ctoi_t60_info, + (StgPtr) &stg_ctoi_t61_info, + (StgPtr) &stg_ctoi_t62_info, +}; + #if defined(PROFILING) // @@ -642,13 +734,12 @@ interpretBCO (Capability* cap) ASSERT(get_itbl((StgClosure*)bco)->type == BCO); StgWord16* instrs = (StgWord16*)(bco->instrs->payload); - StgWord16 bci = instrs[0]; + int bciPtr = 0; + StgWord16 bci = BCO_NEXT; /* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first * instruction in a BCO */ if ((bci & 0xFF) == bci_BRK_FUN) { - // Define rest of variables used by BCO_* Macros - int bciPtr = 0; W_ arg1_brk_array, arg4_info_index; arg1_brk_array = BCO_GET_LARGE_ARG; @@ -779,7 +870,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 ) { @@ -1021,11 +1111,37 @@ 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 to drop the RET_BCO frame header, + // but not its arguments (which are expected at the top when running the BCO). + // NOTE: Always a return_pointer (ie not a tuple ctoi frame!) + + // Make sure stack is headed by a ctoi nontuple frame then drop it. + // The arguments to the BCO continuation stay on top of the stack + ASSERT(ReadSpW(0) == (W_)&stg_ctoi_R1p_info); + // TODO: NO LONGER NEEDED BC NOW WE KEEP THE FRAMES Sp_addW(2); + + // Plus 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: @@ -1094,8 +1210,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 @@ -1103,8 +1220,74 @@ 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 + 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 + /* Drop the RET_BCO header (next_frame), + * but not its arguments (which are expected at the top when running the BCO) + * + * NEVERMINDDDDD JUST KEEP THE FRAMES. + * WRITE NEW NOTE + */ +// W_ n = offset; +// W_ by = is_ctoi_nontuple_frame(next_frame) +// ? 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 +// SpSlide(n, by); + + /* 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: { @@ -1271,8 +1454,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 // // | .... | // +---------------+ @@ -1289,10 +1472,6 @@ do_apply: // +---------------+ // | fv1 | // +---------------+ - // | BCO | - // +---------------+ - // | stg_ctoi_ret_ | - // +---------------+ // | retval | // +---------------+ // @@ -1310,68 +1489,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 - 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); @@ -1454,7 +1571,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; @@ -1522,29 +1639,81 @@ run_BCO: 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); + W_ stack_head = ReadSpW(0); + + 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; + + // 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 */ + + StgClosure* cont_frame_head + = (StgClosure*)(SpW(size_returned_frame)); + + // stg_ctoi_* + int size_cont_frame = + 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; + 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 @@ -1557,12 +1726,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); @@ -1733,6 +1917,10 @@ run_BCO: Sp_subW(2); SpW(1) = BCO_PTR(o_bco); SpW(0) = (W_)&stg_ctoi_R1p_info; + + // The o_bco expects its arguments (as per the BCO_BITMAP_SIZE) to + // be found on the stack before it. + IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);); #if defined(PROFILING) Sp_subW(2); SpW(1) = (W_)cap->r.rCCCS; @@ -1746,6 +1934,8 @@ run_BCO: SpW(-2) = (W_)&stg_ctoi_R1n_info; SpW(-1) = BCO_PTR(o_bco); Sp_subW(2); + + IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);); #if defined(PROFILING) Sp_subW(2); SpW(1) = (W_)cap->r.rCCCS; @@ -1759,6 +1949,8 @@ run_BCO: SpW(-2) = (W_)&stg_ctoi_F1_info; SpW(-1) = BCO_PTR(o_bco); Sp_subW(2); + + IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);); #if defined(PROFILING) Sp_subW(2); SpW(1) = (W_)cap->r.rCCCS; @@ -1772,6 +1964,8 @@ run_BCO: SpW(-2) = (W_)&stg_ctoi_D1_info; SpW(-1) = BCO_PTR(o_bco); Sp_subW(2); + + IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);); #if defined(PROFILING) Sp_subW(2); SpW(1) = (W_)cap->r.rCCCS; @@ -1785,6 +1979,8 @@ run_BCO: SpW(-2) = (W_)&stg_ctoi_L1_info; SpW(-1) = BCO_PTR(o_bco); Sp_subW(2); + + IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);); #if defined(PROFILING) Sp_subW(2); SpW(1) = (W_)cap->r.rCCCS; @@ -1798,6 +1994,8 @@ run_BCO: SpW(-2) = (W_)&stg_ctoi_V_info; SpW(-1) = BCO_PTR(o_bco); Sp_subW(2); + + IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);); #if defined(PROFILING) Sp_subW(2); SpW(1) = (W_)cap->r.rCCCS; @@ -1811,6 +2009,7 @@ run_BCO: W_ tuple_info = (W_)BCO_LIT(BCO_GET_LARGE_ARG); W_ o_tuple_bco = BCO_GET_LARGE_ARG; + IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size);); #if defined(PROFILING) SpW(-1) = (W_)cap->r.rCCCS; Sp_subW(1); @@ -1819,82 +2018,11 @@ run_BCO: SpW(-1) = BCO_PTR(o_tuple_bco); SpW(-2) = tuple_info; SpW(-3) = BCO_PTR(o_bco); - W_ ctoi_t_offset; int tuple_stack_words = (tuple_info >> 24) & 0xff; - switch(tuple_stack_words) { - case 0: ctoi_t_offset = (W_)&stg_ctoi_t0_info; break; - case 1: ctoi_t_offset = (W_)&stg_ctoi_t1_info; break; - case 2: ctoi_t_offset = (W_)&stg_ctoi_t2_info; break; - case 3: ctoi_t_offset = (W_)&stg_ctoi_t3_info; break; - case 4: ctoi_t_offset = (W_)&stg_ctoi_t4_info; break; - case 5: ctoi_t_offset = (W_)&stg_ctoi_t5_info; break; - case 6: ctoi_t_offset = (W_)&stg_ctoi_t6_info; break; - case 7: ctoi_t_offset = (W_)&stg_ctoi_t7_info; break; - case 8: ctoi_t_offset = (W_)&stg_ctoi_t8_info; break; - case 9: ctoi_t_offset = (W_)&stg_ctoi_t9_info; break; - - case 10: ctoi_t_offset = (W_)&stg_ctoi_t10_info; break; - case 11: ctoi_t_offset = (W_)&stg_ctoi_t11_info; break; - case 12: ctoi_t_offset = (W_)&stg_ctoi_t12_info; break; - case 13: ctoi_t_offset = (W_)&stg_ctoi_t13_info; break; - case 14: ctoi_t_offset = (W_)&stg_ctoi_t14_info; break; - case 15: ctoi_t_offset = (W_)&stg_ctoi_t15_info; break; - case 16: ctoi_t_offset = (W_)&stg_ctoi_t16_info; break; - case 17: ctoi_t_offset = (W_)&stg_ctoi_t17_info; break; - case 18: ctoi_t_offset = (W_)&stg_ctoi_t18_info; break; - case 19: ctoi_t_offset = (W_)&stg_ctoi_t19_info; break; - - case 20: ctoi_t_offset = (W_)&stg_ctoi_t20_info; break; - case 21: ctoi_t_offset = (W_)&stg_ctoi_t21_info; break; - case 22: ctoi_t_offset = (W_)&stg_ctoi_t22_info; break; - case 23: ctoi_t_offset = (W_)&stg_ctoi_t23_info; break; - case 24: ctoi_t_offset = (W_)&stg_ctoi_t24_info; break; - case 25: ctoi_t_offset = (W_)&stg_ctoi_t25_info; break; - case 26: ctoi_t_offset = (W_)&stg_ctoi_t26_info; break; - case 27: ctoi_t_offset = (W_)&stg_ctoi_t27_info; break; - case 28: ctoi_t_offset = (W_)&stg_ctoi_t28_info; break; - case 29: ctoi_t_offset = (W_)&stg_ctoi_t29_info; break; - - case 30: ctoi_t_offset = (W_)&stg_ctoi_t30_info; break; - case 31: ctoi_t_offset = (W_)&stg_ctoi_t31_info; break; - case 32: ctoi_t_offset = (W_)&stg_ctoi_t32_info; break; - case 33: ctoi_t_offset = (W_)&stg_ctoi_t33_info; break; - case 34: ctoi_t_offset = (W_)&stg_ctoi_t34_info; break; - case 35: ctoi_t_offset = (W_)&stg_ctoi_t35_info; break; - case 36: ctoi_t_offset = (W_)&stg_ctoi_t36_info; break; - case 37: ctoi_t_offset = (W_)&stg_ctoi_t37_info; break; - case 38: ctoi_t_offset = (W_)&stg_ctoi_t38_info; break; - case 39: ctoi_t_offset = (W_)&stg_ctoi_t39_info; break; - - case 40: ctoi_t_offset = (W_)&stg_ctoi_t40_info; break; - case 41: ctoi_t_offset = (W_)&stg_ctoi_t41_info; break; - case 42: ctoi_t_offset = (W_)&stg_ctoi_t42_info; break; - case 43: ctoi_t_offset = (W_)&stg_ctoi_t43_info; break; - case 44: ctoi_t_offset = (W_)&stg_ctoi_t44_info; break; - case 45: ctoi_t_offset = (W_)&stg_ctoi_t45_info; break; - case 46: ctoi_t_offset = (W_)&stg_ctoi_t46_info; break; - case 47: ctoi_t_offset = (W_)&stg_ctoi_t47_info; break; - case 48: ctoi_t_offset = (W_)&stg_ctoi_t48_info; break; - case 49: ctoi_t_offset = (W_)&stg_ctoi_t49_info; break; - - case 50: ctoi_t_offset = (W_)&stg_ctoi_t50_info; break; - case 51: ctoi_t_offset = (W_)&stg_ctoi_t51_info; break; - case 52: ctoi_t_offset = (W_)&stg_ctoi_t52_info; break; - case 53: ctoi_t_offset = (W_)&stg_ctoi_t53_info; break; - case 54: ctoi_t_offset = (W_)&stg_ctoi_t54_info; break; - case 55: ctoi_t_offset = (W_)&stg_ctoi_t55_info; break; - case 56: ctoi_t_offset = (W_)&stg_ctoi_t56_info; break; - case 57: ctoi_t_offset = (W_)&stg_ctoi_t57_info; break; - case 58: ctoi_t_offset = (W_)&stg_ctoi_t58_info; break; - case 59: ctoi_t_offset = (W_)&stg_ctoi_t59_info; break; - - case 60: ctoi_t_offset = (W_)&stg_ctoi_t60_info; break; - case 61: ctoi_t_offset = (W_)&stg_ctoi_t61_info; break; - case 62: ctoi_t_offset = (W_)&stg_ctoi_t62_info; break; - - default: barf("unsupported tuple size %d", tuple_stack_words); + if (tuple_stack_words > 62) { + barf("unsupported tuple size %d", tuple_stack_words); } - + W_ ctoi_t_offset = (W_) ctoi_tuple_infos[tuple_stack_words]; SpW(-4) = ctoi_t_offset; Sp_subW(4); goto nextInsn; @@ -1987,15 +2115,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/count-deps/CountDepsAst.stdout ===================================== @@ -5,14 +5,9 @@ GHC.Builtin.Types GHC.Builtin.Types.Literals GHC.Builtin.Types.Prim GHC.Builtin.Uniques -GHC.ByteCode.Breakpoints -GHC.ByteCode.Types GHC.Cmm.BlockId GHC.Cmm.CLabel GHC.Cmm.Dataflow.Label -GHC.Cmm.Expr -GHC.Cmm.MachOp -GHC.Cmm.Reg GHC.Cmm.Type GHC.CmmToAsm.CFG.Weight GHC.Core @@ -65,7 +60,6 @@ GHC.Data.FastMutInt GHC.Data.FastString GHC.Data.FastString.Env GHC.Data.FiniteMap -GHC.Data.FlatBag GHC.Data.Graph.Directed GHC.Data.Graph.Directed.Internal GHC.Data.Graph.UnVar @@ -77,7 +71,6 @@ GHC.Data.Maybe GHC.Data.OrdList GHC.Data.OsPath GHC.Data.Pair -GHC.Data.SmallArray GHC.Data.Strict GHC.Data.StringBuffer GHC.Data.TrieMap @@ -111,8 +104,6 @@ GHC.Hs.Pat GHC.Hs.Specificity GHC.Hs.Type GHC.Hs.Utils -GHC.HsToCore.Breakpoints -GHC.HsToCore.Ticks GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Flags @@ -182,7 +173,6 @@ GHC.Types.RepType GHC.Types.SafeHaskell GHC.Types.SourceFile GHC.Types.SourceText -GHC.Types.SptEntry GHC.Types.SrcLoc GHC.Types.ThLevelIndex GHC.Types.Tickish ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -5,14 +5,9 @@ GHC.Builtin.Types GHC.Builtin.Types.Literals GHC.Builtin.Types.Prim GHC.Builtin.Uniques -GHC.ByteCode.Breakpoints -GHC.ByteCode.Types GHC.Cmm.BlockId GHC.Cmm.CLabel GHC.Cmm.Dataflow.Label -GHC.Cmm.Expr -GHC.Cmm.MachOp -GHC.Cmm.Reg GHC.Cmm.Type GHC.CmmToAsm.CFG.Weight GHC.Core @@ -66,7 +61,6 @@ GHC.Data.FastMutInt GHC.Data.FastString GHC.Data.FastString.Env GHC.Data.FiniteMap -GHC.Data.FlatBag GHC.Data.Graph.Directed GHC.Data.Graph.Directed.Internal GHC.Data.Graph.Directed.Reachability @@ -79,7 +73,6 @@ GHC.Data.Maybe GHC.Data.OrdList GHC.Data.OsPath GHC.Data.Pair -GHC.Data.SmallArray GHC.Data.Strict GHC.Data.StringBuffer GHC.Data.TrieMap @@ -115,10 +108,8 @@ GHC.Hs.Pat GHC.Hs.Specificity GHC.Hs.Type GHC.Hs.Utils -GHC.HsToCore.Breakpoints GHC.HsToCore.Errors.Types GHC.HsToCore.Pmc.Solver.Types -GHC.HsToCore.Ticks GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Flags @@ -205,7 +196,6 @@ GHC.Types.RepType GHC.Types.SafeHaskell GHC.Types.SourceFile GHC.Types.SourceText -GHC.Types.SptEntry GHC.Types.SrcLoc GHC.Types.Target GHC.Types.ThLevelIndex ===================================== 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/-/compare/5da18c2307b56e032a14577806e163c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5da18c2307b56e032a14577806e163c... You're receiving this email because of your account on gitlab.haskell.org.