Rodrigo Mesquita pushed to branch wip/romes/step-out-5 at Glasgow Haskell Compiler / GHC
Commits:
d61e3fbc by Rodrigo Mesquita at 2025-06-24T22:57:30+01:00
WIP: Working on RESUME_STEP_OUT for case continuations [skip ci]
- - - - -
6 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/StgToByteCode.hs
- rts/Disassembler.c
- rts/Interpreter.c
- rts/include/rts/Bytecodes.h
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -856,7 +856,7 @@ assembleI platform i = case i of
, Op np
]
- BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp active]
+ RESUME_STEP_OUT on prev next -> emit_ bci_RESUME_STEP_OUT [SmallOp on, SmallOp prev, SmallOp next]
#if MIN_VERSION_rts(1,0,3)
BCO_NAME name -> do np <- lit1 (BCONPtrStr name)
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -8,10 +8,11 @@
-- | Bytecode instruction definitions
module GHC.ByteCode.Instr (
- BCInstr(..), ProtoBCO(..), bciStackUse, LocalLabel(..)
+ BCInstr(..), ProtoBCO(..), bciStackUse, bciSize, LocalLabel(..)
) where
import GHC.Prelude
+import GHC.Platform
import GHC.ByteCode.Types
import GHC.Cmm.Type (Width)
@@ -273,8 +274,10 @@ data BCInstr
(RemotePtr CostCentre)
-- An internal breakpoint for triggering a break on any case alternative
- -- See Note [Debugger: BRK_ALTS]
- | BRK_ALTS !Word16 {- enabled? -}
+ -- See Note [Debugger: RESUME_STEP_OUT]
+ | RESUME_STEP_OUT !Word16 {- enabled? -}
+ !Word16 {- offset to prev RESUME_STEP_OUT within same BCO -}
+ !Word16 {- offset to next RESUME_STEP_OUT within same BCO -}
#if MIN_VERSION_rts(1,0,3)
-- | A "meta"-instruction for recording the name of a BCO for debugging purposes.
@@ -471,7 +474,8 @@ instance Outputable BCInstr where
<+> text "" <+> text "" <+> ppr tickx
<+> text "" <+> text "" <+> ppr infox
<+> text "<cc>"
- ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active
+ ppr (RESUME_STEP_OUT on prev next)
+ = text "RESUME_STEP_OUT" <+> ppr on <+> ppr prev <+> ppr next
#if MIN_VERSION_rts(1,0,3)
ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm)
#endif
@@ -597,7 +601,7 @@ bciStackUse OP_INDEX_ADDR{} = 0
bciStackUse SWIZZLE{} = 0
bciStackUse BRK_FUN{} = 0
-bciStackUse BRK_ALTS{} = 0
+bciStackUse RESUME_STEP_OUT{} = 0
-- These insns actually reduce stack use, but we need the high-tide level,
-- so can't use this info. Not that it matters much.
@@ -608,3 +612,121 @@ bciStackUse PACK{} = 1 -- worst case is PACK 0 words
#if MIN_VERSION_rts(1,0,3)
bciStackUse BCO_NAME{} = 0
#endif
+
+-- | The size of a bytecode instruction's arguments in number of Word16 (the
+-- size of bytecode instructions)
+bciSize :: Platform -> BCInstr -> Word16
+bciSize p STKCHECK{} = wordSizeInBc p
+bciSize p PUSH_L{} = wordSizeInBc p
+bciSize p PUSH_LL{} = 2*wordSizeInBc p
+bciSize p PUSH_LLL{} = 3*wordSizeInBc p
+bciSize p PUSH8{} = wordSizeInBc p
+bciSize p PUSH16{} = wordSizeInBc p
+bciSize p PUSH32{} = wordSizeInBc p
+bciSize p PUSH8_W{} = wordSizeInBc p
+bciSize p PUSH16_W{} = wordSizeInBc p
+bciSize p PUSH32_W{} = wordSizeInBc p
+bciSize p PUSH_G{} = wordSizeInBc p
+bciSize p PUSH_PRIMOP{} = wordSizeInBc p
+bciSize p PUSH_BCO{} = wordSizeInBc p
+bciSize p PUSH_ALTS{} = wordSizeInBc p
+bciSize p PUSH_ALTS_TUPLE{} = 3*wordSizeInBc p
+bciSize _ (PUSH_PAD8) = 0
+bciSize _ (PUSH_PAD16) = 0
+bciSize _ (PUSH_PAD32) = 0
+bciSize p (PUSH_UBX8 _) = wordSizeInBc p
+bciSize p (PUSH_UBX16 _) = wordSizeInBc p
+bciSize p (PUSH_UBX32 _) = wordSizeInBc p
+bciSize p (PUSH_UBX{}) = 2*wordSizeInBc p
+bciSize p PUSH_ADDR{} = 1+wordSizeInBc p
+bciSize _ PUSH_APPLY_N{} = 0
+bciSize _ PUSH_APPLY_V{} = 0
+bciSize _ PUSH_APPLY_F{} = 0
+bciSize _ PUSH_APPLY_D{} = 0
+bciSize _ PUSH_APPLY_L{} = 0
+bciSize _ PUSH_APPLY_P{} = 0
+bciSize _ PUSH_APPLY_PP{} = 0
+bciSize _ PUSH_APPLY_PPP{} = 0
+bciSize _ PUSH_APPLY_PPPP{} = 0
+bciSize _ PUSH_APPLY_PPPPP{} = 0
+bciSize _ PUSH_APPLY_PPPPPP{} = 0
+bciSize p ALLOC_AP{} = wordSizeInBc p
+bciSize p ALLOC_AP_NOUPD{} = wordSizeInBc p
+bciSize p ALLOC_PAP{} = 2*wordSizeInBc p
+bciSize p (UNPACK _) = wordSizeInBc p
+bciSize _ LABEL{} = 0
+bciSize p TESTLT_I{} = 2*wordSizeInBc p
+bciSize p TESTEQ_I{} = 2*wordSizeInBc p
+bciSize p TESTLT_W{} = 2*wordSizeInBc p
+bciSize p TESTEQ_W{} = 2*wordSizeInBc p
+bciSize p TESTLT_I64{} = 2*wordSizeInBc p
+bciSize p TESTEQ_I64{} = 2*wordSizeInBc p
+bciSize p TESTLT_I32{} = 2*wordSizeInBc p
+bciSize p TESTEQ_I32{} = 2*wordSizeInBc p
+bciSize p TESTLT_I16{} = 2*wordSizeInBc p
+bciSize p TESTEQ_I16{} = 2*wordSizeInBc p
+bciSize p TESTLT_I8{} = 2*wordSizeInBc p
+bciSize p TESTEQ_I8{} = 2*wordSizeInBc p
+bciSize p TESTLT_W64{} = 2*wordSizeInBc p
+bciSize p TESTEQ_W64{} = 2*wordSizeInBc p
+bciSize p TESTLT_W32{} = 2*wordSizeInBc p
+bciSize p TESTEQ_W32{} = 2*wordSizeInBc p
+bciSize p TESTLT_W16{} = 2*wordSizeInBc p
+bciSize p TESTEQ_W16{} = 2*wordSizeInBc p
+bciSize p TESTLT_W8{} = 2*wordSizeInBc p
+bciSize p TESTEQ_W8{} = 2*wordSizeInBc p
+bciSize p TESTLT_F{} = 2*wordSizeInBc p
+bciSize p TESTEQ_F{} = 2*wordSizeInBc p
+bciSize p TESTLT_D{} = 2*wordSizeInBc p
+bciSize p TESTEQ_D{} = 2*wordSizeInBc p
+bciSize p TESTLT_P{} = 1+wordSizeInBc p
+bciSize p TESTEQ_P{} = 1+wordSizeInBc p
+bciSize _ CASEFAIL{} = 0
+bciSize p JMP{} = wordSizeInBc p
+bciSize _ ENTER{} = 0
+bciSize _ RETURN{} = 0
+bciSize _ RETURN_TUPLE{} = 0
+bciSize p CCALL{} = 1+2*wordSizeInBc p
+bciSize _ PRIMCALL{} = 0
+bciSize _ OP_ADD{} = 0
+bciSize _ OP_SUB{} = 0
+bciSize _ OP_AND{} = 0
+bciSize _ OP_XOR{} = 0
+bciSize _ OP_OR{} = 0
+bciSize _ OP_NOT{} = 0
+bciSize _ OP_NEG{} = 0
+bciSize _ OP_MUL{} = 0
+bciSize _ OP_SHL{} = 0
+bciSize _ OP_ASR{} = 0
+bciSize _ OP_LSR{} = 0
+
+bciSize _ OP_NEQ{} = 0
+bciSize _ OP_EQ{} = 0
+bciSize _ OP_S_LT{} = 0
+bciSize _ OP_S_GT{} = 0
+bciSize _ OP_S_LE{} = 0
+bciSize _ OP_S_GE{} = 0
+bciSize _ OP_U_LT{} = 0
+bciSize _ OP_U_GT{} = 0
+bciSize _ OP_U_LE{} = 0
+bciSize _ OP_U_GE{} = 0
+
+bciSize _ OP_INDEX_ADDR{} = 0
+
+bciSize p SWIZZLE{} = 2*wordSizeInBc p
+bciSize p BRK_FUN{} = 2+6*wordSizeInBc p
+bciSize _ RESUME_STEP_OUT{} = 3
+
+bciSize p SLIDE{} = 2*wordSizeInBc p
+bciSize p MKAP{} = 2*wordSizeInBc p
+bciSize p MKPAP{} = 2*wordSizeInBc p
+bciSize p PACK{} = 2*wordSizeInBc p
+#if MIN_VERSION_rts(1,0,3)
+bciSize p BCO_NAME{} = wordSizeInBc p
+#endif
+
+wordSizeInBc :: Platform -> Word16
+wordSizeInBc p =
+ case platformWordSize p of
+ PW4 -> 2
+ PW8 -> 4
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -4,6 +4,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ViewPatterns #-}
--
-- (c) The University of Glasgow 2002-2006
@@ -75,6 +76,7 @@ import Data.List ( genericReplicate, intersperse
, partition, scanl', sortBy, zip4, zip6 )
import Foreign hiding (shiftL, shiftR)
import Control.Monad
+import Control.Monad.Trans.State
import Data.Char
import GHC.Unit.Module
@@ -96,6 +98,7 @@ import Data.Either ( partitionEithers )
import GHC.Stg.Syntax
import qualified Data.IntSet as IntSet
import GHC.CoreToIface
+import Data.Bifunctor (Bifunctor(..))
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -1367,6 +1370,43 @@ doCase d s p scrut bndr alts
bitmap = intsToReverseBitmap platform bitmap_size' pointers
+ -- See Note [Debugger: RESUME_STEP_OUT]
+ -- We could do this in a single pass, but it is easier to do two.
+ fillInResStepOutStubs instrs = fst $ runState (fillInBackwards =<< fillInForwards instrs) (0, True)
+
+ fillInForwards :: BCInstrList -> State (Word16, Bool) BCInstrList
+ fillInForwards instrs = do
+ put (0, True) -- reset
+ forM instrs $ \i -> do
+ (off, isFirst) <- get
+ case i of
+ RESUME_STEP_OUT o _ n -> do
+ -- Reset offset
+ put (0, False)
+ if isFirst
+ then return $ RESUME_STEP_OUT o 0 n
+ else return $ RESUME_STEP_OUT o off n
+ _ -> do
+ modify (first (+ (bciSize platform i + 1)))
+ return i
+
+ fillInBackwards :: BCInstrList -> State (Word16, Bool) BCInstrList
+ fillInBackwards instrs = reverseOL <$> do
+ put (0, True) -- reset
+ forM (reverseOL instrs) $ \i -> do
+ (off, isFirst) <- get
+ case i of
+ RESUME_STEP_OUT o p _ -> do
+ -- Reset offset
+ put (0, False)
+ if isFirst
+ then return $ RESUME_STEP_OUT o p 0
+ else return $ RESUME_STEP_OUT o p off
+ _ -> do
+ modify (first (+ (bciSize platform i + 1)))
+ return i
+
+
alt_stuff <- mapM codeAlt alts
alt_final0 <- mkMultiBranch maybe_ncons alt_stuff
@@ -1375,8 +1415,9 @@ doCase d s p scrut bndr alts
| otherwise = alt_final0
alt_final
| gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
- -- See Note [Debugger: BRK_ALTS]
- = BRK_ALTS 0 `consOL` alt_final1
+ -- See Note [Debugger: RESUME_STEP_OUT]
+ = {- TODO: ASSERT IN BYTECODE THINGS -}
+ fillInResStepOutStubs (RESUME_STEP_OUT 0 0 0 `consOL` alt_final1)
| otherwise = alt_final1
add_bco_name <- shouldAddBcoName
@@ -2402,13 +2443,13 @@ mkMultiBranch :: Maybe Int -- # datacons in tycon, if alg alt
-> BcM BCInstrList
mkMultiBranch maybe_ncons raw_ways = do
lbl_default <- getLabelBc
-
+ hsc_env <- getHscEnv
let
mkTree :: [(Discr, BCInstrList)] -> Discr -> Discr -> BcM BCInstrList
mkTree [] _range_lo _range_hi = return (unitOL (JMP lbl_default))
-- shouldn't happen?
- mkTree [val] range_lo range_hi
+ mkTree [(second insertStubResStepOut -> val)] range_lo range_hi
| range_lo == range_hi
= return (snd val)
| null defaults -- Note [CASEFAIL]
@@ -2417,7 +2458,8 @@ mkMultiBranch maybe_ncons raw_ways = do
`consOL` (snd val
`appOL` (LABEL lbl `consOL` unitOL CASEFAIL)))
| otherwise
- = return (testEQ (fst val) lbl_default `consOL` snd val)
+ = return (testEQ (fst val) lbl_default
+ `consOL` snd val)
-- Note [CASEFAIL]
-- ~~~~~~~~~~~~~~~
@@ -2448,8 +2490,22 @@ mkMultiBranch maybe_ncons raw_ways = do
the_default
= case defaults of
[] -> nilOL
- [(_, def)] -> LABEL lbl_default `consOL` def
+ [(_, def)] -> LABEL lbl_default `consOL` insertStubResStepOut def
_ -> panic "mkMultiBranch/the_default"
+
+ -- See Note [Debugger: RESUME_STEP_OUT]
+ insertStubResStepOut (SnocOL instrs i)
+ | not (gopt Opt_InsertBreakpoints (hsc_dflags hsc_env))
+ = instrs `snocOL` i -- do nothing
+ -- look through instrs which diverge control flow
+ | any id $ [True | ENTER <- [i]]
+ ++ [True | RETURN{} <- [i]]
+ ++ [True | PRIMCALL{} <- [i]]
+ = insertStubResStepOut instrs `snocOL` i
+ | otherwise
+ = instrs `snocOL` i `snocOL` RESUME_STEP_OUT 0 0 0
+ insertStubResStepOut NilOL = NilOL
+
instrs <- mkTree notd_ways init_lo init_hi
return (instrs `appOL` the_default)
where
=====================================
rts/Disassembler.c
=====================================
@@ -94,8 +94,11 @@ disInstr ( StgBCO *bco, int pc )
debugBelch("\n");
pc += 6;
break;
- case bci_BRK_ALTS:
- debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
+ case bci_RESUME_STEP_OUT:
+ unsigned int active = BCO_NEXT;
+ unsigned int prev = BCO_NEXT;
+ unsigned int next = BCO_NEXT;
+ debugBelch ("RESUME_STEP_OUT on:%d prev_off:%d next_off:%d\n", active, prev, next);
break;
case bci_SWIZZLE: {
W_ stkoff = BCO_GET_LARGE_ARG;
=====================================
rts/Interpreter.c
=====================================
@@ -562,6 +562,85 @@ slow_spw(void *Sp, StgStack *cur_stack, StgWord offset_words){
}
}
+static void
+set_bco_RESUME_STEP_OUTs(StgWord16 *instrs, int bciPtr, int val) {
+ bciPtr++; // skip fst arg
+ StgWord16 to_prev = BCO_NEXT;
+ StgWord16 to_next = BCO_NEXT;
+
+ while (to_prev != 0) {
+ instrs[to_prev+1] = val;
+ to_prev = instrs[to_prev+2];
+ }
+ while (to_next != 0) {
+ instrs[to_next+1] = val;
+ to_next = instrs[to_next+3];
+ }
+}
+
+
+/* Traverse from the given stack pointer upwards until a continuation BCO with
+ * a breakpoint is found -- then enable that breakpoint.
+ * See Note [Debugger: Step-out]
+ */
+static void
+enable_break_on_continuation(Capability *cap, void *Sp) {
+
+ StgBCO* bco;
+ StgWord16* bco_instrs;
+ StgHalfWord type;
+
+ /* Traverse upwards until continuation BCO, or the end */
+ while ((type = get_itbl((StgClosure*)Sp)->type) != RET_BCO
+ && type != STOP_FRAME) {
+ Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
+ }
+
+ ASSERT(type == RET_BCO || type == STOP_FRAME);
+ if (type == RET_BCO) {
+
+ bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
+ ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
+ bco_instrs = (StgWord16*)(bco->instrs->payload);
+
+ /* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
+ * instruction in a BCO */
+ if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
+ int brk_array, tick_index;
+ StgArrBytes *breakPoints;
+ StgPtr* ptrs;
+
+ ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
+ brk_array = bco_instrs[1];
+ tick_index = bco_instrs[6];
+
+ breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
+ // ACTIVATE the breakpoint by tick index
+ ((StgInt*)breakPoints->payload)[tick_index] = 0;
+ }
+ // TODO: ASSERT IN STG2BC: All Case continuation BCOs start with a RESUME_STEP_OUT instruction that is never active but points to the remaining ones
+ else {
+ if ((bco_instrs[0] & 0xFF) == bci_RESUME_STEP_OUT) {
+
+ // Step-out will resume and trigger a specific breakpoint further up
+ // the stack when the case alternative is selected.
+ // See Note [Debugger: RESUME_STEP_OUT]
+ set_bco_RESUME_STEP_OUTs(bco_instrs, 1 /*start ix*/, 1 /* Enable them all */);
+ bco_instrs[1] = 0; /* and disable the first stub one again; this one is not meant to run, only find the others. */
+ }
+ else {
+ // Unlikely: This continuation BCO doesn't have a BRK_FUN nor is a case
+ // continuation BCO with RESUME_STEP_OUT.
+ // Keep looking for a frame to trigger a breakpoint in in the stack:
+ enable_break_on_continuation(cap, Sp);
+ }
+ }
+ }
+ else /* type == STOP_FRAME */ {
+ /* No continuation frame to further stop at: Nothing to do */
+ }
+}
+
// Compute the pointer tag for the constructor and tag the pointer;
// see Note [Data constructor dynamic tags] in GHC.StgToCmm.Closure.
//
@@ -618,62 +697,17 @@ interpretBCO (Capability* cap)
* See Note [Debugger: Step-out]
*/
if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
+ StgPtr frame;
- StgBCO* bco;
- StgWord16* bco_instrs;
- StgHalfWord type;
-
- /* Store the entry Sp; traverse the stack modifying Sp (using Sp macros);
- * restore Sp afterwards. */
- StgPtr restoreStackPointer = Sp;
-
- /* The first BCO on the stack is the one we are already stopped at.
- * Skip it. */
- Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
+ /* The first BCO on the stack as we re-enter the interpreter is the one
+ * we are already stopped at. Skip it. */
+ frame = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
- /* Traverse upwards until continuation BCO, or the end */
- while ((type = get_itbl((StgClosure*)Sp)->type) != RET_BCO
- && type != STOP_FRAME) {
- Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
- }
-
- ASSERT(type == RET_BCO || type == STOP_FRAME);
- if (type == RET_BCO) {
-
- bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
- ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
- bco_instrs = (StgWord16*)(bco->instrs->payload);
-
- /* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
- * instruction in a BCO */
- if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
- int brk_array, tick_index;
- StgArrBytes *breakPoints;
- StgPtr* ptrs;
+ /* Enable the breakpoint in the first breakable continuation */
+ enable_break_on_continuation(cap, frame);
- ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
- brk_array = bco_instrs[1];
- tick_index = bco_instrs[6];
-
- breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
- // ACTIVATE the breakpoint by tick index
- ((StgInt*)breakPoints->payload)[tick_index] = 0;
- }
- else if ((bco_instrs[0] & 0xFF) == bci_BRK_ALTS) {
- // ACTIVATE BRK_ALTS by setting its only argument to ON
- bco_instrs[1] = 1;
- }
- // else: if there is no BRK instruction perhaps we should keep
- // traversing; that said, the continuation should always have a BRK
- }
- else /* type == STOP_FRAME */ {
- /* No continuation frame to further stop at: Nothing to do */
- }
-
- // Mark as done to not do it again
+ /* Mark as done to not do it again */
cap->r.rCurrentTSO->flags &= ~TSO_STOP_AFTER_RETURN;
-
- Sp = restoreStackPointer;
}
// ------------------------------------------------------------------------
@@ -1600,12 +1634,21 @@ run_BCO:
goto nextInsn;
}
- /* See Note [Debugger: BRK_ALTS] */
- case bci_BRK_ALTS:
+ /* See Note [Debugger: RESUME_STEP_OUT] */
+ case bci_RESUME_STEP_OUT:
{
- StgWord16 active = BCO_NEXT;
+ StgWord16 active = BCO_NEXT;
+ bciPtr++; /* arg2 */
+ bciPtr++; /* arg3 */
+
if (active) {
- cap->r.rCurrentTSO->flags |= TSO_STOP_NEXT_BREAKPOINT;
+ // Try to look for a continuation to activate a breakpoint on on
+ // the stack again.
+ enable_break_on_continuation(cap, Sp);
+
+ // Make sure the remaining RESUME_STEP_OUTs in this BCO are
+ // disabled since we took this one.
+ set_bco_RESUME_STEP_OUTs(instrs, bciPtr - 3 /* index */, 0 /* Disable them all */);
}
goto nextInsn;
=====================================
rts/include/rts/Bytecodes.h
=====================================
@@ -214,7 +214,7 @@
#define bci_OP_INDEX_ADDR_32 242
#define bci_OP_INDEX_ADDR_64 243
-#define bci_BRK_ALTS 244
+#define bci_RESUME_STEP_OUT 244
/* If you need to go past 255 then you will run into the flags */
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d61e3fbcd63385097026386de8474981...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d61e3fbcd63385097026386de8474981...
You're receiving this email because of your account on gitlab.haskell.org.