Rodrigo Mesquita pushed to branch wip/romes/step-out-5 at Glasgow Haskell Compiler / GHC

Commits:

6 changed files:

Changes:

  • compiler/GHC/ByteCode/Asm.hs
    ... ... @@ -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)
    

  • compiler/GHC/ByteCode/Instr.hs
    ... ... @@ -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

  • compiler/GHC/StgToByteCode.hs
    ... ... @@ -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
    

  • rts/Disassembler.c
    ... ... @@ -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;
    

  • rts/Interpreter.c
    ... ... @@ -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;
    

  • rts/include/rts/Bytecodes.h
    ... ... @@ -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 */