[Git][ghc/ghc][wip/romes/step-out-5] WIP: Working on RESUME_STEP_OUT for case continuations [skip ci]

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.