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

Commits:

23 changed files:

Changes:

  • compiler/GHC/ByteCode/Asm.hs
    ... ... @@ -854,8 +854,6 @@ assembleI platform i = case i of
    854 854
         emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
    
    855 855
                           , SmallOp (toW16 infox), Op np ]
    
    856 856
     
    
    857
    -  BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)]
    
    858
    -
    
    859 857
     #if MIN_VERSION_rts(1,0,3)
    
    860 858
       BCO_NAME name            -> do np <- lit1 (BCONPtrStr name)
    
    861 859
                                      emit_ bci_BCO_NAME [Op np]
    

  • compiler/GHC/ByteCode/Breakpoints.hs
    1 1
     {-# LANGUAGE RecordWildCards #-}
    
    2
    +{-# LANGUAGE DerivingStrategies #-}
    
    2 3
     
    
    3 4
     -- | Breakpoint information constructed during ByteCode generation.
    
    4 5
     --
    
    ... ... @@ -15,6 +16,7 @@ module GHC.ByteCode.Breakpoints
    15 16
     
    
    16 17
         -- ** Internal breakpoint identifier
    
    17 18
       , InternalBreakpointId(..), BreakInfoIndex
    
    19
    +  , InternalBreakLoc(..)
    
    18 20
     
    
    19 21
         -- * Operations
    
    20 22
     
    
    ... ... @@ -23,7 +25,7 @@ module GHC.ByteCode.Breakpoints
    23 25
     
    
    24 26
         -- ** Source-level information operations
    
    25 27
       , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
    
    26
    -  , getBreakSourceId
    
    28
    +  , getBreakSourceId, getBreakSourceMod
    
    27 29
     
    
    28 30
         -- * Utils
    
    29 31
       , seqInternalModBreaks
    
    ... ... @@ -165,7 +167,7 @@ data CgBreakInfo
    165 167
        { cgb_tyvars  :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
    
    166 168
        , cgb_vars    :: ![Maybe (IfaceIdBndr, Word)]
    
    167 169
        , cgb_resty   :: !IfaceType
    
    168
    -   , cgb_tick_id :: !BreakpointId
    
    170
    +   , cgb_tick_id :: !(Either InternalBreakLoc BreakpointId)
    
    169 171
          -- ^ This field records the original breakpoint tick identifier for this
    
    170 172
          -- internal breakpoint info. It is used to convert a breakpoint
    
    171 173
          -- *occurrence* index ('InternalBreakpointId') into a *definition* index
    
    ... ... @@ -173,9 +175,18 @@ data CgBreakInfo
    173 175
          --
    
    174 176
          -- The modules of breakpoint occurrence and breakpoint definition are not
    
    175 177
          -- necessarily the same: See Note [Breakpoint identifiers].
    
    178
    +     --
    
    179
    +     -- If there is no original tick identifier (that is, the breakpoint was
    
    180
    +     -- created during code generation), instead refer directly to the SrcSpan
    
    181
    +     -- we want to use for it.
    
    176 182
        }
    
    177 183
     -- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
    
    178 184
     
    
    185
    +-- | Breakpoints created during code generation don't have a source-level tick
    
    186
    +-- location. Instead, we come up with one ourselves.
    
    187
    +newtype InternalBreakLoc = InternalBreakLoc SrcSpan
    
    188
    +  deriving newtype (Eq, Show, NFData, Outputable)
    
    189
    +
    
    179 190
     -- | Get an internal breakpoint info by 'InternalBreakpointId'
    
    180 191
     getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
    
    181 192
     getInternalBreak (InternalBreakpointId mod ix) imbs =
    
    ... ... @@ -196,27 +207,36 @@ assert_modules_match ibi_mod imbs_mod =
    196 207
     
    
    197 208
     -- | Get the source module and tick index for this breakpoint
    
    198 209
     -- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
    
    199
    -getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
    
    210
    +getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> Either InternalBreakLoc BreakpointId
    
    200 211
     getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
    
    201 212
       assert_modules_match ibi_mod (imodBreaks_module imbs) $
    
    202 213
         let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
    
    203 214
          in cgb_tick_id cgb
    
    204 215
     
    
    216
    +-- | Get the source module for this breakpoint (where the breakpoint is defined)
    
    217
    +getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module
    
    218
    +getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs =
    
    219
    +  assert_modules_match ibi_mod (imodBreaks_module imbs) $
    
    220
    +    let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
    
    221
    +     in case cgb_tick_id cgb of
    
    222
    +      Left InternalBreakLoc{} -> imodBreaks_module imbs
    
    223
    +      Right BreakpointId{bi_tick_mod} -> bi_tick_mod
    
    224
    +
    
    205 225
     -- | Get the source span for this breakpoint
    
    206 226
     getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
    
    207
    -getBreakLoc = getBreakXXX modBreaks_locs
    
    227
    +getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
    
    208 228
     
    
    209 229
     -- | Get the vars for this breakpoint
    
    210 230
     getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
    
    211
    -getBreakVars = getBreakXXX modBreaks_vars
    
    231
    +getBreakVars = getBreakXXX modBreaks_vars (const [])
    
    212 232
     
    
    213 233
     -- | Get the decls for this breakpoint
    
    214 234
     getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
    
    215
    -getBreakDecls = getBreakXXX modBreaks_decls
    
    235
    +getBreakDecls = getBreakXXX modBreaks_decls (const [])
    
    216 236
     
    
    217 237
     -- | Get the decls for this breakpoint
    
    218
    -getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
    
    219
    -getBreakCCS = getBreakXXX modBreaks_ccs
    
    238
    +getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
    
    239
    +getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
    
    220 240
     
    
    221 241
     -- | Internal utility to access a ModBreaks field at a particular breakpoint index
    
    222 242
     --
    
    ... ... @@ -228,14 +248,17 @@ getBreakCCS = getBreakXXX modBreaks_ccs
    228 248
     -- 'ModBreaks'. When the tick module is different, we need to look up the
    
    229 249
     -- 'ModBreaks' in the HUG for that other module.
    
    230 250
     --
    
    251
    +-- When there is no tick module (the breakpoint was generated at codegen), use
    
    252
    +-- the function on internal mod breaks.
    
    253
    +--
    
    231 254
     -- To avoid cyclic dependencies, we instead receive a function that looks up
    
    232 255
     -- the 'ModBreaks' given a 'Module'
    
    233
    -getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
    
    234
    -getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
    
    256
    +getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
    
    257
    +getBreakXXX view viewInternal lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
    
    235 258
       assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
    
    236 259
         let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
    
    237 260
         case cgb_tick_id cgb of
    
    238
    -      BreakpointId{bi_tick_mod, bi_tick_index}
    
    261
    +      Right BreakpointId{bi_tick_mod, bi_tick_index}
    
    239 262
             | bi_tick_mod == ibi_mod
    
    240 263
             -> do
    
    241 264
               let these_mbs = imodBreaks_modBreaks imbs
    
    ... ... @@ -244,6 +267,8 @@ getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
    244 267
             -> do
    
    245 268
               other_mbs <- lookupModule bi_tick_mod
    
    246 269
               return $ view other_mbs ! bi_tick_index
    
    270
    +      Left l ->
    
    271
    +          return $ viewInternal l
    
    247 272
     
    
    248 273
     --------------------------------------------------------------------------------
    
    249 274
     -- Instances
    

  • compiler/GHC/ByteCode/Instr.hs
    ... ... @@ -260,10 +260,6 @@ data BCInstr
    260 260
        -- Breakpoints
    
    261 261
        | BRK_FUN          !InternalBreakpointId
    
    262 262
     
    
    263
    -   -- An internal breakpoint for triggering a break on any case alternative
    
    264
    -   -- See Note [Debugger: BRK_ALTS]
    
    265
    -   | BRK_ALTS         !Bool {- enabled? -}
    
    266
    -
    
    267 263
     #if MIN_VERSION_rts(1,0,3)
    
    268 264
        -- | A "meta"-instruction for recording the name of a BCO for debugging purposes.
    
    269 265
        -- These are ignored by the interpreter but helpfully printed by the disassmbler.
    
    ... ... @@ -458,7 +454,6 @@ instance Outputable BCInstr where
    458 454
                                  = text "BRK_FUN" <+> text "<breakarray>"
    
    459 455
                                    <+> ppr info_mod <+> ppr infox
    
    460 456
                                    <+> text "<cc>"
    
    461
    -   ppr (BRK_ALTS active)     = text "BRK_ALTS" <+> ppr active
    
    462 457
     #if MIN_VERSION_rts(1,0,3)
    
    463 458
        ppr (BCO_NAME nm)         = text "BCO_NAME" <+> text (show nm)
    
    464 459
     #endif
    
    ... ... @@ -584,7 +579,6 @@ bciStackUse OP_INDEX_ADDR{} = 0
    584 579
     
    
    585 580
     bciStackUse SWIZZLE{}             = 0
    
    586 581
     bciStackUse BRK_FUN{}             = 0
    
    587
    -bciStackUse BRK_ALTS{}            = 0
    
    588 582
     
    
    589 583
     -- These insns actually reduce stack use, but we need the high-tide level,
    
    590 584
     -- so can't use this info.  Not that it matters much.
    

  • compiler/GHC/Linker/Loader.hs
    ... ... @@ -59,6 +59,7 @@ import GHCi.RemoteTypes
    59 59
     import GHC.Iface.Load
    
    60 60
     import GHCi.Message (ConInfoTable(..), LoadedDLL)
    
    61 61
     
    
    62
    +import GHC.ByteCode.Breakpoints
    
    62 63
     import GHC.ByteCode.Linker
    
    63 64
     import GHC.ByteCode.Asm
    
    64 65
     import GHC.ByteCode.Types
    
    ... ... @@ -1711,8 +1712,10 @@ allocateCCS interp ce mbss
    1711 1712
                   let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo
    
    1712 1713
                   let ccs = IM.map
    
    1713 1714
                         (\info ->
    
    1714
    -                      fromMaybe (toRemotePtr nullPtr)
    
    1715
    -                        (M.lookup (cgb_tick_id info) ccss)
    
    1715
    +                      case cgb_tick_id info of
    
    1716
    +                        Right bi -> fromMaybe (toRemotePtr nullPtr)
    
    1717
    +                          (M.lookup bi ccss)
    
    1718
    +                        Left InternalBreakLoc{} -> toRemotePtr nullPtr
    
    1716 1719
                         )
    
    1717 1720
                         imodBreaks_breakInfo
    
    1718 1721
                   assertPpr (count == length ccs)
    

  • compiler/GHC/Runtime/Debugger/Breakpoints.hs
    ... ... @@ -253,8 +253,11 @@ mkBreakpointOccurrences = do
    253 253
           let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
    
    254 254
           IntMap.foldrWithKey (\info_ix cgi bmp -> do
    
    255 255
               let ibi = InternalBreakpointId imod info_ix
    
    256
    -          let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
    
    257
    -          extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
    
    256
    +          case cgb_tick_id cgi of
    
    257
    +            Right (BreakpointId tick_mod tick_ix)
    
    258
    +              -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
    
    259
    +            Left _
    
    260
    +              -> bmp
    
    258 261
             ) bmp0 (imodBreaks_breakInfo ibrks)
    
    259 262
     
    
    260 263
     --------------------------------------------------------------------------------
    
    ... ... @@ -287,7 +290,7 @@ getCurrentBreakModule = do
    287 290
             Nothing -> pure Nothing
    
    288 291
             Just ibi -> do
    
    289 292
               brks <- readIModBreaks hug ibi
    
    290
    -          return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
    
    293
    +          return $ Just $ getBreakSourceMod ibi brks
    
    291 294
           ix ->
    
    292 295
               Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
    
    293 296
     

  • compiler/GHC/Runtime/Eval.hs
    ... ... @@ -151,7 +151,7 @@ getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
    151 151
     getHistoryModule hug hist = do
    
    152 152
       let ibi = historyBreakpointId hist
    
    153 153
       brks <- readIModBreaks hug ibi
    
    154
    -  return $ bi_tick_mod $ getBreakSourceId ibi brks
    
    154
    +  return $ getBreakSourceMod ibi brks
    
    155 155
     
    
    156 156
     getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
    
    157 157
     getHistorySpan hug hist = do
    

  • compiler/GHC/StgToByteCode.hs
    ... ... @@ -63,7 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
    63 63
                                   assertNonVoidIds, assertNonVoidStgArgs )
    
    64 64
     import GHC.StgToCmm.Layout
    
    65 65
     import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
    
    66
    -import GHC.Runtime.Interpreter ( interpreterProfiled )
    
    66
    +import GHC.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks )
    
    67 67
     import GHC.Data.Bitmap
    
    68 68
     import GHC.Data.FlatBag as FlatBag
    
    69 69
     import GHC.Data.OrdList
    
    ... ... @@ -99,6 +99,7 @@ import GHC.CoreToIface
    99 99
     import Control.Monad.IO.Class
    
    100 100
     import Control.Monad.Trans.Reader (ReaderT(..))
    
    101 101
     import Control.Monad.Trans.State  (StateT(..))
    
    102
    +import Data.Array ((!))
    
    102 103
     
    
    103 104
     -- -----------------------------------------------------------------------------
    
    104 105
     -- Generating byte code for a complete module
    
    ... ... @@ -393,26 +394,26 @@ schemeR_wrk fvs nm original_body (args, body)
    393 394
     -- | Introduce break instructions for ticked expressions.
    
    394 395
     -- If no breakpoint information is available, the instruction is omitted.
    
    395 396
     schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
    
    396
    -schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
    
    397
    -  code <- schemeE d 0 p rhs
    
    398
    -  mb_current_mod_breaks <- getCurrentModBreaks
    
    399
    -  case mb_current_mod_breaks of
    
    400
    -    -- if we're not generating ModBreaks for this module for some reason, we
    
    401
    -    -- can't store breakpoint occurrence information.
    
    402
    -    Nothing -> pure code
    
    403
    -    Just current_mod_breaks -> do
    
    404
    -      platform <- profilePlatform <$> getProfile
    
    405
    -      let idOffSets = getVarOffSets platform d p fvs
    
    406
    -          ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    
    407
    -          toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    
    408
    -          toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    
    409
    -          breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
    
    397
    +schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
    
    398
    +  platform <- profilePlatform <$> getProfile
    
    399
    +
    
    400
    +  -- When we find a tick we update the "last breakpoint location".
    
    401
    +  -- We use it when constructing step-out BRK_FUNs in doCase
    
    402
    +  -- See Note [Debugger: Stepout internal break locs]
    
    403
    +  code <- withBreakTick bp $ schemeE d 0 p rhs
    
    404
    +
    
    405
    +  let idOffSets = getVarOffSets platform d p fvs
    
    406
    +      ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    
    407
    +      toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    
    408
    +      toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    
    409
    +      breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Right tick_id)
    
    410 410
     
    
    411
    -      let info_mod = modBreaks_module current_mod_breaks
    
    412
    -      infox <- newBreakInfo breakInfo
    
    411
    +  mibi <- newBreakInfo breakInfo
    
    412
    +
    
    413
    +  return $ case mibi of
    
    414
    +    Nothing  -> code
    
    415
    +    Just ibi -> BRK_FUN ibi `consOL` code
    
    413 416
     
    
    414
    -      let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
    
    415
    -      return $ breakInstr `consOL` code
    
    416 417
     schemeER_wrk d p rhs = schemeE d 0 p rhs
    
    417 418
     
    
    418 419
     getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
    
    ... ... @@ -1140,43 +1141,34 @@ doCase d s p scrut bndr alts
    1140 1141
             -- When an alt is entered, it assumes the returned value is
    
    1141 1142
             -- on top of the itbl; see Note [Return convention for non-tuple values]
    
    1142 1143
             -- for details.
    
    1143
    -        ret_frame_size_b :: StackDepth
    
    1144
    -        ret_frame_size_b | ubx_tuple_frame =
    
    1145
    -                             (if profiling then 5 else 4) * wordSize platform
    
    1146
    -                         | otherwise = 2 * wordSize platform
    
    1144
    +        ret_frame_size_w :: WordOff
    
    1145
    +        ret_frame_size_w | ubx_tuple_frame =
    
    1146
    +                             if profiling then 5 else 4
    
    1147
    +                         | otherwise = 2
    
    1147 1148
     
    
    1148 1149
             -- The stack space used to save/restore the CCCS when profiling
    
    1149 1150
             save_ccs_size_b | profiling &&
    
    1150 1151
                               not ubx_tuple_frame = 2 * wordSize platform
    
    1151 1152
                             | otherwise = 0
    
    1152 1153
     
    
    1153
    -        -- The size of the return frame info table pointer if one exists
    
    1154
    -        unlifted_itbl_size_b :: StackDepth
    
    1155
    -        unlifted_itbl_size_b | ubx_tuple_frame = wordSize platform
    
    1156
    -                             | otherwise       = 0
    
    1157
    -
    
    1158 1154
             (bndr_size, call_info, args_offsets)
    
    1159 1155
                | ubx_tuple_frame =
    
    1160 1156
                    let bndr_reps = typePrimRep (idType bndr)
    
    1161 1157
                        (call_info, args_offsets) =
    
    1162 1158
                            layoutNativeCall profile NativeTupleReturn 0 id bndr_reps
    
    1163
    -               in ( wordsToBytes platform (nativeCallSize call_info)
    
    1159
    +               in ( nativeCallSize call_info
    
    1164 1160
                       , call_info
    
    1165 1161
                       , args_offsets
    
    1166 1162
                       )
    
    1167
    -           | otherwise = ( wordsToBytes platform (idSizeW platform bndr)
    
    1163
    +           | otherwise = ( idSizeW platform bndr
    
    1168 1164
                              , voidTupleReturnInfo
    
    1169 1165
                              , []
    
    1170 1166
                              )
    
    1171 1167
     
    
    1172
    -        -- depth of stack after the return value has been pushed
    
    1168
    +        -- Depth of stack after the return value has been pushed
    
    1169
    +        -- This is the stack depth at the continuation.
    
    1173 1170
             d_bndr =
    
    1174
    -            d + ret_frame_size_b + bndr_size
    
    1175
    -
    
    1176
    -        -- depth of stack after the extra info table for an unlifted return
    
    1177
    -        -- has been pushed, if any.  This is the stack depth at the
    
    1178
    -        -- continuation.
    
    1179
    -        d_alts = d + ret_frame_size_b + bndr_size + unlifted_itbl_size_b
    
    1171
    +            d + wordsToBytes platform bndr_size
    
    1180 1172
     
    
    1181 1173
             -- Env in which to compile the alts, not including
    
    1182 1174
             -- any vars bound by the alts themselves
    
    ... ... @@ -1188,13 +1180,13 @@ doCase d s p scrut bndr alts
    1188 1180
             -- given an alt, return a discr and code for it.
    
    1189 1181
             codeAlt :: CgStgAlt -> BcM (Discr, BCInstrList)
    
    1190 1182
             codeAlt GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=rhs}
    
    1191
    -           = do rhs_code <- schemeE d_alts s p_alts rhs
    
    1183
    +           = do rhs_code <- schemeE d_bndr s p_alts rhs
    
    1192 1184
                     return (NoDiscr, rhs_code)
    
    1193 1185
     
    
    1194 1186
             codeAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs}
    
    1195 1187
                -- primitive or nullary constructor alt: no need to UNPACK
    
    1196 1188
                | null real_bndrs = do
    
    1197
    -                rhs_code <- schemeE d_alts s p_alts rhs
    
    1189
    +                rhs_code <- schemeE d_bndr s p_alts rhs
    
    1198 1190
                     return (my_discr alt, rhs_code)
    
    1199 1191
                | isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
    
    1200 1192
                  let bndr_ty = idPrimRepU . fromNonVoid
    
    ... ... @@ -1206,7 +1198,7 @@ doCase d s p scrut bndr alts
    1206 1198
                                         bndr_ty
    
    1207 1199
                                         (assertNonVoidIds bndrs)
    
    1208 1200
     
    
    1209
    -                 stack_bot = d_alts
    
    1201
    +                 stack_bot = d_bndr
    
    1210 1202
     
    
    1211 1203
                      p' = Map.insertList
    
    1212 1204
                             [ (arg, tuple_start -
    
    ... ... @@ -1224,7 +1216,7 @@ doCase d s p scrut bndr alts
    1224 1216
                              (addIdReps (assertNonVoidIds real_bndrs))
    
    1225 1217
                      size = WordOff tot_wds
    
    1226 1218
     
    
    1227
    -                 stack_bot = d_alts + wordsToBytes platform size
    
    1219
    +                 stack_bot = d_bndr + wordsToBytes platform size
    
    1228 1220
     
    
    1229 1221
                      -- convert offsets from Sp into offsets into the virtual stack
    
    1230 1222
                      p' = Map.insertList
    
    ... ... @@ -1324,22 +1316,53 @@ doCase d s p scrut bndr alts
    1324 1316
          alt_stuff <- mapM codeAlt alts
    
    1325 1317
          alt_final0 <- mkMultiBranch maybe_ncons alt_stuff
    
    1326 1318
     
    
    1327
    -     let alt_final1
    
    1328
    -           | ubx_tuple_frame    = SLIDE 0 2 `consOL` alt_final0
    
    1329
    -           | otherwise          = alt_final0
    
    1330
    -         alt_final
    
    1331
    -           | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
    
    1332
    -                                -- See Note [Debugger: BRK_ALTS]
    
    1333
    -                                = BRK_ALTS False `consOL` alt_final1
    
    1334
    -           | otherwise          = alt_final1
    
    1319
    +     let
    
    1320
    +
    
    1321
    +         -- drop the stg_ctoi_*_info header...
    
    1322
    +         alt_final1 = SLIDE bndr_size ret_frame_size_w `consOL` alt_final0
    
    1323
    +
    
    1324
    +         -- after dropping the stg_ret_*_info header
    
    1325
    +         alt_final2
    
    1326
    +           | ubx_tuple_frame    = SLIDE 0 3 `consOL` alt_final1
    
    1327
    +           | otherwise          = SLIDE 0 1 `consOL` alt_final1
    
    1328
    +
    
    1329
    +     -- When entering a case continuation BCO, the stack is always headed
    
    1330
    +     -- by the stg_ret frame and the stg_ctoi frame that returned to it.
    
    1331
    +     -- See Note [Stack layout when entering run_BCO]
    
    1332
    +     --
    
    1333
    +     -- Right after the breakpoint instruction, a case continuation BCO
    
    1334
    +     -- drops the stg_ret and stg_ctoi frame headers (see alt_final1,
    
    1335
    +     -- alt_final2), leaving the stack with the scrutinee followed by the
    
    1336
    +     -- free variables (with depth==d_bndr)
    
    1337
    +     alt_final <- getLastBreakTick >>= \case
    
    1338
    +       Just (Breakpoint tick_ty tick_id fvs)
    
    1339
    +         | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
    
    1340
    +         -- Construct an internal breakpoint to put at the start of this case
    
    1341
    +         -- continuation BCO, for step-out.
    
    1342
    +         -- See Note [Debugger: Stepout internal break locs]
    
    1343
    +         -> do
    
    1344
    +          internal_tick_loc <- makeCaseInternalBreakLoc tick_id
    
    1345
    +
    
    1346
    +          -- same fvs available in the case expression are available in the case continuation
    
    1347
    +          let idOffSets = getVarOffSets platform d p fvs
    
    1348
    +              ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    
    1349
    +              toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    
    1350
    +              toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    
    1351
    +              breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Left internal_tick_loc)
    
    1352
    +
    
    1353
    +          mibi <- newBreakInfo breakInfo
    
    1354
    +          return $ case mibi of
    
    1355
    +            Nothing  -> alt_final2
    
    1356
    +            Just ibi -> BRK_FUN ibi `consOL` alt_final2
    
    1357
    +       _ -> pure alt_final2
    
    1335 1358
     
    
    1336 1359
          add_bco_name <- shouldAddBcoName
    
    1337 1360
          let
    
    1338 1361
              alt_bco_name = getName bndr
    
    1339 1362
              alt_bco = mkProtoBCO platform add_bco_name alt_bco_name alt_final (Left alts)
    
    1340 1363
                            0{-no arity-} bitmap_size bitmap True{-is alts-}
    
    1341
    -     scrut_code <- schemeE (d + ret_frame_size_b + save_ccs_size_b)
    
    1342
    -                           (d + ret_frame_size_b + save_ccs_size_b)
    
    1364
    +     scrut_code <- schemeE (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
    
    1365
    +                           (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
    
    1343 1366
                                p scrut
    
    1344 1367
          if ubx_tuple_frame
    
    1345 1368
            then do let tuple_bco = tupleBCO platform call_info args_offsets
    
    ... ... @@ -1351,72 +1374,122 @@ doCase d s p scrut bndr alts
    1351 1374
                       _     -> panic "schemeE(StgCase).push_alts"
    
    1352 1375
                 in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
    
    1353 1376
     
    
    1377
    +-- | Come up with an 'InternalBreakLoc' from the location of the given 'BreakpointId'.
    
    1378
    +-- See also Note [Debugger: Stepout internal break locs]
    
    1379
    +makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
    
    1380
    +makeCaseInternalBreakLoc bid = do
    
    1381
    +  hug         <- hsc_HUG <$> getHscEnv
    
    1382
    +  curr_mod    <- getCurrentModule
    
    1383
    +  mb_mod_brks <- getCurrentModBreaks
    
    1384
    +
    
    1385
    +  InternalBreakLoc <$> case bid of
    
    1386
    +    BreakpointId{bi_tick_mod, bi_tick_index}
    
    1387
    +      | bi_tick_mod == curr_mod
    
    1388
    +      , Just these_mbs <- mb_mod_brks
    
    1389
    +      -> do
    
    1390
    +        return $ modBreaks_locs these_mbs ! bi_tick_index
    
    1391
    +      | otherwise
    
    1392
    +      -> do
    
    1393
    +        other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod
    
    1394
    +        return $ modBreaks_locs other_mbs ! bi_tick_index
    
    1395
    +
    
    1354 1396
     {-
    
    1355
    -Note [Debugger: BRK_ALTS]
    
    1356
    -~~~~~~~~~~~~~~~~~~~~~~~~~
    
    1357
    -As described in Note [Debugger: Step-out] in rts/Interpreter.c, to implement
    
    1358
    -the stepping-out debugger feature we traverse the stack at runtime, identify
    
    1359
    -the first continuation BCO, and explicitly enable that BCO's breakpoint thus
    
    1360
    -ensuring that we stop exactly when we return to the continuation.
    
    1361
    -
    
    1362
    -However, case continuation BCOs (produced by PUSH_ALTS and which merely compute
    
    1363
    -which case alternative BCO to enter next) contain no user-facing breakpoint
    
    1364
    -ticks (BRK_FUN). While we could in principle add breakpoints in case continuation
    
    1365
    -BCOs, there are a few reasons why this is not an attractive option:
    
    1366
    -
    
    1367
    -  1) It's not useful to a user stepping through the program to always have a
    
    1368
    -  breakpoint after the scrutinee is evaluated but before the case alternative
    
    1369
    -  is selected. The source span associated with such a breakpoint would also be
    
    1370
    -  slightly awkward to choose.
    
    1371
    -
    
    1372
    -  2) It's not easy to add a breakpoint tick before the case alternatives because in
    
    1373
    -  essentially all internal representations they are given as a list of Alts
    
    1374
    -  rather than an expression.
    
    1375
    -
    
    1376
    -To provide the debugger a way to break in a case continuation
    
    1377
    -despite the BCOs' lack of BRK_FUNs, we introduce an alternative
    
    1378
    -type of breakpoint, represented by the BRK_ALTS instruction,
    
    1379
    -at the start of every case continuation BCO. For instance,
    
    1380
    -
    
    1381
    -    case x of
    
    1382
    -      0# -> ...
    
    1383
    -      _  -> ...
    
    1384
    -
    
    1385
    -will produce a continuation of the form (N.B. the below bytecode
    
    1386
    -is simplified):
    
    1387
    -
    
    1388
    -    PUSH_ALTS P
    
    1389
    -      BRK_ALTS 0
    
    1390
    -      TESTEQ_I 0 lblA
    
    1391
    -      PUSH_BCO
    
    1392
    -        BRK_FUN 0
    
    1393
    -        -- body of 0# alternative
    
    1394
    -      ENTER
    
    1395
    -
    
    1396
    -      lblA:
    
    1397
    -      PUSH_BCO
    
    1398
    -        BRK_FUN 1
    
    1399
    -        -- body of wildcard alternative
    
    1400
    -      ENTER
    
    1401
    -
    
    1402
    -When enabled (by its single boolean operand), the BRK_ALTS instruction causes
    
    1403
    -the program to break at the next encountered breakpoint (implemented
    
    1404
    -by setting the TSO's TSO_STOP_NEXT_BREAKPOINT flag). Since the case
    
    1405
    -continuation BCO will ultimately jump to one of the alternatives (each of
    
    1406
    -which having its own BRK_FUN) we are guaranteed to stop in the taken alternative.
    
    1407
    -
    
    1408
    -It's important that BRK_ALTS (just like BRK_FUN) is the first instruction of
    
    1409
    -the BCO, since that's where the debugger will look to enable it at runtime.
    
    1410
    -
    
    1411
    -KNOWN ISSUES:
    
    1412
    --------------
    
    1413
    -This implementation of BRK_ALTS that modifies the first argument of the
    
    1414
    -bytecode to enable it does not allow multi-threaded debugging because the BCO
    
    1415
    -object is shared across threads and enabling the breakpoint in one will enable
    
    1416
    -it in all other threads too. This will have to change to support multi-threads
    
    1417
    -debugging.
    
    1418
    -
    
    1419
    -The progress towards multi-threaded debugging is tracked by #26064
    
    1397
    +Note [Debugger: Stepout internal break locs]
    
    1398
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    1399
    +Step-out tells the interpreter to run until the current function
    
    1400
    +returns to where it was called from, and stop there.
    
    1401
    +
    
    1402
    +This is achieved by enabling the BRK_FUN found on the first RET_BCO
    
    1403
    +frame on the stack (See [Note Debugger: Step-out]).
    
    1404
    +
    
    1405
    +Case continuation BCOs (which select an alternative branch) must
    
    1406
    +therefore be headed by a BRK_FUN. An example:
    
    1407
    +
    
    1408
    +    f x = case g x of <--- end up here
    
    1409
    +        1 -> ...
    
    1410
    +        2 -> ...
    
    1411
    +
    
    1412
    +    g y = ... <--- step out from here
    
    1413
    +
    
    1414
    +- `g` will return a value to the case continuation BCO in `f`
    
    1415
    +- The case continuation BCO will receive the value returned from g
    
    1416
    +- Match on it and push the alternative continuation for that branch
    
    1417
    +- And then enter that alternative.
    
    1418
    +
    
    1419
    +If we step-out of `g`, the first RET_BCO on the stack is the case
    
    1420
    +continuation of `f` -- execution should stop at its start, before
    
    1421
    +selecting an alternative. (One might ask, "why not enable the breakpoint
    
    1422
    +in the alternative instead?", because the alternative continuation is
    
    1423
    +only pushed to the stack *after* it is selected by the case cont. BCO)
    
    1424
    +
    
    1425
    +However, the case cont. BCO is not associated with any source-level
    
    1426
    +tick, it is merely the glue code which selects alternatives which do
    
    1427
    +have source level ticks. Therefore, we have to come up at code
    
    1428
    +generation time with a breakpoint location ('InternalBreakLoc') to
    
    1429
    +display to the user when it is stopped there.
    
    1430
    +
    
    1431
    +Our solution is to use the last tick seen just before reaching the case
    
    1432
    +continuation. This is robust because a case continuation will thus
    
    1433
    +always have a relevant breakpoint location:
    
    1434
    +
    
    1435
    +    - The source location will be the last source-relevant expression
    
    1436
    +      executed before the continuation is pushed
    
    1437
    +
    
    1438
    +    - So the source location will point to the thing you've just stepped
    
    1439
    +      out of
    
    1440
    +
    
    1441
    +    - Doing :step-local from there will put you on the selected
    
    1442
    +      alternative (which at the source level may also be the e.g. next
    
    1443
    +      line in a do-block)
    
    1444
    +
    
    1445
    +Examples, using angle brackets (<<...>>) to denote the breakpoint span:
    
    1446
    +
    
    1447
    +    f x = case <<g x>> {- step in here -} of
    
    1448
    +        1 -> ...
    
    1449
    +        2 -> ...>
    
    1450
    +
    
    1451
    +    g y = <<...>> <--- step out from here
    
    1452
    +
    
    1453
    +    ...
    
    1454
    +
    
    1455
    +    f x = <<case g x of <--- end up here, whole case highlighted
    
    1456
    +        1 -> ...
    
    1457
    +        2 -> ...>>
    
    1458
    +
    
    1459
    +    doing :step-local ...
    
    1460
    +
    
    1461
    +    f x = case g x of
    
    1462
    +        1 -> <<...>> <--- stop in the alternative
    
    1463
    +        2 -> ...
    
    1464
    +
    
    1465
    +A second example based on T26042d2, where the source is a do-block IO
    
    1466
    +action, optimised to a chain of `case expressions`.
    
    1467
    +
    
    1468
    +    main = do
    
    1469
    +      putStrLn "hello1"
    
    1470
    +      <<f>> <--- step-in here
    
    1471
    +      putStrLn "hello3"
    
    1472
    +      putStrLn "hello4"
    
    1473
    +
    
    1474
    +    f = do
    
    1475
    +      <<putStrLn "hello2.1">> <--- step-out from here
    
    1476
    +      putStrLn "hello2.2"
    
    1477
    +
    
    1478
    +    ...
    
    1479
    +
    
    1480
    +    main = do
    
    1481
    +      putStrLn "hello1"
    
    1482
    +      <<f>> <--- end up here again, the previously executed expression
    
    1483
    +      putStrLn "hello3"
    
    1484
    +      putStrLn "hello4"
    
    1485
    +
    
    1486
    +    doing step/step-local ...
    
    1487
    +
    
    1488
    +    main = do
    
    1489
    +      putStrLn "hello1"
    
    1490
    +      f
    
    1491
    +      <<putStrLn "hello3">> <--- straight to the next line
    
    1492
    +      putStrLn "hello4"
    
    1420 1493
     -}
    
    1421 1494
     
    
    1422 1495
     -- -----------------------------------------------------------------------------
    
    ... ... @@ -2619,6 +2692,7 @@ data BcM_Env
    2619 2692
             { bcm_hsc_env    :: !HscEnv
    
    2620 2693
             , bcm_module     :: !Module -- current module (for breakpoints)
    
    2621 2694
             , modBreaks      :: !(Maybe ModBreaks)
    
    2695
    +        , last_bp_tick   :: !(Maybe StgTickish)
    
    2622 2696
             }
    
    2623 2697
     
    
    2624 2698
     data BcM_State
    
    ... ... @@ -2637,7 +2711,7 @@ newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (r, BcM_State))
    2637 2711
     
    
    2638 2712
     runBc :: HscEnv -> Module -> Maybe ModBreaks -> BcM r -> IO (r, BcM_State)
    
    2639 2713
     runBc hsc_env this_mod mbs (BcM m)
    
    2640
    -   = m (BcM_Env hsc_env this_mod mbs) (BcM_State 0 0 IntMap.empty)
    
    2714
    +   = m (BcM_Env hsc_env this_mod mbs Nothing) (BcM_State 0 0 IntMap.empty)
    
    2641 2715
     
    
    2642 2716
     instance HasDynFlags BcM where
    
    2643 2717
         getDynFlags = hsc_dflags <$> getHscEnv
    
    ... ... @@ -2667,14 +2741,19 @@ getLabelsBc n = BcM $ \_ st ->
    2667 2741
       let ctr = nextlabel st
    
    2668 2742
        in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
    
    2669 2743
     
    
    2670
    -newBreakInfo :: CgBreakInfo -> BcM Int
    
    2671
    -newBreakInfo info = BcM $ \_ st ->
    
    2672
    -  let ix = breakInfoIdx st
    
    2673
    -      st' = st
    
    2674
    -        { breakInfo = IntMap.insert ix info (breakInfo st)
    
    2675
    -        , breakInfoIdx = ix + 1
    
    2676
    -        }
    
    2677
    -  in return (ix, st')
    
    2744
    +newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
    
    2745
    +newBreakInfo info = BcM $ \env st -> do
    
    2746
    +  -- if we're not generating ModBreaks for this module for some reason, we
    
    2747
    +  -- can't store breakpoint occurrence information.
    
    2748
    +  case modBreaks env of
    
    2749
    +    Nothing -> pure (Nothing, st)
    
    2750
    +    Just modBreaks -> do
    
    2751
    +      let ix = breakInfoIdx st
    
    2752
    +          st' = st
    
    2753
    +            { breakInfo = IntMap.insert ix info (breakInfo st)
    
    2754
    +            , breakInfoIdx = ix + 1
    
    2755
    +            }
    
    2756
    +      return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
    
    2678 2757
     
    
    2679 2758
     getCurrentModule :: BcM Module
    
    2680 2759
     getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
    
    ... ... @@ -2682,12 +2761,20 @@ getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
    2682 2761
     getCurrentModBreaks :: BcM (Maybe ModBreaks)
    
    2683 2762
     getCurrentModBreaks = BcM $ \env st -> return (modBreaks env, st)
    
    2684 2763
     
    
    2764
    +withBreakTick :: StgTickish -> BcM a -> BcM a
    
    2765
    +withBreakTick bp (BcM act) = BcM $ \env st ->
    
    2766
    +  act env{last_bp_tick=Just bp} st
    
    2767
    +
    
    2768
    +getLastBreakTick :: BcM (Maybe StgTickish)
    
    2769
    +getLastBreakTick = BcM $ \env st ->
    
    2770
    +  pure (last_bp_tick env, st)
    
    2771
    +
    
    2685 2772
     tickFS :: FastString
    
    2686 2773
     tickFS = fsLit "ticked"
    
    2687 2774
     
    
    2688 2775
     -- Dehydrating CgBreakInfo
    
    2689 2776
     
    
    2690
    -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
    
    2777
    +dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
    
    2691 2778
     dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
    
    2692 2779
               CgBreakInfo
    
    2693 2780
                 { cgb_tyvars = map toIfaceTvBndr ty_vars
    

  • ghc/GHCi/UI.hs
    ... ... @@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
    45 45
     import GHC.Runtime.Eval.Utils
    
    46 46
     
    
    47 47
     -- The GHC interface
    
    48
    -import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
    
    48
    +import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId, getBreakSourceMod)
    
    49 49
     import GHC.Runtime.Interpreter
    
    50 50
     import GHCi.RemoteTypes
    
    51 51
     import GHCi.BreakArray( breakOn, breakOff )
    
    ... ... @@ -1621,7 +1621,7 @@ toBreakIdAndLocation (Just inf) = do
    1621 1621
       brks <- liftIO $ readIModBreaks hug inf
    
    1622 1622
       let bi = getBreakSourceId inf brks
    
    1623 1623
       return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
    
    1624
    -                                  breakId loc == bi ]
    
    1624
    +                                  Right (breakId loc) == bi ]
    
    1625 1625
     
    
    1626 1626
     printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
    
    1627 1627
     printStoppedAtBreakInfo res names = do
    
    ... ... @@ -3825,7 +3825,7 @@ pprStopped res = do
    3825 3825
           hug <- hsc_HUG <$> GHC.getSession
    
    3826 3826
           brks <- liftIO $ readIModBreaks hug ibi
    
    3827 3827
           return $ Just $ moduleName $
    
    3828
    -        bi_tick_mod $ getBreakSourceId ibi brks
    
    3828
    +        getBreakSourceMod ibi brks
    
    3829 3829
       return $
    
    3830 3830
         text "Stopped in"
    
    3831 3831
           <+> ((case mb_mod_name of
    

  • libraries/ghci/GHCi/Run.hs
    ... ... @@ -362,6 +362,14 @@ withBreakAction opts breakMVar statusMVar mtid act
    362 362
              info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
    
    363 363
              pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
    
    364 364
          putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
    
    365
    +
    
    366
    +     -- Block until this thread is resumed (by the thread which took the
    
    367
    +     -- `ResumeContext` from the `statusMVar`).
    
    368
    +     --
    
    369
    +     -- The `onBreak` function must have been called from `rts/Interpreter.c`
    
    370
    +     -- when interpreting a `BRK_FUN`. After taking from the MVar, the function
    
    371
    +     -- returns to the continuation on the stack which is where the interpreter
    
    372
    +     -- was stopped.
    
    365 373
          takeMVar breakMVar
    
    366 374
     
    
    367 375
        resetBreakAction stablePtr = do
    

  • rts/Disassembler.c
    ... ... @@ -101,9 +101,6 @@ disInstr ( StgBCO *bco, int pc )
    101 101
              }
    
    102 102
              debugBelch("\n");
    
    103 103
              break; }
    
    104
    -      case bci_BRK_ALTS:
    
    105
    -         debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
    
    106
    -         break;
    
    107 104
           case bci_SWIZZLE: {
    
    108 105
              W_     stkoff = BCO_GET_LARGE_ARG;
    
    109 106
              StgInt by     = BCO_GET_LARGE_ARG;
    

  • rts/Interpreter.c
    ... ... @@ -284,6 +284,18 @@ allocate_NONUPD (Capability *cap, int n_words)
    284 284
         return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
    
    285 285
     }
    
    286 286
     
    
    287
    +STATIC_INLINE int
    
    288
    +is_ret_bco_frame(const StgPtr frame_head) {
    
    289
    +  return ( (W_)frame_head == (W_)&stg_ret_t_info
    
    290
    +        || (W_)frame_head == (W_)&stg_ret_v_info
    
    291
    +        || (W_)frame_head == (W_)&stg_ret_p_info
    
    292
    +        || (W_)frame_head == (W_)&stg_ret_n_info
    
    293
    +        || (W_)frame_head == (W_)&stg_ret_f_info
    
    294
    +        || (W_)frame_head == (W_)&stg_ret_d_info
    
    295
    +        || (W_)frame_head == (W_)&stg_ret_l_info
    
    296
    +      );
    
    297
    +}
    
    298
    +
    
    287 299
     int rts_stop_on_exception = 0;
    
    288 300
     
    
    289 301
     /* ---------------------------------------------------------------------------
    
    ... ... @@ -346,16 +358,11 @@ to the continuation.
    346 358
     To achieve this, when the flag is set as the interpreter is re-entered:
    
    347 359
       (1) Traverse the stack until a RET_BCO frame is found or we otherwise hit the
    
    348 360
           bottom (STOP_FRAME).
    
    349
    -  (2) Look for a breakpoint instruction heading the BCO instructions (a
    
    361
    +  (2) Look for a BRK_FUN instruction heading the BCO instructions (a
    
    350 362
           breakpoint, when present, is always the first instruction in a BCO)
    
    351 363
     
    
    352
    -      (2a) For PUSH_ALT BCOs, the breakpoint instruction will be BRK_ALTS
    
    353
    -          (as explained in Note [Debugger: BRK_ALTS]) and it can be enabled by
    
    354
    -          setting its first operand to 1.
    
    355
    -
    
    356
    -      (2b) Otherwise, the instruction will be BRK_FUN and the breakpoint can be
    
    357
    -           enabled by setting the associated BreakArray at the associated tick
    
    358
    -           index to 0.
    
    364
    +      The breakpoint can be enabled by setting the associated BreakArray at the
    
    365
    +      associated internal breakpoint index to 0.
    
    359 366
     
    
    360 367
     By simply enabling the breakpoint heading the continuation we can ensure that
    
    361 368
     when it is returned to we will stop there without additional work -- it
    
    ... ... @@ -692,8 +699,13 @@ interpretBCO (Capability* cap)
    692 699
           StgPtr restoreStackPointer = Sp;
    
    693 700
     
    
    694 701
           /* The first BCO on the stack is the one we are already stopped at.
    
    695
    -       * Skip it. */
    
    696
    -      Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
    
    702
    +       * Skip it. In the case of returning to a case cont. BCO, there are two
    
    703
    +       * frames to skip before we reach the first continuation frame.
    
    704
    +       * */
    
    705
    +      int to_skip = is_ret_bco_frame((StgPtr)SpW(0)) ? 2 : 1;
    
    706
    +      for (int i = 0; i < to_skip; i++) {
    
    707
    +        Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp));
    
    708
    +      }
    
    697 709
     
    
    698 710
           /* Traverse upwards until continuation BCO, or the end */
    
    699 711
           while ((type = get_itbl((StgClosure*)Sp)->type) != RET_BCO
    
    ... ... @@ -711,8 +723,8 @@ interpretBCO (Capability* cap)
    711 723
             int bciPtr = 0;
    
    712 724
             StgWord16 bci = BCO_NEXT;
    
    713 725
     
    
    714
    -        /* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
    
    715
    -         * instruction in a BCO */
    
    726
    +        /* A breakpoint instruction (BRK_FUN) can only be the first instruction
    
    727
    +         * in a BCO */
    
    716 728
             if ((bci & 0xFF) == bci_BRK_FUN) {
    
    717 729
     
    
    718 730
                 W_ arg1_brk_array, arg4_info_index;
    
    ... ... @@ -727,10 +739,6 @@ interpretBCO (Capability* cap)
    727 739
                 // ACTIVATE the breakpoint by tick index
    
    728 740
                 ((StgInt*)breakPoints->payload)[arg4_info_index] = 0;
    
    729 741
             }
    
    730
    -        else if ((bci & 0xFF) == bci_BRK_ALTS) {
    
    731
    -            // ACTIVATE BRK_ALTS by setting its only argument to ON
    
    732
    -            instrs[1] = 1;
    
    733
    -        }
    
    734 742
             // else: if there is no BRK instruction perhaps we should keep
    
    735 743
             // traversing; that said, the continuation should always have a BRK
    
    736 744
           }
    
    ... ... @@ -844,7 +852,6 @@ eval_obj:
    844 852
                  debugBelch("\n\n");
    
    845 853
                 );
    
    846 854
     
    
    847
    -//    IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
    
    848 855
         IF_DEBUG(sanity,checkStackFrame(Sp));
    
    849 856
     
    
    850 857
         switch ( get_itbl(obj)->type ) {
    
    ... ... @@ -1086,11 +1093,33 @@ do_return_pointer:
    1086 1093
             // Returning to an interpreted continuation: put the object on
    
    1087 1094
             // the stack, and start executing the BCO.
    
    1088 1095
             INTERP_TICK(it_retto_BCO);
    
    1089
    -        Sp_subW(1);
    
    1090
    -        SpW(0) = (W_)tagged_obj;
    
    1091
    -        obj = (StgClosure*)ReadSpW(2);
    
    1096
    +        obj = (StgClosure*)ReadSpW(1);
    
    1092 1097
             ASSERT(get_itbl(obj)->type == BCO);
    
    1093
    -        goto run_BCO_return_pointer;
    
    1098
    +
    
    1099
    +        // Heap check
    
    1100
    +        if (doYouWantToGC(cap)) {
    
    1101
    +            Sp_subW(2);
    
    1102
    +            SpW(1) = (W_)tagged_obj;
    
    1103
    +            SpW(0) = (W_)&stg_ret_p_info;
    
    1104
    +            RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    
    1105
    +        }
    
    1106
    +        else {
    
    1107
    +
    
    1108
    +          // Stack checks aren't necessary at return points, the stack use
    
    1109
    +          // is aggregated into the enclosing function entry point.
    
    1110
    +
    
    1111
    +          // Make sure stack is headed by a ctoi R1p frame when returning a pointer
    
    1112
    +          ASSERT(ReadSpW(0) == (W_)&stg_ctoi_R1p_info);
    
    1113
    +
    
    1114
    +          // Add the return frame on top of the args
    
    1115
    +          Sp_subW(2);
    
    1116
    +          SpW(1) = (W_)tagged_obj;
    
    1117
    +          SpW(0) = (W_)&stg_ret_p_info;
    
    1118
    +        }
    
    1119
    +
    
    1120
    +        /* Keep the ret frame and the ctoi frame for run_BCO.
    
    1121
    +         * See Note [Stack layout when entering run_BCO] */
    
    1122
    +        goto run_BCO;
    
    1094 1123
     
    
    1095 1124
         default:
    
    1096 1125
         do_return_unrecognised:
    
    ... ... @@ -1159,8 +1188,9 @@ do_return_nonpointer:
    1159 1188
     
    
    1160 1189
             // get the offset of the header of the next stack frame
    
    1161 1190
             offset = stack_frame_sizeW((StgClosure *)Sp);
    
    1191
    +        StgClosure* next_frame = (StgClosure*)(SafeSpWP(offset));
    
    1162 1192
     
    
    1163
    -        switch (get_itbl((StgClosure*)(SafeSpWP(offset)))->type) {
    
    1193
    +        switch (get_itbl(next_frame)->type) {
    
    1164 1194
     
    
    1165 1195
             case RET_BCO:
    
    1166 1196
                 // Returning to an interpreted continuation: pop the return frame
    
    ... ... @@ -1168,8 +1198,58 @@ do_return_nonpointer:
    1168 1198
                 // executing the BCO.
    
    1169 1199
                 INTERP_TICK(it_retto_BCO);
    
    1170 1200
                 obj = (StgClosure*)ReadSpW(offset+1);
    
    1201
    +
    
    1171 1202
                 ASSERT(get_itbl(obj)->type == BCO);
    
    1172
    -            goto run_BCO_return_nonpointer;
    
    1203
    +
    
    1204
    +            // Heap check
    
    1205
    +            if (doYouWantToGC(cap)) {
    
    1206
    +                RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    
    1207
    +            }
    
    1208
    +            else {
    
    1209
    +              // Stack checks aren't necessary at return points, the stack use
    
    1210
    +              // is aggregated into the enclosing function entry point.
    
    1211
    +
    
    1212
    +#if defined(PROFILING)
    
    1213
    +              /*
    
    1214
    +                 Restore the current cost centre stack if a tuple is being returned.
    
    1215
    +
    
    1216
    +                 When a "simple" unlifted value is returned, the cccs is restored with
    
    1217
    +                 an stg_restore_cccs frame on the stack, for example:
    
    1218
    +
    
    1219
    +                     ...
    
    1220
    +                     stg_ctoi_D1
    
    1221
    +                     <CCCS>
    
    1222
    +                     stg_restore_cccs
    
    1223
    +
    
    1224
    +                 But stg_restore_cccs cannot deal with tuples, which may have more
    
    1225
    +                 things on the stack. Therefore we store the CCCS inside the
    
    1226
    +                 stg_ctoi_t frame.
    
    1227
    +
    
    1228
    +                 If we have a tuple being returned, the stack looks like this:
    
    1229
    +
    
    1230
    +                     ...
    
    1231
    +                     <CCCS>           <- to restore, Sp offset <next frame + 4 words>
    
    1232
    +                     tuple_BCO
    
    1233
    +                     tuple_info
    
    1234
    +                     cont_BCO
    
    1235
    +                     stg_ctoi_t       <- next frame
    
    1236
    +                     tuple_data_1
    
    1237
    +                     ...
    
    1238
    +                     tuple_data_n
    
    1239
    +                     tuple_info
    
    1240
    +                     tuple_BCO
    
    1241
    +                     stg_ret_t        <- Sp
    
    1242
    +               */
    
    1243
    +
    
    1244
    +              if(SpW(0) == (W_)&stg_ret_t_info) {
    
    1245
    +                  cap->r.rCCCS = (CostCentreStack*)ReadSpW(offset + 4);
    
    1246
    +              }
    
    1247
    +#endif
    
    1248
    +
    
    1249
    +              /* Keep the ret frame and the ctoi frame for run_BCO.
    
    1250
    +               * See Note [Stack layout when entering run_BCO] */
    
    1251
    +              goto run_BCO;
    
    1252
    +            }
    
    1173 1253
     
    
    1174 1254
             default:
    
    1175 1255
             {
    
    ... ... @@ -1332,111 +1412,90 @@ do_apply:
    1332 1412
                 RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
    
    1333 1413
         }
    
    1334 1414
     
    
    1335
    -    // ------------------------------------------------------------------------
    
    1336
    -    // Ok, we now have a bco (obj), and its arguments are all on the
    
    1337
    -    // stack.  We can start executing the byte codes.
    
    1338
    -    //
    
    1339
    -    // The stack is in one of two states.  First, if this BCO is a
    
    1340
    -    // function:
    
    1341
    -    //
    
    1342
    -    //    |     ....      |
    
    1343
    -    //    +---------------+
    
    1344
    -    //    |     arg2      |
    
    1345
    -    //    +---------------+
    
    1346
    -    //    |     arg1      |
    
    1347
    -    //    +---------------+
    
    1348
    -    //
    
    1349
    -    // Second, if this BCO is a continuation:
    
    1350
    -    //
    
    1351
    -    //    |     ....      |
    
    1352
    -    //    +---------------+
    
    1353
    -    //    |     fv2       |
    
    1354
    -    //    +---------------+
    
    1355
    -    //    |     fv1       |
    
    1356
    -    //    +---------------+
    
    1357
    -    //    |     BCO       |
    
    1358
    -    //    +---------------+
    
    1359
    -    //    | stg_ctoi_ret_ |
    
    1360
    -    //    +---------------+
    
    1361
    -    //    |    retval     |
    
    1362
    -    //    +---------------+
    
    1363
    -    //
    
    1364
    -    // where retval is the value being returned to this continuation.
    
    1365
    -    // In the event of a stack check, heap check, or context switch,
    
    1366
    -    // we need to leave the stack in a sane state so the garbage
    
    1367
    -    // collector can find all the pointers.
    
    1368
    -    //
    
    1369
    -    //  (1) BCO is a function:  the BCO's bitmap describes the
    
    1370
    -    //      pointerhood of the arguments.
    
    1371
    -    //
    
    1372
    -    //  (2) BCO is a continuation: BCO's bitmap describes the
    
    1373
    -    //      pointerhood of the free variables.
    
    1374
    -    //
    
    1375
    -    // Sadly we have three different kinds of stack/heap/cswitch check
    
    1376
    -    // to do:
    
    1377
    -
    
    1378
    -
    
    1379
    -run_BCO_return_pointer:
    
    1380
    -    // Heap check
    
    1381
    -    if (doYouWantToGC(cap)) {
    
    1382
    -        Sp_subW(1); SpW(0) = (W_)&stg_ret_p_info;
    
    1383
    -        RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    
    1384
    -    }
    
    1385
    -    // Stack checks aren't necessary at return points, the stack use
    
    1386
    -    // is aggregated into the enclosing function entry point.
    
    1387
    -
    
    1388
    -    goto run_BCO;
    
    1389
    -
    
    1390
    -run_BCO_return_nonpointer:
    
    1391
    -    // Heap check
    
    1392
    -    if (doYouWantToGC(cap)) {
    
    1393
    -        RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    
    1394
    -    }
    
    1395
    -    // Stack checks aren't necessary at return points, the stack use
    
    1396
    -    // is aggregated into the enclosing function entry point.
    
    1397
    -
    
    1398
    -#if defined(PROFILING)
    
    1399
    -    /*
    
    1400
    -       Restore the current cost centre stack if a tuple is being returned.
    
    1401
    -
    
    1402
    -       When a "simple" unlifted value is returned, the cccs is restored with
    
    1403
    -       an stg_restore_cccs frame on the stack, for example:
    
    1404
    -
    
    1405
    -           ...
    
    1406
    -           stg_ctoi_D1
    
    1407
    -           <CCCS>
    
    1408
    -           stg_restore_cccs
    
    1409
    -
    
    1410
    -       But stg_restore_cccs cannot deal with tuples, which may have more
    
    1411
    -       things on the stack. Therefore we store the CCCS inside the
    
    1412
    -       stg_ctoi_t frame.
    
    1413
    -
    
    1414
    -       If we have a tuple being returned, the stack looks like this:
    
    1415
    -
    
    1416
    -           ...
    
    1417
    -           <CCCS>           <- to restore, Sp offset <next frame + 4 words>
    
    1418
    -           tuple_BCO
    
    1419
    -           tuple_info
    
    1420
    -           cont_BCO
    
    1421
    -           stg_ctoi_t       <- next frame
    
    1422
    -           tuple_data_1
    
    1423
    -           ...
    
    1424
    -           tuple_data_n
    
    1425
    -           tuple_info
    
    1426
    -           tuple_BCO
    
    1427
    -           stg_ret_t        <- Sp
    
    1428
    -     */
    
    1429
    -
    
    1430
    -    if(SpW(0) == (W_)&stg_ret_t_info) {
    
    1431
    -        cap->r.rCCCS = (CostCentreStack*)ReadSpW(stack_frame_sizeW((StgClosure *)Sp) + 4);
    
    1432
    -    }
    
    1433
    -#endif
    
    1434
    -
    
    1435
    -    if (SpW(0) != (W_)&stg_ret_t_info) {
    
    1436
    -      Sp_addW(1);
    
    1437
    -    }
    
    1438
    -    goto run_BCO;
    
    1415
    +/*
    
    1416
    +Note [Stack layout when entering run_BCO]
    
    1417
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    1418
    +We have a bco (obj), and its arguments are all on the stack. We can start
    
    1419
    +executing the byte codes.
    
    1420
    +
    
    1421
    +The stack is in one of two states. First, if this BCO is a
    
    1422
    +function (in run_BCO_fun or run_BCO)
    
    1423
    +
    
    1424
    +   |     ....      |
    
    1425
    +   +---------------+
    
    1426
    +   |     arg2      |
    
    1427
    +   +---------------+
    
    1428
    +   |     arg1      |
    
    1429
    +   +---------------+
    
    1430
    +
    
    1431
    +Second, if this BCO is a case cont., as per Note [Case continuation BCOs] (only
    
    1432
    +in run_BCO):
    
    1433
    +
    
    1434
    +   |     ....      |
    
    1435
    +   +---------------+
    
    1436
    +   |     fv2       |
    
    1437
    +   +---------------+
    
    1438
    +   |     fv1       |
    
    1439
    +   +---------------+
    
    1440
    +   |     BCO       |
    
    1441
    +   +---------------+
    
    1442
    +   | stg_ctoi_ret_ |
    
    1443
    +   +---------------+
    
    1444
    +   |    retval     |
    
    1445
    +   +---------------+
    
    1446
    +   | stg_ret_..... |
    
    1447
    +   +---------------+
    
    1448
    +
    
    1449
    +where retval is the value being returned to this continuation.
    
    1450
    +In the event of a stack check, heap check, context switch,
    
    1451
    +or breakpoint, we need to leave the stack in a sane state so
    
    1452
    +the garbage collector can find all the pointers.
    
    1453
    +
    
    1454
    + (1) BCO is a function:  the BCO's bitmap describes the
    
    1455
    +     pointerhood of the arguments.
    
    1456
    +
    
    1457
    + (2) BCO is a continuation: BCO's bitmap describes the
    
    1458
    +     pointerhood of the free variables.
    
    1459
    +
    
    1460
    +To reconstruct a valid stack state for yielding (such that when we return to
    
    1461
    +the interpreter we end up in the same place from where we yielded), we need to
    
    1462
    +differentiate the two cases again:
    
    1463
    +
    
    1464
    +  (1) For function BCOs, the arguments are directly on top of the stack, so it
    
    1465
    +  suffices to add a `stg_apply_interp_info` frame header using the BCO that is
    
    1466
    +  being applied to these arguments (i.e. the `obj` being run)
    
    1467
    +
    
    1468
    +  (2) For continuation BCOs, the stack is already consistent -- that's why we
    
    1469
    +  keep the ret and ctoi frame on top of the stack when we start executing it.
    
    1470
    +
    
    1471
    +  We couldn't reconstruct a valid stack that resumes the case continuation
    
    1472
    +  execution just from the return and free vars values alone because we wouldn't
    
    1473
    +  know what kind of result it was (are we returning a pointer, non pointer int,
    
    1474
    +  a tuple? etc.); especially considering some frames have different sizes,
    
    1475
    +  notably unboxed tuple return frames (see Note [unboxed tuple bytecodes and tuple_BCO]).
    
    1476
    +
    
    1477
    +  For consistency, the first instructions in a case continuation BCO, right
    
    1478
    +  after a possible BRK_FUN heading it, are two SLIDEs to remove the stg_ret_
    
    1479
    +  and stg_ctoi_ frame headers, leaving only the return value followed by the
    
    1480
    +  free vars. Theses slides use statically known offsets computed in StgToByteCode.hs.
    
    1481
    +  Following the continuation BCO diagram above, SLIDING would result in:
    
    1482
    +
    
    1483
    +   |     ....      |
    
    1484
    +   +---------------+
    
    1485
    +   |     fv2       |
    
    1486
    +   +---------------+
    
    1487
    +   |     fv1       |
    
    1488
    +   +---------------+
    
    1489
    +   |    retval     |
    
    1490
    +   +---------------+
    
    1491
    +*/
    
    1439 1492
     
    
    1493
    +// Ok, we now have a bco (obj), and its arguments are all on the stack as
    
    1494
    +// described by Note [Stack layout when entering run_BCO].
    
    1495
    +// We can start executing the byte codes.
    
    1496
    +//
    
    1497
    +// Sadly we have three different kinds of stack/heap/cswitch check
    
    1498
    +// to do:
    
    1440 1499
     run_BCO_fun:
    
    1441 1500
         IF_DEBUG(sanity,
    
    1442 1501
                  Sp_subW(2);
    
    ... ... @@ -1466,6 +1525,7 @@ run_BCO_fun:
    1466 1525
     
    
    1467 1526
         // Now, actually interpret the BCO... (no returning to the
    
    1468 1527
         // scheduler again until the stack is in an orderly state).
    
    1528
    +    // See also Note [Stack layout when entering run_BCO]
    
    1469 1529
     run_BCO:
    
    1470 1530
         INTERP_TICK(it_BCO_entries);
    
    1471 1531
         {
    
    ... ... @@ -1519,7 +1579,7 @@ run_BCO:
    1519 1579
     
    
    1520 1580
         switch (bci & 0xFF) {
    
    1521 1581
     
    
    1522
    -        /* check for a breakpoint on the beginning of a let binding */
    
    1582
    +        /* check for a breakpoint on the beginning of a BCO */
    
    1523 1583
             case bci_BRK_FUN:
    
    1524 1584
             {
    
    1525 1585
                 W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
    
    ... ... @@ -1572,6 +1632,13 @@ run_BCO:
    1572 1632
                 {
    
    1573 1633
                    breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
    
    1574 1634
     
    
    1635
    +               StgPtr stack_head = (StgPtr)SpW(0);
    
    1636
    +
    
    1637
    +               // When the BRK_FUN is at the start of a case continuation BCO,
    
    1638
    +               // the stack is headed by the frame returning the value at the start.
    
    1639
    +               // See Note [Stack layout when entering run_BCO]
    
    1640
    +               int is_case_cont_BCO = is_ret_bco_frame(stack_head);
    
    1641
    +
    
    1575 1642
                    // stop the current thread if either `stop_next_breakpoint` is
    
    1576 1643
                    // true OR if the ignore count for this particular breakpoint is zero
    
    1577 1644
                    StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
    
    ... ... @@ -1580,36 +1647,80 @@ run_BCO:
    1580 1647
                       // decrement and write back ignore count
    
    1581 1648
                       ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
    
    1582 1649
                    }
    
    1583
    -               else if (stop_next_breakpoint == true || ignore_count == 0)
    
    1650
    +               else if (
    
    1651
    +                  /* Doing step-in (but don't stop at case continuation BCOs,
    
    1652
    +                   * those are only useful when stepping out) */
    
    1653
    +                  (stop_next_breakpoint == true && !is_case_cont_BCO)
    
    1654
    +                  /* Or breakpoint is explicitly enabled */
    
    1655
    +                  || ignore_count == 0)
    
    1584 1656
                    {
    
    1585 1657
                       // make sure we don't automatically stop at the
    
    1586 1658
                       // next breakpoint
    
    1587 1659
                       rts_stop_next_breakpoint = 0;
    
    1588 1660
                       cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
    
    1589 1661
     
    
    1590
    -                  // allocate memory for a new AP_STACK, enough to
    
    1591
    -                  // store the top stack frame plus an
    
    1592
    -                  // stg_apply_interp_info pointer and a pointer to
    
    1593
    -                  // the BCO
    
    1594
    -                  size_words = BCO_BITMAP_SIZE(obj) + 2;
    
    1595
    -                  new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
    
    1596
    -                  new_aps->size = size_words;
    
    1597
    -                  new_aps->fun = &stg_dummy_ret_closure;
    
    1598
    -
    
    1599
    -                  // fill in the payload of the AP_STACK
    
    1600
    -                  new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
    
    1601
    -                  new_aps->payload[1] = (StgClosure *)obj;
    
    1602
    -
    
    1603
    -                  // copy the contents of the top stack frame into the AP_STACK
    
    1604
    -                  for (i = 2; i < size_words; i++)
    
    1605
    -                  {
    
    1606
    -                     new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
    
    1662
    +                  /* To yield execution we need to come up with a consistent AP_STACK
    
    1663
    +                   * to store in the :history data structure.
    
    1664
    +                   */
    
    1665
    +                  if (is_case_cont_BCO) {
    
    1666
    +
    
    1667
    +                    // If the BCO is a case cont. then the stack is headed by the
    
    1668
    +                    // stg_ret and a stg_ctoi frames which caused this same BCO
    
    1669
    +                    // to be run. This stack is already well-formed, so it
    
    1670
    +                    // needs only to be copied to the AP_STACK.
    
    1671
    +                    // See Note [Stack layout when entering run_BCO]
    
    1672
    +
    
    1673
    +                    // stg_ret_*
    
    1674
    +                    int size_returned_frame = stack_frame_sizeW((StgClosure *)Sp);
    
    1675
    +
    
    1676
    +                    ASSERT(obj == UNTAG_CLOSURE((StgClosure*)ReadSpW(size_returned_frame+1)));
    
    1677
    +
    
    1678
    +                    // stg_ctoi_*
    
    1679
    +                    int size_cont_frame_head = stack_frame_sizeW((StgClosure*)SafeSpWP(size_returned_frame));
    
    1680
    +
    
    1681
    +                    // Continuation stack is already well formed,
    
    1682
    +                    // so just copy it whole to the AP_STACK
    
    1683
    +                    size_words = size_returned_frame
    
    1684
    +                               + size_cont_frame_head;
    
    1685
    +                    new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
    
    1686
    +                    new_aps->size = size_words;
    
    1687
    +                    new_aps->fun = &stg_dummy_ret_closure;
    
    1688
    +
    
    1689
    +                    // (1) Fill in the payload of the AP_STACK:
    
    1690
    +                    for (i = 0; i < size_words; i++) {
    
    1691
    +                       new_aps->payload[i] = (StgClosure *)ReadSpW(i);
    
    1692
    +                    }
    
    1693
    +                  }
    
    1694
    +                  else {
    
    1695
    +
    
    1696
    +                    // The BCO is a function, therefore the arguments are
    
    1697
    +                    // directly on top of the stack.
    
    1698
    +                    // To construct a valid stack chunk simply add an
    
    1699
    +                    // stg_apply_interp and the current BCO to the stack.
    
    1700
    +                    // See also Note [Stack layout when entering run_BCO]
    
    1701
    +
    
    1702
    +                    // (1) Allocate memory for a new AP_STACK, enough to store
    
    1703
    +                    // the top stack frame plus an stg_apply_interp_info pointer
    
    1704
    +                    // and a pointer to the BCO
    
    1705
    +                    size_words = BCO_BITMAP_SIZE(obj) + 2;
    
    1706
    +                    new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
    
    1707
    +                    new_aps->size = size_words;
    
    1708
    +                    new_aps->fun = &stg_dummy_ret_closure;
    
    1709
    +
    
    1710
    +                    // (1.1) the continuation frame
    
    1711
    +                    new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
    
    1712
    +                    new_aps->payload[1] = (StgClosure *)obj;
    
    1713
    +
    
    1714
    +                    // (1.2.1) copy the args/free vars of the top stack frame into the AP_STACK
    
    1715
    +                    for (i = 2; i < size_words; i++) {
    
    1716
    +                       new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
    
    1717
    +                    }
    
    1607 1718
                       }
    
    1608 1719
     
    
    1609 1720
                       // No write barrier is needed here as this is a new allocation
    
    1610 1721
                       SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
    
    1611 1722
     
    
    1612
    -                  // Arrange the stack to call the breakpoint IO action, and
    
    1723
    +                  // (2) Arrange the stack to call the breakpoint IO action, and
    
    1613 1724
                       // continue execution of this BCO when the IO action returns.
    
    1614 1725
                       //
    
    1615 1726
                       // ioAction :: Addr#       -- the breakpoint info module
    
    ... ... @@ -1622,12 +1733,27 @@ run_BCO:
    1622 1733
                       ioAction = (StgClosure *) deRefStablePtr (
    
    1623 1734
                           rts_breakpoint_io_action);
    
    1624 1735
     
    
    1625
    -                  Sp_subW(13);
    
    1626
    -                  SpW(12) = (W_)obj;
    
    1627
    -                  SpW(11) = (W_)&stg_apply_interp_info;
    
    1736
    +                  // (2.1) Construct the continuation to which we'll return in
    
    1737
    +                  // this thread after the `rts_breakpoint_io_action` returns.
    
    1738
    +                  //
    
    1739
    +                  // For case cont. BCOs, the continuation to re-run this BCO
    
    1740
    +                  // is already first on the stack. For function BCOs we need
    
    1741
    +                  // to add an `stg_apply_interp` apply to the current BCO.
    
    1742
    +                  // See Note [Stack layout when entering run_BCO]
    
    1743
    +                  if (!is_case_cont_BCO) {
    
    1744
    +                    Sp_subW(2); // stg_apply_interp_info + StgBCO*
    
    1745
    +
    
    1746
    +                    // (2.1.2) Write the continuation frame (above the stg_ret
    
    1747
    +                    // frame if one exists)
    
    1748
    +                    SpW(1) = (W_)obj;
    
    1749
    +                    SpW(0) = (W_)&stg_apply_interp_info;
    
    1750
    +                  }
    
    1751
    +
    
    1752
    +                  // (2.2) The `rts_breakpoint_io_action` call
    
    1753
    +                  Sp_subW(11);
    
    1628 1754
                       SpW(10) = (W_)new_aps;
    
    1629
    -                  SpW(9) = (W_)False_closure;         // True <=> an exception
    
    1630
    -                  SpW(8) = (W_)&stg_ap_ppv_info;
    
    1755
    +                  SpW(9)  = (W_)False_closure;         // True <=> an exception
    
    1756
    +                  SpW(8)  = (W_)&stg_ap_ppv_info;
    
    1631 1757
                       SpW(7)  = (W_)arg4_info_index;
    
    1632 1758
                       SpW(6)  = (W_)&stg_ap_n_info;
    
    1633 1759
                       SpW(5)  = (W_)BCO_LIT(arg3_info_mod_id);
    
    ... ... @@ -1656,17 +1782,6 @@ run_BCO:
    1656 1782
                 goto nextInsn;
    
    1657 1783
             }
    
    1658 1784
     
    
    1659
    -        /* See Note [Debugger: BRK_ALTS] */
    
    1660
    -        case bci_BRK_ALTS:
    
    1661
    -        {
    
    1662
    -          StgWord16 active = BCO_NEXT;
    
    1663
    -          if (active) {
    
    1664
    -            cap->r.rCurrentTSO->flags |= TSO_STOP_NEXT_BREAKPOINT;
    
    1665
    -          }
    
    1666
    -
    
    1667
    -          goto nextInsn;
    
    1668
    -        }
    
    1669
    -
    
    1670 1785
             case bci_STKCHECK: {
    
    1671 1786
                 // Explicit stack check at the beginning of a function
    
    1672 1787
                 // *only* (stack checks in case alternatives are
    

  • rts/Profiling.c
    ... ... @@ -411,7 +411,7 @@ void enterFunCCS (StgRegTable *reg, CostCentreStack *ccsfn)
    411 411
         }
    
    412 412
     
    
    413 413
         // common case 2: the function stack is empty, or just CAF
    
    414
    -    if (ccsfn->cc->is_caf) {
    
    414
    +    if (ccsfn->cc == NULL || ccsfn->cc->is_caf) {
    
    415 415
             return;
    
    416 416
         }
    
    417 417
     
    

  • rts/include/rts/Bytecodes.h
    ... ... @@ -214,8 +214,6 @@
    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
    
    218
    -
    
    219 217
     
    
    220 218
     /* If you need to go past 255 then you will run into the flags */
    
    221 219
     
    

  • testsuite/tests/ghci.debugger/scripts/T26042b.stdout
    ... ... @@ -8,35 +8,32 @@ _result ::
    8 8
     10  foo True  i = return i
    
    9 9
                       ^^^^^^^^
    
    10 10
     11  foo False _ = do
    
    11
    -Stopped in Main.bar, T26042b.hs:21:3-10
    
    11
    +Stopped in Main., T26042b.hs:20:3-17
    
    12 12
     _result ::
    
    13 13
       GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    
    14 14
       -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
    
    15 15
             Int #) = _
    
    16
    -y :: Int = _
    
    16
    +19    let t = z * 2
    
    17 17
     20    y <- foo True t
    
    18
    +      ^^^^^^^^^^^^^^^
    
    18 19
     21    return y
    
    19
    -      ^^^^^^^^
    
    20
    -22  
    
    21
    -Stopped in Main.foo, T26042b.hs:15:3-10
    
    20
    +Stopped in Main., T26042b.hs:14:3-18
    
    22 21
     _result ::
    
    23 22
       GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    
    24 23
       -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
    
    25 24
             Int #) = _
    
    26
    -n :: Int = _
    
    25
    +13        y = 4
    
    27 26
     14    n <- bar (x + y)
    
    27
    +      ^^^^^^^^^^^^^^^^
    
    28 28
     15    return n
    
    29
    -      ^^^^^^^^
    
    30
    -16  
    
    31
    -Stopped in Main.main, T26042b.hs:6:3-9
    
    29
    +Stopped in Main., T26042b.hs:5:3-26
    
    32 30
     _result ::
    
    33 31
       GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    
    34 32
       -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
    
    35 33
             () #) = _
    
    36
    -a :: Int = _
    
    34
    +4  main = do
    
    37 35
     5    a <- foo False undefined
    
    36
    +     ^^^^^^^^^^^^^^^^^^^^^^^^
    
    38 37
     6    print a
    
    39
    -     ^^^^^^^
    
    40
    -7    print a
    
    41 38
     14
    
    42 39
     14

  • testsuite/tests/ghci.debugger/scripts/T26042c.script
    ... ... @@ -14,15 +14,7 @@ main
    14 14
     -- we go straight to `main`.
    
    15 15
     :stepout
    
    16 16
     :list
    
    17
    --- stepping out from here will stop in the thunk (TODO: WHY?)
    
    18
    -:stepout
    
    19
    -:list
    
    20
    -
    
    21
    --- bring us back to main from the thunk (why were we stopped there?...)
    
    22
    -:stepout
    
    23
    -:list
    
    24
    -
    
    25
    --- and finally out
    
    17
    +-- stepping out from here will exit main
    
    26 18
     :stepout
    
    27 19
     
    
    28 20
     -- this test is also run with optimisation to make sure the IO bindings inline and we can stop at them

  • testsuite/tests/ghci.debugger/scripts/T26042c.stdout
    ... ... @@ -8,17 +8,14 @@ _result ::
    8 8
     10  foo True  i = return i
    
    9 9
                       ^^^^^^^^
    
    10 10
     11  foo False _ = do
    
    11
    -Stopped in Main.main, T26042c.hs:6:3-9
    
    11
    +Stopped in Main., T26042c.hs:5:3-26
    
    12 12
     _result ::
    
    13 13
       GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    
    14 14
       -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
    
    15 15
             () #) = _
    
    16
    -a :: Int = _
    
    16
    +4  main = do
    
    17 17
     5    a <- foo False undefined
    
    18
    +     ^^^^^^^^^^^^^^^^^^^^^^^^
    
    18 19
     6    print a
    
    19
    -     ^^^^^^^
    
    20
    -7    print a
    
    21 20
     14
    
    22 21
     14
    23
    -not stopped at a breakpoint
    
    24
    -not stopped at a breakpoint

  • testsuite/tests/ghci.debugger/scripts/T26042d2.hs
    1
    +
    
    2
    +module Main where
    
    3
    +
    
    4
    +main = do
    
    5
    +  putStrLn "hello1"
    
    6
    +  f
    
    7
    +  putStrLn "hello3"
    
    8
    +  putStrLn "hello4"
    
    9
    +
    
    10
    +f = do
    
    11
    +  putStrLn "hello2.1"
    
    12
    +  putStrLn "hello2.2"
    
    13
    +{-# NOINLINE f #-}

  • testsuite/tests/ghci.debugger/scripts/T26042d2.script
    1
    +:load T26042d2.hs
    
    2
    +
    
    3
    +:break 11
    
    4
    +main
    
    5
    +:list
    
    6
    +:stepout
    
    7
    +:list
    
    8
    +:stepout
    
    9
    +
    
    10
    +-- should exit! we compile this test case with -O1 to make sure the monad >> are inlined
    
    11
    +-- and thus the test relies on the filtering behavior based on SrcSpans for stepout
    
    12
    +

  • testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
    1
    +Breakpoint 0 activated at T26042d2.hs:11:3-21
    
    2
    +hello1
    
    3
    +Stopped in Main.f, T26042d2.hs:11:3-21
    
    4
    +_result ::
    
    5
    +  GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    
    6
    +  -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
    
    7
    +        () #) = _
    
    8
    +10  f = do
    
    9
    +11    putStrLn "hello2.1"
    
    10
    +      ^^^^^^^^^^^^^^^^^^^
    
    11
    +12    putStrLn "hello2.2"
    
    12
    +hello2.1
    
    13
    +hello2.2
    
    14
    +Stopped in Main., T26042d2.hs:6:3
    
    15
    +_result ::
    
    16
    +  GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    
    17
    +  -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
    
    18
    +        () #) = _
    
    19
    +5    putStrLn "hello1"
    
    20
    +6    f
    
    21
    +     ^
    
    22
    +7    putStrLn "hello3"
    
    23
    +hello3
    
    24
    +hello4

  • testsuite/tests/ghci.debugger/scripts/T26042e.stdout
    ... ... @@ -7,14 +7,12 @@ y :: [a1] -> Int = _
    7 7
     11    let !z = y x
    
    8 8
           ^^^^^^^^^^^^
    
    9 9
     12    let !t = y ['b']
    
    10
    -Stopped in T7.main, T26042e.hs:19:3-11
    
    10
    +Stopped in T7., T26042e.hs:18:3-17
    
    11 11
     _result :: IO () = _
    
    12
    -x :: Int = _
    
    13
    -y :: Int = _
    
    12
    +17  main = do
    
    14 13
     18    let !(x, y) = a
    
    14
    +      ^^^^^^^^^^^^^^^
    
    15 15
     19    print '1'
    
    16
    -      ^^^^^^^^^
    
    17
    -20    print '2'
    
    18 16
     '1'
    
    19 17
     '2'
    
    20 18
     '3'
    

  • testsuite/tests/ghci.debugger/scripts/T26042f2.stdout
    ... ... @@ -8,18 +8,16 @@ x :: Int = 450
    8 8
     21    pure (x + 3)
    
    9 9
                       ^^
    
    10 10
     22  {-# OPAQUE t #-}
    
    11
    -Stopped in T8.g, T26042f.hs:15:3-17
    
    11
    +Stopped in T8., T26042f.hs:14:3-14
    
    12 12
     _result :: Identity Int = _
    
    13
    -a :: Int = 453
    
    13
    +13  g x = do
    
    14 14
     14    a <- t (x*2)
    
    15
    +      ^^^^^^^^^^^^
    
    15 16
     15    n <- pure (a+a)
    
    16
    -      ^^^^^^^^^^^^^^^
    
    17
    -16    return (n+n)
    
    18
    -Stopped in T8.f, T26042f.hs:9:3-17
    
    17
    +Stopped in T8., T26042f.hs:8:3-14
    
    19 18
     _result :: Identity Int = _
    
    20
    -b :: Int = 1812
    
    19
    +7  f x = do
    
    21 20
     8    b <- g (x*x)
    
    21
    +     ^^^^^^^^^^^^
    
    22 22
     9    y <- pure (b+b)
    
    23
    -     ^^^^^^^^^^^^^^^
    
    24
    -10    return (y+y)
    
    25 23
     7248

  • testsuite/tests/ghci.debugger/scripts/T26042g.stdout
    ... ... @@ -6,10 +6,13 @@ x :: Int = 14
    6 6
     11  succ x = (-) (x - 2) (x + 1)
    
    7 7
                  ^^^^^^^^^^^^^^^^^^^
    
    8 8
     12  
    
    9
    -Stopped in T9.top, T26042g.hs:8:10-21
    
    9
    +Stopped in T9., T26042g.hs:(6,3)-(8,21)
    
    10 10
     _result :: Int = _
    
    11
    +5  top = do
    
    12
    +   vv
    
    13
    +6    case succ 14 of
    
    11 14
     7      5 -> 5
    
    12 15
     8      _ -> 6 + other 55
    
    13
    -            ^^^^^^^^^^^^
    
    16
    +                        ^^
    
    14 17
     9  
    
    15 18
     171

  • testsuite/tests/ghci.debugger/scripts/all.T
    ... ... @@ -147,8 +147,9 @@ test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script'])
    147 147
     
    
    148 148
     # Step out tests
    
    149 149
     test('T26042b', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042b.hs'])], ghci_script, ['T26042b.script'])
    
    150
    -test('T26042c', [expect_broken(26042),extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
    
    150
    +test('T26042c', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
    
    151 151
     test('T26042d', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d.hs'])], ghci_script, ['T26042d.script'])
    
    152
    +test('T26042d2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d2.hs'])], ghci_script, ['T26042d2.script'])
    
    152 153
     test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
    
    153 154
     test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop
    
    154 155
     test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042f.hs', 'T26042f.script'])], ghci_script, ['T26042f.script'])