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

Commits:

13 changed files:

Changes:

  • 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,19 @@ 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. See Note [Internal Breakpoint Locations]
    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 
    +-- See Note [Internal Breakpoint Locations]
    188 
    +newtype InternalBreakLoc = InternalBreakLoc SrcSpan
    189 
    +  deriving newtype (Eq, Show, NFData, Outputable)
    190 
    +
    179 191 
     -- | Get an internal breakpoint info by 'InternalBreakpointId'
    180 192 
     getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
    181 193 
     getInternalBreak (InternalBreakpointId mod ix) imbs =
    ... ... @@ -196,27 +208,36 @@ assert_modules_match ibi_mod imbs_mod =
    196 208
    197 209 
     -- | Get the source module and tick index for this breakpoint
    198 210 
     -- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
    199 
    -getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
    211 
    +getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> Either InternalBreakLoc BreakpointId
    200 212 
     getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
    201 213 
       assert_modules_match ibi_mod (imodBreaks_module imbs) $
    202 214 
         let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
    203 215 
          in cgb_tick_id cgb
    204 216
    217 
    +-- | Get the source module for this breakpoint (where the breakpoint is defined)
    218 
    +getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module
    219 
    +getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs =
    220 
    +  assert_modules_match ibi_mod (imodBreaks_module imbs) $
    221 
    +    let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
    222 
    +     in case cgb_tick_id cgb of
    223 
    +      Left InternalBreakLoc{} -> imodBreaks_module imbs
    224 
    +      Right BreakpointId{bi_tick_mod} -> bi_tick_mod
    225 
    +
    205 226 
     -- | Get the source span for this breakpoint
    206 227 
     getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
    207 
    -getBreakLoc = getBreakXXX modBreaks_locs
    228 
    +getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
    208 229
    209 230 
     -- | Get the vars for this breakpoint
    210 231 
     getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
    211 
    -getBreakVars = getBreakXXX modBreaks_vars
    232 
    +getBreakVars = getBreakXXX modBreaks_vars (const [])
    212 233
    213 234 
     -- | Get the decls for this breakpoint
    214 235 
     getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
    215 
    -getBreakDecls = getBreakXXX modBreaks_decls
    236 
    +getBreakDecls = getBreakXXX modBreaks_decls (const [])
    216 237
    217 238 
     -- | Get the decls for this breakpoint
    218 
    -getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
    219 
    -getBreakCCS = getBreakXXX modBreaks_ccs
    239 
    +getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
    240 
    +getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
    220 241
    221 242 
     -- | Internal utility to access a ModBreaks field at a particular breakpoint index
    222 243 
     --
    ... ... @@ -228,14 +249,17 @@ getBreakCCS = getBreakXXX modBreaks_ccs
    228 249 
     -- 'ModBreaks'. When the tick module is different, we need to look up the
    229 250 
     -- 'ModBreaks' in the HUG for that other module.
    230 251 
     --
    252 
    +-- When there is no tick module (the breakpoint was generated at codegen), use
    253 
    +-- the function on internal mod breaks.
    254 
    +--
    231 255 
     -- To avoid cyclic dependencies, we instead receive a function that looks up
    232 256 
     -- 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 =
    257 
    +getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
    258 
    +getBreakXXX view viewInternal lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
    235 259 
       assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
    236 260 
         let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
    237 261 
         case cgb_tick_id cgb of
    238 
    -      BreakpointId{bi_tick_mod, bi_tick_index}
    262 
    +      Right BreakpointId{bi_tick_mod, bi_tick_index}
    239 263 
             | bi_tick_mod == ibi_mod
    240 264 
             -> do
    241 265 
               let these_mbs = imodBreaks_modBreaks imbs
    ... ... @@ -244,6 +268,8 @@ getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
    244 268 
             -> do
    245 269 
               other_mbs <- lookupModule bi_tick_mod
    246 270 
               return $ view other_mbs ! bi_tick_index
    271 
    +      Left l ->
    272 
    +          return $ viewInternal l
    247 273
    248 274 
     --------------------------------------------------------------------------------
    249 275 
     -- Instances

  • compiler/GHC/Linker/Loader.hs
    ... ... @@ -58,6 +58,7 @@ import GHCi.RemoteTypes
    58 58 
     import GHC.Iface.Load
    59 59 
     import GHCi.Message (ConInfoTable(..), LoadedDLL)
    60 60
    61 
    +import GHC.ByteCode.Breakpoints
    61 62 
     import GHC.ByteCode.Linker
    62 63 
     import GHC.ByteCode.Asm
    63 64 
     import GHC.ByteCode.Types
    ... ... @@ -1711,8 +1712,10 @@ allocateCCS interp ce mbss
    1711 1712 
                   let count = 1 + (maybe 0 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,30 @@ 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
    410 
    -
    411 
    -      let info_mod = modBreaks_module current_mod_breaks
    412 
    -      infox <- newBreakInfo breakInfo
    397 
    +schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
    398 
    +  platform <- profilePlatform <$> getProfile
    399 
    +
    400 
    +  code <- case rhs of
    401 
    +    -- When we find a tick surrounding a case expression we introduce a new BRK_FUN
    402 
    +    -- instruction at the start of the case *continuation*, in addition to the
    403 
    +    -- usual BRK_FUN surrounding the StgCase)
    404 
    +    -- See Note [TODO]
    405 
    +    StgCase scrut bndr _ alts
    406 
    +      -> doCase d 0 p (Just bp) scrut bndr alts
    407 
    +    _ -> schemeE d 0 p rhs
    408 
    +
    409 
    +  let idOffSets = getVarOffSets platform d p fvs
    410 
    +      ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    411 
    +      toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    412 
    +      toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    413 
    +      breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Right tick_id)
    414 
    +
    415 
    +  mibi <- newBreakInfo breakInfo
    416 
    +
    417 
    +  return $ case mibi of
    418 
    +    Nothing  -> code
    419 
    +    Just ibi -> BRK_FUN ibi `consOL` code
    413 420
    414 
    -      let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
    415 
    -      return $ breakInstr `consOL` code
    416 421 
     schemeER_wrk d p rhs = schemeE d 0 p rhs
    417 422
    418 423 
     getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
    ... ... @@ -614,7 +619,7 @@ schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
    614 619 
     schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut
    615 620
    616 621 
     schemeE d s p (StgCase scrut bndr _ alts)
    617 
    -   = doCase d s p scrut bndr alts
    622 
    +   = doCase d s p Nothing scrut bndr alts
    618 623
    619 624
    620 625 
     {-
    ... ... @@ -1106,11 +1111,15 @@ doCase
    1106 1111 
         :: StackDepth
    1107 1112 
         -> Sequel
    1108 1113 
         -> BCEnv
    1114 
    +    -> Maybe StgTickish
    1115 
    +    -- ^ The breakpoint surrounding the full case expression, if any (only
    1116 
    +    -- source-level cases get breakpoint ticks, and those are the only we care
    1117 
    +    -- about). See Note [TODO]
    1109 1118 
         -> CgStgExpr
    1110 1119 
         -> Id
    1111 1120 
         -> [CgStgAlt]
    1112 1121 
         -> BcM BCInstrList
    1113 
    -doCase d s p scrut bndr alts
    1122 
    +doCase d s p m_bid scrut bndr alts
    1114 1123 
       = do
    1115 1124 
          profile <- getProfile
    1116 1125 
          hsc_env <- getHscEnv
    ... ... @@ -1140,43 +1149,34 @@ doCase d s p scrut bndr alts
    1140 1149 
             -- When an alt is entered, it assumes the returned value is
    1141 1150 
             -- on top of the itbl; see Note [Return convention for non-tuple values]
    1142 1151 
             -- 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
    1152 
    +        ret_frame_size_w :: WordOff
    1153 
    +        ret_frame_size_w | ubx_tuple_frame =
    1154 
    +                             if profiling then 5 else 4
    1155 
    +                         | otherwise = 2
    1147 1156
    1148 1157 
             -- The stack space used to save/restore the CCCS when profiling
    1149 1158 
             save_ccs_size_b | profiling &&
    1150 1159 
                               not ubx_tuple_frame = 2 * wordSize platform
    1151 1160 
                             | otherwise = 0
    1152 1161
    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 1162 
             (bndr_size, call_info, args_offsets)
    1159 1163 
                | ubx_tuple_frame =
    1160 1164 
                    let bndr_reps = typePrimRep (idType bndr)
    1161 1165 
                        (call_info, args_offsets) =
    1162 1166 
                            layoutNativeCall profile NativeTupleReturn 0 id bndr_reps
    1163 
    -               in ( wordsToBytes platform (nativeCallSize call_info)
    1167 
    +               in ( nativeCallSize call_info
    1164 1168 
                       , call_info
    1165 1169 
                       , args_offsets
    1166 1170 
                       )
    1167 
    -           | otherwise = ( wordsToBytes platform (idSizeW platform bndr)
    1171 
    +           | otherwise = ( idSizeW platform bndr
    1168 1172 
                              , voidTupleReturnInfo
    1169 1173 
                              , []
    1170 1174 
                              )
    1171 1175
    1172 
    -        -- depth of stack after the return value has been pushed
    1176 
    +        -- Depth of stack after the return value has been pushed
    1177 
    +        -- This is the stack depth at the continuation.
    1173 1178 
             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
    1179 
    +            d + wordsToBytes platform bndr_size
    1180 1180
    1181 1181 
             -- Env in which to compile the alts, not including
    1182 1182 
             -- any vars bound by the alts themselves
    ... ... @@ -1188,13 +1188,13 @@ doCase d s p scrut bndr alts
    1188 1188 
             -- given an alt, return a discr and code for it.
    1189 1189 
             codeAlt :: CgStgAlt -> BcM (Discr, BCInstrList)
    1190 1190 
             codeAlt GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=rhs}
    1191 
    -           = do rhs_code <- schemeE d_alts s p_alts rhs
    1191 
    +           = do rhs_code <- schemeE d_bndr s p_alts rhs
    1192 1192 
                     return (NoDiscr, rhs_code)
    1193 1193
    1194 1194 
             codeAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs}
    1195 1195 
                -- primitive or nullary constructor alt: no need to UNPACK
    1196 1196 
                | null real_bndrs = do
    1197 
    -                rhs_code <- schemeE d_alts s p_alts rhs
    1197 
    +                rhs_code <- schemeE d_bndr s p_alts rhs
    1198 1198 
                     return (my_discr alt, rhs_code)
    1199 1199 
                | isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
    1200 1200 
                  let bndr_ty = idPrimRepU . fromNonVoid
    ... ... @@ -1206,7 +1206,7 @@ doCase d s p scrut bndr alts
    1206 1206 
                                         bndr_ty
    1207 1207 
                                         (assertNonVoidIds bndrs)
    1208 1208
    1209 
    -                 stack_bot = d_alts
    1209 
    +                 stack_bot = d_bndr
    1210 1210
    1211 1211 
                      p' = Map.insertList
    1212 1212 
                             [ (arg, tuple_start -
    ... ... @@ -1224,7 +1224,7 @@ doCase d s p scrut bndr alts
    1224 1224 
                              (addIdReps (assertNonVoidIds real_bndrs))
    1225 1225 
                      size = WordOff tot_wds
    1226 1226
    1227 
    -                 stack_bot = d_alts + wordsToBytes platform size
    1227 
    +                 stack_bot = d_bndr + wordsToBytes platform size
    1228 1228
    1229 1229 
                      -- convert offsets from Sp into offsets into the virtual stack
    1230 1230 
                      p' = Map.insertList
    ... ... @@ -1324,22 +1324,53 @@ doCase d s p scrut bndr alts
    1324 1324 
          alt_stuff <- mapM codeAlt alts
    1325 1325 
          alt_final0 <- mkMultiBranch maybe_ncons alt_stuff
    1326 1326
    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
    1327 
    +     let
    1328 
    +
    1329 
    +         -- drop the stg_ctoi_*_info header...
    1330 
    +         alt_final1 = SLIDE bndr_size ret_frame_size_w `consOL` alt_final0
    1331 
    +
    1332 
    +         -- after dropping the stg_ret_*_info header
    1333 
    +         alt_final2
    1334 
    +           | ubx_tuple_frame    = SLIDE 0 3 `consOL` alt_final1
    1335 
    +           | otherwise          = SLIDE 0 1 `consOL` alt_final1
    1336 
    +
    1337 
    +     -- when `BRK_FUN` in a case continuation BCO executes,
    1338 
    +     -- the stack will already have a full continuation that just
    1339 
    +     -- re-executes the BCO being stopped at (including the stg_ret and
    1340 
    +     -- stg_ctoi frames)
    1341 
    +     --
    1342 
    +     -- right after the `BRK_FUN`, all case continuations will drop the
    1343 
    +     -- stg_ret and stg_ctoi headers (see alt_final1, alt_final2), leaving
    1344 
    +     -- the stack with the bound return values followed by the free variables
    1345 
    +     alt_final <- case m_bid of
    1346 
    +       Just (Breakpoint tick_ty tick_id fvs)
    1347 
    +         | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
    1348 
    +         -- Construct an internal breakpoint to put at the start of this case
    1349 
    +         -- continuation BCO.
    1350 
    +         -- See Note [TODO]
    1351 
    +         -> do
    1352 
    +          internal_tick_loc <- makeCaseInternalBreakLoc tick_id
    1353 
    +
    1354 
    +          -- same fvs available in the case expression are available in the case continuation
    1355 
    +          let idOffSets = getVarOffSets platform d p fvs
    1356 
    +              ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    1357 
    +              toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    1358 
    +              toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    1359 
    +              breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Left internal_tick_loc)
    1360 
    +
    1361 
    +          mibi <- newBreakInfo breakInfo
    1362 
    +          return $ case mibi of
    1363 
    +            Nothing  -> alt_final2
    1364 
    +            Just ibi -> BRK_FUN ibi `consOL` alt_final2
    1365 
    +       _ -> pure alt_final2
    1335 1366
    1336 1367 
          add_bco_name <- shouldAddBcoName
    1337 1368 
          let
    1338 1369 
              alt_bco_name = getName bndr
    1339 1370 
              alt_bco = mkProtoBCO platform add_bco_name alt_bco_name alt_final (Left alts)
    1340 1371 
                            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)
    1372 
    +     scrut_code <- schemeE (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
    1373 
    +                           (d + wordsToBytes platform ret_frame_size_w + save_ccs_size_b)
    1343 1374 
                                p scrut
    1344 1375 
          if ubx_tuple_frame
    1345 1376 
            then do let tuple_bco = tupleBCO platform call_info args_offsets
    ... ... @@ -1351,6 +1382,24 @@ doCase d s p scrut bndr alts
    1351 1382 
                       _     -> panic "schemeE(StgCase).push_alts"
    1352 1383 
                 in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
    1353 1384
    1385 
    +makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
    1386 
    +makeCaseInternalBreakLoc bid = do
    1387 
    +  hug         <- hsc_HUG <$> getHscEnv
    1388 
    +  curr_mod    <- getCurrentModule
    1389 
    +  mb_mod_brks <- getCurrentModBreaks
    1390 
    +
    1391 
    +  -- TODO: Subtract the scrutinee loc from the case loc to get continuation loc
    1392 
    +  InternalBreakLoc <$> case bid of
    1393 
    +    BreakpointId{bi_tick_mod, bi_tick_index}
    1394 
    +      | bi_tick_mod == curr_mod
    1395 
    +      , Just these_mbs <- mb_mod_brks
    1396 
    +      -> do
    1397 
    +        return $ modBreaks_locs these_mbs ! bi_tick_index
    1398 
    +      | otherwise
    1399 
    +      -> do
    1400 
    +        other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod
    1401 
    +        return $ modBreaks_locs other_mbs ! bi_tick_index
    1402 
    +
    1354 1403 
     {-
    1355 1404 
     Note [Debugger: BRK_ALTS]
    1356 1405 
     ~~~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -1718,6 +1767,10 @@ tupleBCO platform args_info args =
    1718 1767 
           with using a fake name here. We will need to change this if we want
    1719 1768 
           to save some memory by sharing the BCO between places that have
    1720 1769 
           the same tuple shape
    1770 
    +
    1771 
    +      ROMES:TODO: This seems like it would have a pretty good impact.
    1772 
    +      Looking at examples like UnboxedTuple.hs shows many occurrences of the
    1773 
    +      same tuple_BCO
    1721 1774 
         -}
    1722 1775 
         invented_name  = mkSystemVarName (mkPseudoUniqueE 0) (fsLit "tuple")
    1723 1776
    ... ... @@ -2667,14 +2720,19 @@ getLabelsBc n = BcM $ \_ st ->
    2667 2720 
       let ctr = nextlabel st
    2668 2721 
        in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
    2669 2722
    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')
    2723 
    +newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
    2724 
    +newBreakInfo info = BcM $ \env st -> do
    2725 
    +  -- if we're not generating ModBreaks for this module for some reason, we
    2726 
    +  -- can't store breakpoint occurrence information.
    2727 
    +  case modBreaks env of
    2728 
    +    Nothing -> pure (Nothing, st)
    2729 
    +    Just modBreaks -> do
    2730 
    +      let ix = breakInfoIdx st
    2731 
    +          st' = st
    2732 
    +            { breakInfo = IntMap.insert ix info (breakInfo st)
    2733 
    +            , breakInfoIdx = ix + 1
    2734 
    +            }
    2735 
    +      return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
    2678 2736
    2679 2737 
     getCurrentModule :: BcM Module
    2680 2738 
     getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
    ... ... @@ -2687,7 +2745,7 @@ tickFS = fsLit "ticked"
    2687 2745
    2688 2746 
     -- Dehydrating CgBreakInfo
    2689 2747
    2690 
    -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
    2748 
    +dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
    2691 2749 
     dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
    2692 2750 
               CgBreakInfo
    2693 2751 
                 { 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/Interpreter.c
    ... ... @@ -207,6 +207,19 @@ See also Note [Width of parameters] for some more motivation.
    207 207 
     // Perhaps confusingly this still reads a full word, merely the offset is in bytes.
    208 208 
     #define ReadSpB(n)       (*((StgWord*)   SafeSpBP(n)))
    209 209
    210 
    +/*
    211 
    + * SLIDE "n" words "by" words
    212 
    + * a_1 ... a_n, b_1 ... b_by, k
    213 
    + *           =>
    214 
    + * a_1 ... a_n, k
    215 
    + */
    216 
    +#define SpSlide(n, by)          \
    217 
    +    while(n-- > 0) {            \
    218 
    +        SpW(n+by) = ReadSpW(n); \
    219 
    +    }                           \
    220 
    +    Sp_addW(by);                \
    221 
    +
    222 
    +
    210 223 
     /* Note [PUSH_L underflow]
    211 224 
        ~~~~~~~~~~~~~~~~~~~~~~~
    212 225 
     BCOs can be nested, resulting in nested BCO stack frames where the inner most
    ... ... @@ -284,6 +297,18 @@ allocate_NONUPD (Capability *cap, int n_words)
    284 297 
         return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
    285 298 
     }
    286 299
    300 
    +STATIC_INLINE int
    301 
    +is_ctoi_nontuple_frame(const StgPtr frame_head) {
    302 
    +  return (
    303 
    +      (W_)frame_head == (W_)&stg_ctoi_R1p_info ||
    304 
    +      (W_)frame_head == (W_)&stg_ctoi_R1n_info ||
    305 
    +      (W_)frame_head == (W_)&stg_ctoi_F1_info ||
    306 
    +      (W_)frame_head == (W_)&stg_ctoi_D1_info ||
    307 
    +      (W_)frame_head == (W_)&stg_ctoi_L1_info ||
    308 
    +      (W_)frame_head == (W_)&stg_ctoi_V_info
    309 
    +    );
    310 
    +}
    311 
    +
    287 312 
     int rts_stop_on_exception = 0;
    288 313
    289 314 
     /* ---------------------------------------------------------------------------
    ... ... @@ -844,7 +869,6 @@ eval_obj:
    844 869 
                  debugBelch("\n\n");
    845 870 
                 );
    846 871
    847 
    -//    IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
    848 872 
         IF_DEBUG(sanity,checkStackFrame(Sp));
    849 873
    850 874 
         switch ( get_itbl(obj)->type ) {
    ... ... @@ -1086,11 +1110,31 @@ do_return_pointer:
    1086 1110 
             // Returning to an interpreted continuation: put the object on
    1087 1111 
             // the stack, and start executing the BCO.
    1088 1112 
             INTERP_TICK(it_retto_BCO);
    1089 
    -        Sp_subW(1);
    1090 
    -        SpW(0) = (W_)tagged_obj;
    1091 
    -        obj = (StgClosure*)ReadSpW(2);
    1113 
    +        obj = (StgClosure*)ReadSpW(1);
    1092 1114 
             ASSERT(get_itbl(obj)->type == BCO);
    1093 
    -        goto run_BCO_return_pointer;
    1115 
    +
    1116 
    +        // Heap check
    1117 
    +        if (doYouWantToGC(cap)) {
    1118 
    +            Sp_subW(2);
    1119 
    +            SpW(1) = (W_)tagged_obj;
    1120 
    +            SpW(0) = (W_)&stg_ret_p_info;
    1121 
    +            RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    1122 
    +        }
    1123 
    +        else {
    1124 
    +
    1125 
    +          // Stack checks aren't necessary at return points, the stack use
    1126 
    +          // is aggregated into the enclosing function entry point.
    1127 
    +
    1128 
    +          // Make sure stack is headed by a ctoi R1p frame when returning a pointer
    1129 
    +          ASSERT(ReadSpW(0) == (W_)&stg_ctoi_R1p_info);
    1130 
    +
    1131 
    +          // Add the return frame on top of the args
    1132 
    +          Sp_subW(2);
    1133 
    +          SpW(1) = (W_)tagged_obj;
    1134 
    +          SpW(0) = (W_)&stg_ret_p_info;
    1135 
    +        }
    1136 
    +
    1137 
    +        goto run_BCO;
    1094 1138
    1095 1139 
         default:
    1096 1140 
         do_return_unrecognised:
    ... ... @@ -1159,8 +1203,9 @@ do_return_nonpointer:
    1159 1203
    1160 1204 
             // get the offset of the header of the next stack frame
    1161 1205 
             offset = stack_frame_sizeW((StgClosure *)Sp);
    1206 
    +        StgClosure* next_frame = (StgClosure*)(SafeSpWP(offset));
    1162 1207
    1163 
    -        switch (get_itbl((StgClosure*)(SafeSpWP(offset)))->type) {
    1208 
    +        switch (get_itbl(next_frame)->type) {
    1164 1209
    1165 1210 
             case RET_BCO:
    1166 1211 
                 // Returning to an interpreted continuation: pop the return frame
    ... ... @@ -1168,8 +1213,59 @@ do_return_nonpointer:
    1168 1213 
                 // executing the BCO.
    1169 1214 
                 INTERP_TICK(it_retto_BCO);
    1170 1215 
                 obj = (StgClosure*)ReadSpW(offset+1);
    1216 
    +
    1171 1217 
                 ASSERT(get_itbl(obj)->type == BCO);
    1172 
    -            goto run_BCO_return_nonpointer;
    1218 
    +
    1219 
    +            // Heap check
    1220 
    +            if (doYouWantToGC(cap)) {
    1221 
    +                RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    1222 
    +            }
    1223 
    +            else {
    1224 
    +              // Stack checks aren't necessary at return points, the stack use
    1225 
    +              // is aggregated into the enclosing function entry point.
    1226 
    +
    1227 
    +#if defined(PROFILING)
    1228 
    +              /*
    1229 
    +                 Restore the current cost centre stack if a tuple is being returned.
    1230 
    +
    1231 
    +                 When a "simple" unlifted value is returned, the cccs is restored with
    1232 
    +                 an stg_restore_cccs frame on the stack, for example:
    1233 
    +
    1234 
    +                     ...
    1235 
    +                     stg_ctoi_D1
    1236 
    +                     <CCCS>
    1237 
    +                     stg_restore_cccs
    1238 
    +
    1239 
    +                 But stg_restore_cccs cannot deal with tuples, which may have more
    1240 
    +                 things on the stack. Therefore we store the CCCS inside the
    1241 
    +                 stg_ctoi_t frame.
    1242 
    +
    1243 
    +                 If we have a tuple being returned, the stack looks like this:
    1244 
    +
    1245 
    +                     ...
    1246 
    +                     <CCCS>           <- to restore, Sp offset <next frame + 4 words>
    1247 
    +                     tuple_BCO
    1248 
    +                     tuple_info
    1249 
    +                     cont_BCO
    1250 
    +                     stg_ctoi_t       <- next frame
    1251 
    +                     tuple_data_1
    1252 
    +                     ...
    1253 
    +                     tuple_data_n
    1254 
    +                     tuple_info
    1255 
    +                     tuple_BCO
    1256 
    +                     stg_ret_t        <- Sp
    1257 
    +               */
    1258 
    +
    1259 
    +              if(SpW(0) == (W_)&stg_ret_t_info) {
    1260 
    +                  cap->r.rCCCS = (CostCentreStack*)ReadSpW(offset + 4);
    1261 
    +              }
    1262 
    +#endif
    1263 
    +
    1264 
    +              /* Keep the stg_ret_*_info header (i.e. don't drop it)
    1265 
    +               * See Note [The Stack when running a Case Continuation BCO]
    1266 
    +               */
    1267 
    +              goto run_BCO;
    1268 
    +            }
    1173 1269
    1174 1270 
             default:
    1175 1271 
             {
    ... ... @@ -1336,8 +1432,8 @@ do_apply:
    1336 1432 
         // Ok, we now have a bco (obj), and its arguments are all on the
    1337 1433 
         // stack.  We can start executing the byte codes.
    1338 1434 
         //
    1339 
    -    // The stack is in one of two states.  First, if this BCO is a
    1340 
    -    // function:
    1435 
    +    // The stack is in one of two states. First, if this BCO is a
    1436 
    +    // function
    1341 1437 
         //
    1342 1438 
         //    |     ....      |
    1343 1439 
         //    +---------------+
    ... ... @@ -1375,68 +1471,6 @@ do_apply:
    1375 1471 
         // Sadly we have three different kinds of stack/heap/cswitch check
    1376 1472 
         // to do:
    1377 1473
    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;
    1439 
    -
    1440 1474 
     run_BCO_fun:
    1441 1475 
         IF_DEBUG(sanity,
    1442 1476 
                  Sp_subW(2);
    ... ... @@ -1519,7 +1553,7 @@ run_BCO:
    1519 1553
    1520 1554 
         switch (bci & 0xFF) {
    1521 1555
    1522 
    -        /* check for a breakpoint on the beginning of a let binding */
    1556 
    +        /* check for a breakpoint on the beginning of a BCO */
    1523 1557 
             case bci_BRK_FUN:
    1524 1558 
             {
    1525 1559 
                 W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
    ... ... @@ -1572,6 +1606,20 @@ run_BCO:
    1572 1606 
                 {
    1573 1607 
                    breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
    1574 1608
    1609 
    +               W_ stack_head = ReadSpW(0);
    1610 
    +
    1611 
    +               // See Note [Stack layout when entering run_BCO blah]
    1612 
    +               // When the BRK_FUN is at the start of a case continuation BCO,
    1613 
    +               // the stack contains the frame returning the value at the start.
    1614 
    +               int is_case_cont_BCO =
    1615 
    +                       stack_head == (W_)&stg_ret_t_info
    1616 
    +                    || stack_head == (W_)&stg_ret_v_info
    1617 
    +                    || stack_head == (W_)&stg_ret_p_info
    1618 
    +                    || stack_head == (W_)&stg_ret_n_info
    1619 
    +                    || stack_head == (W_)&stg_ret_f_info
    1620 
    +                    || stack_head == (W_)&stg_ret_d_info
    1621 
    +                    || stack_head == (W_)&stg_ret_l_info;
    1622 
    +
    1575 1623 
                    // stop the current thread if either `stop_next_breakpoint` is
    1576 1624 
                    // true OR if the ignore count for this particular breakpoint is zero
    1577 1625 
                    StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
    ... ... @@ -1580,36 +1628,84 @@ run_BCO:
    1580 1628 
                       // decrement and write back ignore count
    1581 1629 
                       ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
    1582 1630 
                    }
    1583 
    -               else if (stop_next_breakpoint == true || ignore_count == 0)
    1631 
    +               else if (
    1632 
    +                  /* Doing step-in (but don't stop at case continuation BCOs,
    1633 
    +                   * those are only useful when stepping out) */
    1634 
    +                  (stop_next_breakpoint == true && !is_case_cont_BCO)
    1635 
    +                  /* Or breakpoint is explicitly enabled */
    1636 
    +                  || ignore_count == 0)
    1584 1637 
                    {
    1585 1638 
                       // make sure we don't automatically stop at the
    1586 1639 
                       // next breakpoint
    1587 1640 
                       rts_stop_next_breakpoint = 0;
    1588 1641 
                       cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
    1589 1642
    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);
    1643 
    +                  // TODO: WRITE NOTE
    1644 
    +                  if (is_case_cont_BCO) {
    1645 
    +
    1646 
    +                    // TODO: WRITE NOTE
    1647 
    +                    // A case cont. BCO is headed by a ret_frame with the returned value
    1648 
    +                    // We need the frame here if we are going to yield to construct a well formed stack
    1649 
    +                    // Then, just afterwards, we SLIDE the header off. This is generated code (see StgToByteCode)
    1650 
    +                    int size_returned_frame =
    1651 
    +                        (stack_head == (W_)&stg_ret_t_info)
    1652 
    +                        ? 2 /* ret_t + tuple_BCO */
    1653 
    +                          + /* Sp(2) is call_info which records the offset to the next frame
    1654 
    +                             * See also Note [unboxed tuple bytecodes and tuple_BCO] */
    1655 
    +                          ((ReadSpW(2) & 0xFF))
    1656 
    +                        : 2; /* ret_* + return value */
    1657 
    +
    1658 
    +                    StgPtr cont_frame_head
    1659 
    +                        = (StgPtr)(SpW(size_returned_frame));
    1660 
    +                    ASSERT(obj == UNTAG_CLOSURE((StgClosure*)ReadSpW(size_returned_frame+1)));
    1661 
    +
    1662 
    +                    // stg_ctoi_*
    1663 
    +                    int size_cont_frame_head =
    1664 
    +                        is_ctoi_nontuple_frame(cont_frame_head)
    1665 
    +                        ? 2 // info+bco
    1666 
    +#if defined(PROFILING)
    1667 
    +                        : 5;  // or info+bco+tuple_info+tuple_BCO+CCS
    1668 
    +#else
    1669 
    +                        : 4;  // or info+bco+tuple_info+tuple_BCO
    1670 
    +#endif
    1671 
    +
    1672 
    +                    // Continuation stack is already well formed,
    1673 
    +                    // so just copy it whole to the AP_STACK
    1674 
    +                    size_words = size_returned_frame
    1675 
    +                               + size_cont_frame_head
    1676 
    +                               + BCO_BITMAP_SIZE(obj) /* payload of cont_frame */;
    1677 
    +                    new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
    1678 
    +                    new_aps->size = size_words;
    1679 
    +                    new_aps->fun = &stg_dummy_ret_closure;
    1680 
    +
    1681 
    +                    // (1) Fill in the payload of the AP_STACK:
    1682 
    +                    for (i = 0; i < size_words; i++) {
    1683 
    +                       new_aps->payload[i] = (StgClosure *)ReadSpW(i);
    1684 
    +                    }
    1685 
    +                  }
    1686 
    +                  else {
    1687 
    +                    // (1) Allocate memory for a new AP_STACK, enough to store
    1688 
    +                    // the top stack frame plus an stg_apply_interp_info pointer
    1689 
    +                    // and a pointer to the BCO
    1690 
    +                    size_words = BCO_BITMAP_SIZE(obj) + 2;
    1691 
    +                    new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
    1692 
    +                    new_aps->size = size_words;
    1693 
    +                    new_aps->fun = &stg_dummy_ret_closure;
    1694 
    +
    1695 
    +                    // (1.1) the continuation frame
    1696 
    +                    new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
    1697 
    +                    new_aps->payload[1] = (StgClosure *)obj;
    1698 
    +
    1699 
    +                    // (1.2.1) copy the args/free vars of the top stack frame into the AP_STACK
    1700 
    +                    for (i = 2; i < size_words; i++) {
    1701 
    +                       new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
    1702 
    +                    }
    1607 1703 
                       }
    1608 1704
    1609 1705 
                       // No write barrier is needed here as this is a new allocation
    1610 1706 
                       SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
    1611 1707
    1612 
    -                  // Arrange the stack to call the breakpoint IO action, and
    1708 
    +                  // (2) Arrange the stack to call the breakpoint IO action, and
    1613 1709 
                       // continue execution of this BCO when the IO action returns.
    1614 1710 
                       //
    1615 1711 
                       // ioAction :: Addr#       -- the breakpoint info module
    ... ... @@ -1622,12 +1718,27 @@ run_BCO:
    1622 1718 
                       ioAction = (StgClosure *) deRefStablePtr (
    1623 1719 
                           rts_breakpoint_io_action);
    1624 1720
    1625 
    -                  Sp_subW(13);
    1626 
    -                  SpW(12) = (W_)obj;
    1627 
    -                  SpW(11) = (W_)&stg_apply_interp_info;
    1721 
    +                  // (2.1) Construct the continuation to which we'll return in
    1722 
    +                  // this thread after the `rts_breakpoint_io_action` returns.
    1723 
    +                  //
    1724 
    +                  // For case continuation BCOs, the continuation that re-runs
    1725 
    +                  // it is always ready at the start of the BCO. It gets
    1726 
    +                  // dropped soon after if we don't stop there by SLIDEing.
    1727 
    +                  // See Note [TODO]
    1728 
    +                  if (!is_case_cont_BCO) {
    1729 
    +                    Sp_subW(2); // stg_apply_interp_info + StgBCO*
    1730 
    +
    1731 
    +                    // (2.1.2) Write the continuation frame (above the stg_ret
    1732 
    +                    // frame if one exists)
    1733 
    +                    SpW(1) = (W_)obj;
    1734 
    +                    SpW(0) = (W_)&stg_apply_interp_info;
    1735 
    +                  }
    1736 
    +
    1737 
    +                  // (2.2) The `rts_breakpoint_io_action` call
    1738 
    +                  Sp_subW(11);
    1628 1739 
                       SpW(10) = (W_)new_aps;
    1629 
    -                  SpW(9) = (W_)False_closure;         // True <=> an exception
    1630 
    -                  SpW(8) = (W_)&stg_ap_ppv_info;
    1740 
    +                  SpW(9)  = (W_)False_closure;         // True <=> an exception
    1741 
    +                  SpW(8)  = (W_)&stg_ap_ppv_info;
    1631 1742 
                       SpW(7)  = (W_)arg4_info_index;
    1632 1743 
                       SpW(6)  = (W_)&stg_ap_n_info;
    1633 1744 
                       SpW(5)  = (W_)BCO_LIT(arg3_info_mod_id);
    ... ... @@ -1981,15 +2092,7 @@ run_BCO:
    1981 2092 
             case bci_SLIDE: {
    1982 2093 
                 W_ n  = BCO_GET_LARGE_ARG;
    1983 2094 
                 W_ by = BCO_GET_LARGE_ARG;
    1984 
    -            /*
    1985 
    -             * a_1 ... a_n, b_1 ... b_by, k
    1986 
    -             *           =>
    1987 
    -             * a_1 ... a_n, k
    1988 
    -             */
    1989 
    -            while(n-- > 0) {
    1990 
    -                SpW(n+by) = ReadSpW(n);
    1991 
    -            }
    1992 
    -            Sp_addW(by);
    2095 
    +            SpSlide(n, by);
    1993 2096 
                 INTERP_TICK(it_slides);
    1994 2097 
                 goto nextInsn;
    1995 2098 
             }

  • 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 
    +<--- should break here too
    15 
    +hello3
    16 
    +hello4

  • 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'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help