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
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:
... | ... | @@ -856,7 +856,7 @@ assembleI platform i = case i of |
856 | 856 | , Op np
|
857 | 857 | ]
|
858 | 858 | |
859 | - BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp active]
|
|
859 | + RESUME_STEP_OUT on prev next -> emit_ bci_RESUME_STEP_OUT [SmallOp on, SmallOp prev, SmallOp next]
|
|
860 | 860 | |
861 | 861 | #if MIN_VERSION_rts(1,0,3)
|
862 | 862 | BCO_NAME name -> do np <- lit1 (BCONPtrStr name)
|
... | ... | @@ -8,10 +8,11 @@ |
8 | 8 | |
9 | 9 | -- | Bytecode instruction definitions
|
10 | 10 | module GHC.ByteCode.Instr (
|
11 | - BCInstr(..), ProtoBCO(..), bciStackUse, LocalLabel(..)
|
|
11 | + BCInstr(..), ProtoBCO(..), bciStackUse, bciSize, LocalLabel(..)
|
|
12 | 12 | ) where
|
13 | 13 | |
14 | 14 | import GHC.Prelude
|
15 | +import GHC.Platform
|
|
15 | 16 | |
16 | 17 | import GHC.ByteCode.Types
|
17 | 18 | import GHC.Cmm.Type (Width)
|
... | ... | @@ -273,8 +274,10 @@ data BCInstr |
273 | 274 | (RemotePtr CostCentre)
|
274 | 275 | |
275 | 276 | -- An internal breakpoint for triggering a break on any case alternative
|
276 | - -- See Note [Debugger: BRK_ALTS]
|
|
277 | - | BRK_ALTS !Word16 {- enabled? -}
|
|
277 | + -- See Note [Debugger: RESUME_STEP_OUT]
|
|
278 | + | RESUME_STEP_OUT !Word16 {- enabled? -}
|
|
279 | + !Word16 {- offset to prev RESUME_STEP_OUT within same BCO -}
|
|
280 | + !Word16 {- offset to next RESUME_STEP_OUT within same BCO -}
|
|
278 | 281 | |
279 | 282 | #if MIN_VERSION_rts(1,0,3)
|
280 | 283 | -- | A "meta"-instruction for recording the name of a BCO for debugging purposes.
|
... | ... | @@ -471,7 +474,8 @@ instance Outputable BCInstr where |
471 | 474 | <+> text "<tick_module>" <+> text "<tick_module_unitid>" <+> ppr tickx
|
472 | 475 | <+> text "<info_module>" <+> text "<info_module_unitid>" <+> ppr infox
|
473 | 476 | <+> text "<cc>"
|
474 | - ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active
|
|
477 | + ppr (RESUME_STEP_OUT on prev next)
|
|
478 | + = text "RESUME_STEP_OUT" <+> ppr on <+> ppr prev <+> ppr next
|
|
475 | 479 | #if MIN_VERSION_rts(1,0,3)
|
476 | 480 | ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm)
|
477 | 481 | #endif
|
... | ... | @@ -597,7 +601,7 @@ bciStackUse OP_INDEX_ADDR{} = 0 |
597 | 601 | |
598 | 602 | bciStackUse SWIZZLE{} = 0
|
599 | 603 | bciStackUse BRK_FUN{} = 0
|
600 | -bciStackUse BRK_ALTS{} = 0
|
|
604 | +bciStackUse RESUME_STEP_OUT{} = 0
|
|
601 | 605 | |
602 | 606 | -- These insns actually reduce stack use, but we need the high-tide level,
|
603 | 607 | -- so can't use this info. Not that it matters much.
|
... | ... | @@ -608,3 +612,121 @@ bciStackUse PACK{} = 1 -- worst case is PACK 0 words |
608 | 612 | #if MIN_VERSION_rts(1,0,3)
|
609 | 613 | bciStackUse BCO_NAME{} = 0
|
610 | 614 | #endif
|
615 | + |
|
616 | +-- | The size of a bytecode instruction's arguments in number of Word16 (the
|
|
617 | +-- size of bytecode instructions)
|
|
618 | +bciSize :: Platform -> BCInstr -> Word16
|
|
619 | +bciSize p STKCHECK{} = wordSizeInBc p
|
|
620 | +bciSize p PUSH_L{} = wordSizeInBc p
|
|
621 | +bciSize p PUSH_LL{} = 2*wordSizeInBc p
|
|
622 | +bciSize p PUSH_LLL{} = 3*wordSizeInBc p
|
|
623 | +bciSize p PUSH8{} = wordSizeInBc p
|
|
624 | +bciSize p PUSH16{} = wordSizeInBc p
|
|
625 | +bciSize p PUSH32{} = wordSizeInBc p
|
|
626 | +bciSize p PUSH8_W{} = wordSizeInBc p
|
|
627 | +bciSize p PUSH16_W{} = wordSizeInBc p
|
|
628 | +bciSize p PUSH32_W{} = wordSizeInBc p
|
|
629 | +bciSize p PUSH_G{} = wordSizeInBc p
|
|
630 | +bciSize p PUSH_PRIMOP{} = wordSizeInBc p
|
|
631 | +bciSize p PUSH_BCO{} = wordSizeInBc p
|
|
632 | +bciSize p PUSH_ALTS{} = wordSizeInBc p
|
|
633 | +bciSize p PUSH_ALTS_TUPLE{} = 3*wordSizeInBc p
|
|
634 | +bciSize _ (PUSH_PAD8) = 0
|
|
635 | +bciSize _ (PUSH_PAD16) = 0
|
|
636 | +bciSize _ (PUSH_PAD32) = 0
|
|
637 | +bciSize p (PUSH_UBX8 _) = wordSizeInBc p
|
|
638 | +bciSize p (PUSH_UBX16 _) = wordSizeInBc p
|
|
639 | +bciSize p (PUSH_UBX32 _) = wordSizeInBc p
|
|
640 | +bciSize p (PUSH_UBX{}) = 2*wordSizeInBc p
|
|
641 | +bciSize p PUSH_ADDR{} = 1+wordSizeInBc p
|
|
642 | +bciSize _ PUSH_APPLY_N{} = 0
|
|
643 | +bciSize _ PUSH_APPLY_V{} = 0
|
|
644 | +bciSize _ PUSH_APPLY_F{} = 0
|
|
645 | +bciSize _ PUSH_APPLY_D{} = 0
|
|
646 | +bciSize _ PUSH_APPLY_L{} = 0
|
|
647 | +bciSize _ PUSH_APPLY_P{} = 0
|
|
648 | +bciSize _ PUSH_APPLY_PP{} = 0
|
|
649 | +bciSize _ PUSH_APPLY_PPP{} = 0
|
|
650 | +bciSize _ PUSH_APPLY_PPPP{} = 0
|
|
651 | +bciSize _ PUSH_APPLY_PPPPP{} = 0
|
|
652 | +bciSize _ PUSH_APPLY_PPPPPP{} = 0
|
|
653 | +bciSize p ALLOC_AP{} = wordSizeInBc p
|
|
654 | +bciSize p ALLOC_AP_NOUPD{} = wordSizeInBc p
|
|
655 | +bciSize p ALLOC_PAP{} = 2*wordSizeInBc p
|
|
656 | +bciSize p (UNPACK _) = wordSizeInBc p
|
|
657 | +bciSize _ LABEL{} = 0
|
|
658 | +bciSize p TESTLT_I{} = 2*wordSizeInBc p
|
|
659 | +bciSize p TESTEQ_I{} = 2*wordSizeInBc p
|
|
660 | +bciSize p TESTLT_W{} = 2*wordSizeInBc p
|
|
661 | +bciSize p TESTEQ_W{} = 2*wordSizeInBc p
|
|
662 | +bciSize p TESTLT_I64{} = 2*wordSizeInBc p
|
|
663 | +bciSize p TESTEQ_I64{} = 2*wordSizeInBc p
|
|
664 | +bciSize p TESTLT_I32{} = 2*wordSizeInBc p
|
|
665 | +bciSize p TESTEQ_I32{} = 2*wordSizeInBc p
|
|
666 | +bciSize p TESTLT_I16{} = 2*wordSizeInBc p
|
|
667 | +bciSize p TESTEQ_I16{} = 2*wordSizeInBc p
|
|
668 | +bciSize p TESTLT_I8{} = 2*wordSizeInBc p
|
|
669 | +bciSize p TESTEQ_I8{} = 2*wordSizeInBc p
|
|
670 | +bciSize p TESTLT_W64{} = 2*wordSizeInBc p
|
|
671 | +bciSize p TESTEQ_W64{} = 2*wordSizeInBc p
|
|
672 | +bciSize p TESTLT_W32{} = 2*wordSizeInBc p
|
|
673 | +bciSize p TESTEQ_W32{} = 2*wordSizeInBc p
|
|
674 | +bciSize p TESTLT_W16{} = 2*wordSizeInBc p
|
|
675 | +bciSize p TESTEQ_W16{} = 2*wordSizeInBc p
|
|
676 | +bciSize p TESTLT_W8{} = 2*wordSizeInBc p
|
|
677 | +bciSize p TESTEQ_W8{} = 2*wordSizeInBc p
|
|
678 | +bciSize p TESTLT_F{} = 2*wordSizeInBc p
|
|
679 | +bciSize p TESTEQ_F{} = 2*wordSizeInBc p
|
|
680 | +bciSize p TESTLT_D{} = 2*wordSizeInBc p
|
|
681 | +bciSize p TESTEQ_D{} = 2*wordSizeInBc p
|
|
682 | +bciSize p TESTLT_P{} = 1+wordSizeInBc p
|
|
683 | +bciSize p TESTEQ_P{} = 1+wordSizeInBc p
|
|
684 | +bciSize _ CASEFAIL{} = 0
|
|
685 | +bciSize p JMP{} = wordSizeInBc p
|
|
686 | +bciSize _ ENTER{} = 0
|
|
687 | +bciSize _ RETURN{} = 0
|
|
688 | +bciSize _ RETURN_TUPLE{} = 0
|
|
689 | +bciSize p CCALL{} = 1+2*wordSizeInBc p
|
|
690 | +bciSize _ PRIMCALL{} = 0
|
|
691 | +bciSize _ OP_ADD{} = 0
|
|
692 | +bciSize _ OP_SUB{} = 0
|
|
693 | +bciSize _ OP_AND{} = 0
|
|
694 | +bciSize _ OP_XOR{} = 0
|
|
695 | +bciSize _ OP_OR{} = 0
|
|
696 | +bciSize _ OP_NOT{} = 0
|
|
697 | +bciSize _ OP_NEG{} = 0
|
|
698 | +bciSize _ OP_MUL{} = 0
|
|
699 | +bciSize _ OP_SHL{} = 0
|
|
700 | +bciSize _ OP_ASR{} = 0
|
|
701 | +bciSize _ OP_LSR{} = 0
|
|
702 | + |
|
703 | +bciSize _ OP_NEQ{} = 0
|
|
704 | +bciSize _ OP_EQ{} = 0
|
|
705 | +bciSize _ OP_S_LT{} = 0
|
|
706 | +bciSize _ OP_S_GT{} = 0
|
|
707 | +bciSize _ OP_S_LE{} = 0
|
|
708 | +bciSize _ OP_S_GE{} = 0
|
|
709 | +bciSize _ OP_U_LT{} = 0
|
|
710 | +bciSize _ OP_U_GT{} = 0
|
|
711 | +bciSize _ OP_U_LE{} = 0
|
|
712 | +bciSize _ OP_U_GE{} = 0
|
|
713 | + |
|
714 | +bciSize _ OP_INDEX_ADDR{} = 0
|
|
715 | + |
|
716 | +bciSize p SWIZZLE{} = 2*wordSizeInBc p
|
|
717 | +bciSize p BRK_FUN{} = 2+6*wordSizeInBc p
|
|
718 | +bciSize _ RESUME_STEP_OUT{} = 3
|
|
719 | + |
|
720 | +bciSize p SLIDE{} = 2*wordSizeInBc p
|
|
721 | +bciSize p MKAP{} = 2*wordSizeInBc p
|
|
722 | +bciSize p MKPAP{} = 2*wordSizeInBc p
|
|
723 | +bciSize p PACK{} = 2*wordSizeInBc p
|
|
724 | +#if MIN_VERSION_rts(1,0,3)
|
|
725 | +bciSize p BCO_NAME{} = wordSizeInBc p
|
|
726 | +#endif
|
|
727 | + |
|
728 | +wordSizeInBc :: Platform -> Word16
|
|
729 | +wordSizeInBc p =
|
|
730 | + case platformWordSize p of
|
|
731 | + PW4 -> 2
|
|
732 | + PW8 -> 4 |
... | ... | @@ -4,6 +4,7 @@ |
4 | 4 | {-# LANGUAGE LambdaCase #-}
|
5 | 5 | {-# LANGUAGE RecordWildCards #-}
|
6 | 6 | {-# LANGUAGE FlexibleContexts #-}
|
7 | +{-# LANGUAGE ViewPatterns #-}
|
|
7 | 8 | |
8 | 9 | --
|
9 | 10 | -- (c) The University of Glasgow 2002-2006
|
... | ... | @@ -75,6 +76,7 @@ import Data.List ( genericReplicate, intersperse |
75 | 76 | , partition, scanl', sortBy, zip4, zip6 )
|
76 | 77 | import Foreign hiding (shiftL, shiftR)
|
77 | 78 | import Control.Monad
|
79 | +import Control.Monad.Trans.State
|
|
78 | 80 | import Data.Char
|
79 | 81 | |
80 | 82 | import GHC.Unit.Module
|
... | ... | @@ -96,6 +98,7 @@ import Data.Either ( partitionEithers ) |
96 | 98 | import GHC.Stg.Syntax
|
97 | 99 | import qualified Data.IntSet as IntSet
|
98 | 100 | import GHC.CoreToIface
|
101 | +import Data.Bifunctor (Bifunctor(..))
|
|
99 | 102 | |
100 | 103 | -- -----------------------------------------------------------------------------
|
101 | 104 | -- Generating byte code for a complete module
|
... | ... | @@ -1367,6 +1370,43 @@ doCase d s p scrut bndr alts |
1367 | 1370 | |
1368 | 1371 | bitmap = intsToReverseBitmap platform bitmap_size' pointers
|
1369 | 1372 | |
1373 | + -- See Note [Debugger: RESUME_STEP_OUT]
|
|
1374 | + -- We could do this in a single pass, but it is easier to do two.
|
|
1375 | + fillInResStepOutStubs instrs = fst $ runState (fillInBackwards =<< fillInForwards instrs) (0, True)
|
|
1376 | + |
|
1377 | + fillInForwards :: BCInstrList -> State (Word16, Bool) BCInstrList
|
|
1378 | + fillInForwards instrs = do
|
|
1379 | + put (0, True) -- reset
|
|
1380 | + forM instrs $ \i -> do
|
|
1381 | + (off, isFirst) <- get
|
|
1382 | + case i of
|
|
1383 | + RESUME_STEP_OUT o _ n -> do
|
|
1384 | + -- Reset offset
|
|
1385 | + put (0, False)
|
|
1386 | + if isFirst
|
|
1387 | + then return $ RESUME_STEP_OUT o 0 n
|
|
1388 | + else return $ RESUME_STEP_OUT o off n
|
|
1389 | + _ -> do
|
|
1390 | + modify (first (+ (bciSize platform i + 1)))
|
|
1391 | + return i
|
|
1392 | + |
|
1393 | + fillInBackwards :: BCInstrList -> State (Word16, Bool) BCInstrList
|
|
1394 | + fillInBackwards instrs = reverseOL <$> do
|
|
1395 | + put (0, True) -- reset
|
|
1396 | + forM (reverseOL instrs) $ \i -> do
|
|
1397 | + (off, isFirst) <- get
|
|
1398 | + case i of
|
|
1399 | + RESUME_STEP_OUT o p _ -> do
|
|
1400 | + -- Reset offset
|
|
1401 | + put (0, False)
|
|
1402 | + if isFirst
|
|
1403 | + then return $ RESUME_STEP_OUT o p 0
|
|
1404 | + else return $ RESUME_STEP_OUT o p off
|
|
1405 | + _ -> do
|
|
1406 | + modify (first (+ (bciSize platform i + 1)))
|
|
1407 | + return i
|
|
1408 | + |
|
1409 | + |
|
1370 | 1410 | alt_stuff <- mapM codeAlt alts
|
1371 | 1411 | alt_final0 <- mkMultiBranch maybe_ncons alt_stuff
|
1372 | 1412 | |
... | ... | @@ -1375,8 +1415,9 @@ doCase d s p scrut bndr alts |
1375 | 1415 | | otherwise = alt_final0
|
1376 | 1416 | alt_final
|
1377 | 1417 | | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
|
1378 | - -- See Note [Debugger: BRK_ALTS]
|
|
1379 | - = BRK_ALTS 0 `consOL` alt_final1
|
|
1418 | + -- See Note [Debugger: RESUME_STEP_OUT]
|
|
1419 | + = {- TODO: ASSERT IN BYTECODE THINGS -}
|
|
1420 | + fillInResStepOutStubs (RESUME_STEP_OUT 0 0 0 `consOL` alt_final1)
|
|
1380 | 1421 | | otherwise = alt_final1
|
1381 | 1422 | |
1382 | 1423 | add_bco_name <- shouldAddBcoName
|
... | ... | @@ -2402,13 +2443,13 @@ mkMultiBranch :: Maybe Int -- # datacons in tycon, if alg alt |
2402 | 2443 | -> BcM BCInstrList
|
2403 | 2444 | mkMultiBranch maybe_ncons raw_ways = do
|
2404 | 2445 | lbl_default <- getLabelBc
|
2405 | - |
|
2446 | + hsc_env <- getHscEnv
|
|
2406 | 2447 | let
|
2407 | 2448 | mkTree :: [(Discr, BCInstrList)] -> Discr -> Discr -> BcM BCInstrList
|
2408 | 2449 | mkTree [] _range_lo _range_hi = return (unitOL (JMP lbl_default))
|
2409 | 2450 | -- shouldn't happen?
|
2410 | 2451 | |
2411 | - mkTree [val] range_lo range_hi
|
|
2452 | + mkTree [(second insertStubResStepOut -> val)] range_lo range_hi
|
|
2412 | 2453 | | range_lo == range_hi
|
2413 | 2454 | = return (snd val)
|
2414 | 2455 | | null defaults -- Note [CASEFAIL]
|
... | ... | @@ -2417,7 +2458,8 @@ mkMultiBranch maybe_ncons raw_ways = do |
2417 | 2458 | `consOL` (snd val
|
2418 | 2459 | `appOL` (LABEL lbl `consOL` unitOL CASEFAIL)))
|
2419 | 2460 | | otherwise
|
2420 | - = return (testEQ (fst val) lbl_default `consOL` snd val)
|
|
2461 | + = return (testEQ (fst val) lbl_default
|
|
2462 | + `consOL` snd val)
|
|
2421 | 2463 | |
2422 | 2464 | -- Note [CASEFAIL]
|
2423 | 2465 | -- ~~~~~~~~~~~~~~~
|
... | ... | @@ -2448,8 +2490,22 @@ mkMultiBranch maybe_ncons raw_ways = do |
2448 | 2490 | the_default
|
2449 | 2491 | = case defaults of
|
2450 | 2492 | [] -> nilOL
|
2451 | - [(_, def)] -> LABEL lbl_default `consOL` def
|
|
2493 | + [(_, def)] -> LABEL lbl_default `consOL` insertStubResStepOut def
|
|
2452 | 2494 | _ -> panic "mkMultiBranch/the_default"
|
2495 | + |
|
2496 | + -- See Note [Debugger: RESUME_STEP_OUT]
|
|
2497 | + insertStubResStepOut (SnocOL instrs i)
|
|
2498 | + | not (gopt Opt_InsertBreakpoints (hsc_dflags hsc_env))
|
|
2499 | + = instrs `snocOL` i -- do nothing
|
|
2500 | + -- look through instrs which diverge control flow
|
|
2501 | + | any id $ [True | ENTER <- [i]]
|
|
2502 | + ++ [True | RETURN{} <- [i]]
|
|
2503 | + ++ [True | PRIMCALL{} <- [i]]
|
|
2504 | + = insertStubResStepOut instrs `snocOL` i
|
|
2505 | + | otherwise
|
|
2506 | + = instrs `snocOL` i `snocOL` RESUME_STEP_OUT 0 0 0
|
|
2507 | + insertStubResStepOut NilOL = NilOL
|
|
2508 | + |
|
2453 | 2509 | instrs <- mkTree notd_ways init_lo init_hi
|
2454 | 2510 | return (instrs `appOL` the_default)
|
2455 | 2511 | where
|
... | ... | @@ -94,8 +94,11 @@ disInstr ( StgBCO *bco, int pc ) |
94 | 94 | debugBelch("\n");
|
95 | 95 | pc += 6;
|
96 | 96 | break;
|
97 | - case bci_BRK_ALTS:
|
|
98 | - debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
|
|
97 | + case bci_RESUME_STEP_OUT:
|
|
98 | + unsigned int active = BCO_NEXT;
|
|
99 | + unsigned int prev = BCO_NEXT;
|
|
100 | + unsigned int next = BCO_NEXT;
|
|
101 | + debugBelch ("RESUME_STEP_OUT on:%d prev_off:%d next_off:%d\n", active, prev, next);
|
|
99 | 102 | break;
|
100 | 103 | case bci_SWIZZLE: {
|
101 | 104 | W_ stkoff = BCO_GET_LARGE_ARG;
|
... | ... | @@ -562,6 +562,85 @@ slow_spw(void *Sp, StgStack *cur_stack, StgWord offset_words){ |
562 | 562 | }
|
563 | 563 | }
|
564 | 564 | |
565 | +static void
|
|
566 | +set_bco_RESUME_STEP_OUTs(StgWord16 *instrs, int bciPtr, int val) {
|
|
567 | + bciPtr++; // skip fst arg
|
|
568 | + StgWord16 to_prev = BCO_NEXT;
|
|
569 | + StgWord16 to_next = BCO_NEXT;
|
|
570 | + |
|
571 | + while (to_prev != 0) {
|
|
572 | + instrs[to_prev+1] = val;
|
|
573 | + to_prev = instrs[to_prev+2];
|
|
574 | + }
|
|
575 | + while (to_next != 0) {
|
|
576 | + instrs[to_next+1] = val;
|
|
577 | + to_next = instrs[to_next+3];
|
|
578 | + }
|
|
579 | +}
|
|
580 | + |
|
581 | + |
|
582 | +/* Traverse from the given stack pointer upwards until a continuation BCO with
|
|
583 | + * a breakpoint is found -- then enable that breakpoint.
|
|
584 | + * See Note [Debugger: Step-out]
|
|
585 | + */
|
|
586 | +static void
|
|
587 | +enable_break_on_continuation(Capability *cap, void *Sp) {
|
|
588 | + |
|
589 | + StgBCO* bco;
|
|
590 | + StgWord16* bco_instrs;
|
|
591 | + StgHalfWord type;
|
|
592 | + |
|
593 | + /* Traverse upwards until continuation BCO, or the end */
|
|
594 | + while ((type = get_itbl((StgClosure*)Sp)->type) != RET_BCO
|
|
595 | + && type != STOP_FRAME) {
|
|
596 | + Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
|
|
597 | + }
|
|
598 | + |
|
599 | + ASSERT(type == RET_BCO || type == STOP_FRAME);
|
|
600 | + if (type == RET_BCO) {
|
|
601 | + |
|
602 | + bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
|
|
603 | + ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
|
|
604 | + bco_instrs = (StgWord16*)(bco->instrs->payload);
|
|
605 | + |
|
606 | + /* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
|
|
607 | + * instruction in a BCO */
|
|
608 | + if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
|
|
609 | + int brk_array, tick_index;
|
|
610 | + StgArrBytes *breakPoints;
|
|
611 | + StgPtr* ptrs;
|
|
612 | + |
|
613 | + ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
|
|
614 | + brk_array = bco_instrs[1];
|
|
615 | + tick_index = bco_instrs[6];
|
|
616 | + |
|
617 | + breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
|
|
618 | + // ACTIVATE the breakpoint by tick index
|
|
619 | + ((StgInt*)breakPoints->payload)[tick_index] = 0;
|
|
620 | + }
|
|
621 | + // 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
|
|
622 | + else {
|
|
623 | + if ((bco_instrs[0] & 0xFF) == bci_RESUME_STEP_OUT) {
|
|
624 | + |
|
625 | + // Step-out will resume and trigger a specific breakpoint further up
|
|
626 | + // the stack when the case alternative is selected.
|
|
627 | + // See Note [Debugger: RESUME_STEP_OUT]
|
|
628 | + set_bco_RESUME_STEP_OUTs(bco_instrs, 1 /*start ix*/, 1 /* Enable them all */);
|
|
629 | + bco_instrs[1] = 0; /* and disable the first stub one again; this one is not meant to run, only find the others. */
|
|
630 | + }
|
|
631 | + else {
|
|
632 | + // Unlikely: This continuation BCO doesn't have a BRK_FUN nor is a case
|
|
633 | + // continuation BCO with RESUME_STEP_OUT.
|
|
634 | + // Keep looking for a frame to trigger a breakpoint in in the stack:
|
|
635 | + enable_break_on_continuation(cap, Sp);
|
|
636 | + }
|
|
637 | + }
|
|
638 | + }
|
|
639 | + else /* type == STOP_FRAME */ {
|
|
640 | + /* No continuation frame to further stop at: Nothing to do */
|
|
641 | + }
|
|
642 | +}
|
|
643 | + |
|
565 | 644 | // Compute the pointer tag for the constructor and tag the pointer;
|
566 | 645 | // see Note [Data constructor dynamic tags] in GHC.StgToCmm.Closure.
|
567 | 646 | //
|
... | ... | @@ -618,62 +697,17 @@ interpretBCO (Capability* cap) |
618 | 697 | * See Note [Debugger: Step-out]
|
619 | 698 | */
|
620 | 699 | if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
|
700 | + StgPtr frame;
|
|
621 | 701 | |
622 | - StgBCO* bco;
|
|
623 | - StgWord16* bco_instrs;
|
|
624 | - StgHalfWord type;
|
|
625 | - |
|
626 | - /* Store the entry Sp; traverse the stack modifying Sp (using Sp macros);
|
|
627 | - * restore Sp afterwards. */
|
|
628 | - StgPtr restoreStackPointer = Sp;
|
|
629 | - |
|
630 | - /* The first BCO on the stack is the one we are already stopped at.
|
|
631 | - * Skip it. */
|
|
632 | - Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
|
|
702 | + /* The first BCO on the stack as we re-enter the interpreter is the one
|
|
703 | + * we are already stopped at. Skip it. */
|
|
704 | + frame = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
|
|
633 | 705 | |
634 | - /* Traverse upwards until continuation BCO, or the end */
|
|
635 | - while ((type = get_itbl((StgClosure*)Sp)->type) != RET_BCO
|
|
636 | - && type != STOP_FRAME) {
|
|
637 | - Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
|
|
638 | - }
|
|
639 | - |
|
640 | - ASSERT(type == RET_BCO || type == STOP_FRAME);
|
|
641 | - if (type == RET_BCO) {
|
|
642 | - |
|
643 | - bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
|
|
644 | - ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
|
|
645 | - bco_instrs = (StgWord16*)(bco->instrs->payload);
|
|
646 | - |
|
647 | - /* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
|
|
648 | - * instruction in a BCO */
|
|
649 | - if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
|
|
650 | - int brk_array, tick_index;
|
|
651 | - StgArrBytes *breakPoints;
|
|
652 | - StgPtr* ptrs;
|
|
706 | + /* Enable the breakpoint in the first breakable continuation */
|
|
707 | + enable_break_on_continuation(cap, frame);
|
|
653 | 708 | |
654 | - ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
|
|
655 | - brk_array = bco_instrs[1];
|
|
656 | - tick_index = bco_instrs[6];
|
|
657 | - |
|
658 | - breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
|
|
659 | - // ACTIVATE the breakpoint by tick index
|
|
660 | - ((StgInt*)breakPoints->payload)[tick_index] = 0;
|
|
661 | - }
|
|
662 | - else if ((bco_instrs[0] & 0xFF) == bci_BRK_ALTS) {
|
|
663 | - // ACTIVATE BRK_ALTS by setting its only argument to ON
|
|
664 | - bco_instrs[1] = 1;
|
|
665 | - }
|
|
666 | - // else: if there is no BRK instruction perhaps we should keep
|
|
667 | - // traversing; that said, the continuation should always have a BRK
|
|
668 | - }
|
|
669 | - else /* type == STOP_FRAME */ {
|
|
670 | - /* No continuation frame to further stop at: Nothing to do */
|
|
671 | - }
|
|
672 | - |
|
673 | - // Mark as done to not do it again
|
|
709 | + /* Mark as done to not do it again */
|
|
674 | 710 | cap->r.rCurrentTSO->flags &= ~TSO_STOP_AFTER_RETURN;
|
675 | - |
|
676 | - Sp = restoreStackPointer;
|
|
677 | 711 | }
|
678 | 712 | |
679 | 713 | // ------------------------------------------------------------------------
|
... | ... | @@ -1600,12 +1634,21 @@ run_BCO: |
1600 | 1634 | goto nextInsn;
|
1601 | 1635 | }
|
1602 | 1636 | |
1603 | - /* See Note [Debugger: BRK_ALTS] */
|
|
1604 | - case bci_BRK_ALTS:
|
|
1637 | + /* See Note [Debugger: RESUME_STEP_OUT] */
|
|
1638 | + case bci_RESUME_STEP_OUT:
|
|
1605 | 1639 | {
|
1606 | - StgWord16 active = BCO_NEXT;
|
|
1640 | + StgWord16 active = BCO_NEXT;
|
|
1641 | + bciPtr++; /* arg2 */
|
|
1642 | + bciPtr++; /* arg3 */
|
|
1643 | + |
|
1607 | 1644 | if (active) {
|
1608 | - cap->r.rCurrentTSO->flags |= TSO_STOP_NEXT_BREAKPOINT;
|
|
1645 | + // Try to look for a continuation to activate a breakpoint on on
|
|
1646 | + // the stack again.
|
|
1647 | + enable_break_on_continuation(cap, Sp);
|
|
1648 | + |
|
1649 | + // Make sure the remaining RESUME_STEP_OUTs in this BCO are
|
|
1650 | + // disabled since we took this one.
|
|
1651 | + set_bco_RESUME_STEP_OUTs(instrs, bciPtr - 3 /* index */, 0 /* Disable them all */);
|
|
1609 | 1652 | }
|
1610 | 1653 | |
1611 | 1654 | goto nextInsn;
|
... | ... | @@ -214,7 +214,7 @@ |
214 | 214 | #define bci_OP_INDEX_ADDR_32 242
|
215 | 215 | #define bci_OP_INDEX_ADDR_64 243
|
216 | 216 | |
217 | -#define bci_BRK_ALTS 244
|
|
217 | +#define bci_RESUME_STEP_OUT 244
|
|
218 | 218 | |
219 | 219 | |
220 | 220 | /* If you need to go past 255 then you will run into the flags */
|