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 entering a case continuation BCO, the stack is always headed
    1338 
    +     -- by the stg_ret frame and the stg_ctoi frame that returned to it.
    1339 
    +     -- See Note [Stack layout when entering run_BCO]
    1340 
    +     --
    1341 
    +     -- Right after the breakpoint instruction, a case continuation BCO
    1342 
    +     -- drops the stg_ret and stg_ctoi frame headers (see alt_final1,
    1343 
    +     -- alt_final2), leaving the stack with the scrutinee followed by the
    1344 
    +     -- free variables (with depth==d_bndr)
    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 
     ~~~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -2667,14 +2716,19 @@ getLabelsBc n = BcM $ \_ st ->
    2667 2716 
       let ctr = nextlabel st
    2668 2717 
        in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
    2669 2718
    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')
    2719 
    +newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
    2720 
    +newBreakInfo info = BcM $ \env st -> do
    2721 
    +  -- if we're not generating ModBreaks for this module for some reason, we
    2722 
    +  -- can't store breakpoint occurrence information.
    2723 
    +  case modBreaks env of
    2724 
    +    Nothing -> pure (Nothing, st)
    2725 
    +    Just modBreaks -> do
    2726 
    +      let ix = breakInfoIdx st
    2727 
    +          st' = st
    2728 
    +            { breakInfo = IntMap.insert ix info (breakInfo st)
    2729 
    +            , breakInfoIdx = ix + 1
    2730 
    +            }
    2731 
    +      return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
    2678 2732
    2679 2733 
     getCurrentModule :: BcM Module
    2680 2734 
     getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
    ... ... @@ -2687,7 +2741,7 @@ tickFS = fsLit "ticked"
    2687 2741
    2688 2742 
     -- Dehydrating CgBreakInfo
    2689 2743
    2690 
    -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
    2744 
    +dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
    2691 2745 
     dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
    2692 2746 
               CgBreakInfo
    2693 2747 
                 { 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
    ... ... @@ -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_ctoi_nontuple_frame(const StgPtr frame_head) {
    289 
    +  return (
    290 
    +      (W_)frame_head == (W_)&stg_ctoi_R1p_info ||
    291 
    +      (W_)frame_head == (W_)&stg_ctoi_R1n_info ||
    292 
    +      (W_)frame_head == (W_)&stg_ctoi_F1_info ||
    293 
    +      (W_)frame_head == (W_)&stg_ctoi_D1_info ||
    294 
    +      (W_)frame_head == (W_)&stg_ctoi_L1_info ||
    295 
    +      (W_)frame_head == (W_)&stg_ctoi_V_info
    296 
    +    );
    297 
    +}
    298 
    +
    287 299 
     int rts_stop_on_exception = 0;
    288 300
    289 301 
     /* ---------------------------------------------------------------------------
    ... ... @@ -844,7 +856,6 @@ eval_obj:
    844 856 
                  debugBelch("\n\n");
    845 857 
                 );
    846 858
    847 
    -//    IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
    848 859 
         IF_DEBUG(sanity,checkStackFrame(Sp));
    849 860
    850 861 
         switch ( get_itbl(obj)->type ) {
    ... ... @@ -1086,11 +1097,33 @@ do_return_pointer:
    1086 1097 
             // Returning to an interpreted continuation: put the object on
    1087 1098 
             // the stack, and start executing the BCO.
    1088 1099 
             INTERP_TICK(it_retto_BCO);
    1089 
    -        Sp_subW(1);
    1090 
    -        SpW(0) = (W_)tagged_obj;
    1091 
    -        obj = (StgClosure*)ReadSpW(2);
    1100 
    +        obj = (StgClosure*)ReadSpW(1);
    1092 1101 
             ASSERT(get_itbl(obj)->type == BCO);
    1093 
    -        goto run_BCO_return_pointer;
    1102 
    +
    1103 
    +        // Heap check
    1104 
    +        if (doYouWantToGC(cap)) {
    1105 
    +            Sp_subW(2);
    1106 
    +            SpW(1) = (W_)tagged_obj;
    1107 
    +            SpW(0) = (W_)&stg_ret_p_info;
    1108 
    +            RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    1109 
    +        }
    1110 
    +        else {
    1111 
    +
    1112 
    +          // Stack checks aren't necessary at return points, the stack use
    1113 
    +          // is aggregated into the enclosing function entry point.
    1114 
    +
    1115 
    +          // Make sure stack is headed by a ctoi R1p frame when returning a pointer
    1116 
    +          ASSERT(ReadSpW(0) == (W_)&stg_ctoi_R1p_info);
    1117 
    +
    1118 
    +          // Add the return frame on top of the args
    1119 
    +          Sp_subW(2);
    1120 
    +          SpW(1) = (W_)tagged_obj;
    1121 
    +          SpW(0) = (W_)&stg_ret_p_info;
    1122 
    +        }
    1123 
    +
    1124 
    +        /* Keep the ret frame and the ctoi frame for run_BCO.
    1125 
    +         * See Note [Stack layout when entering run_BCO] */
    1126 
    +        goto run_BCO;
    1094 1127
    1095 1128 
         default:
    1096 1129 
         do_return_unrecognised:
    ... ... @@ -1159,8 +1192,9 @@ do_return_nonpointer:
    1159 1192
    1160 1193 
             // get the offset of the header of the next stack frame
    1161 1194 
             offset = stack_frame_sizeW((StgClosure *)Sp);
    1195 
    +        StgClosure* next_frame = (StgClosure*)(SafeSpWP(offset));
    1162 1196
    1163 
    -        switch (get_itbl((StgClosure*)(SafeSpWP(offset)))->type) {
    1197 
    +        switch (get_itbl(next_frame)->type) {
    1164 1198
    1165 1199 
             case RET_BCO:
    1166 1200 
                 // Returning to an interpreted continuation: pop the return frame
    ... ... @@ -1168,8 +1202,58 @@ do_return_nonpointer:
    1168 1202 
                 // executing the BCO.
    1169 1203 
                 INTERP_TICK(it_retto_BCO);
    1170 1204 
                 obj = (StgClosure*)ReadSpW(offset+1);
    1205 
    +
    1171 1206 
                 ASSERT(get_itbl(obj)->type == BCO);
    1172 
    -            goto run_BCO_return_nonpointer;
    1207 
    +
    1208 
    +            // Heap check
    1209 
    +            if (doYouWantToGC(cap)) {
    1210 
    +                RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    1211 
    +            }
    1212 
    +            else {
    1213 
    +              // Stack checks aren't necessary at return points, the stack use
    1214 
    +              // is aggregated into the enclosing function entry point.
    1215 
    +
    1216 
    +#if defined(PROFILING)
    1217 
    +              /*
    1218 
    +                 Restore the current cost centre stack if a tuple is being returned.
    1219 
    +
    1220 
    +                 When a "simple" unlifted value is returned, the cccs is restored with
    1221 
    +                 an stg_restore_cccs frame on the stack, for example:
    1222 
    +
    1223 
    +                     ...
    1224 
    +                     stg_ctoi_D1
    1225 
    +                     <CCCS>
    1226 
    +                     stg_restore_cccs
    1227 
    +
    1228 
    +                 But stg_restore_cccs cannot deal with tuples, which may have more
    1229 
    +                 things on the stack. Therefore we store the CCCS inside the
    1230 
    +                 stg_ctoi_t frame.
    1231 
    +
    1232 
    +                 If we have a tuple being returned, the stack looks like this:
    1233 
    +
    1234 
    +                     ...
    1235 
    +                     <CCCS>           <- to restore, Sp offset <next frame + 4 words>
    1236 
    +                     tuple_BCO
    1237 
    +                     tuple_info
    1238 
    +                     cont_BCO
    1239 
    +                     stg_ctoi_t       <- next frame
    1240 
    +                     tuple_data_1
    1241 
    +                     ...
    1242 
    +                     tuple_data_n
    1243 
    +                     tuple_info
    1244 
    +                     tuple_BCO
    1245 
    +                     stg_ret_t        <- Sp
    1246 
    +               */
    1247 
    +
    1248 
    +              if(SpW(0) == (W_)&stg_ret_t_info) {
    1249 
    +                  cap->r.rCCCS = (CostCentreStack*)ReadSpW(offset + 4);
    1250 
    +              }
    1251 
    +#endif
    1252 
    +
    1253 
    +              /* Keep the ret frame and the ctoi frame for run_BCO.
    1254 
    +               * See Note [Stack layout when entering run_BCO] */
    1255 
    +              goto run_BCO;
    1256 
    +            }
    1173 1257
    1174 1258 
             default:
    1175 1259 
             {
    ... ... @@ -1332,111 +1416,90 @@ do_apply:
    1332 1416 
                 RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
    1333 1417 
         }
    1334 1418
    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;
    1419 
    +/*
    1420 
    +Note [Stack layout when entering run_BCO]
    1421 
    +-----------------------------------------
    1422 
    +We have a bco (obj), and its arguments are all on the stack. We can start
    1423 
    +executing the byte codes.
    1424 
    +
    1425 
    +The stack is in one of two states. First, if this BCO is a
    1426 
    +function (in run_BCO_fun or run_BCO)
    1427 
    +
    1428 
    +   |     ....      |
    1429 
    +   +---------------+
    1430 
    +   |     arg2      |
    1431 
    +   +---------------+
    1432 
    +   |     arg1      |
    1433 
    +   +---------------+
    1434 
    +
    1435 
    +Second, if this BCO is a case cont., as per Note [Case continuation BCOs] (only
    1436 
    +in run_BCO):
    1437 
    +
    1438 
    +   |     ....      |
    1439 
    +   +---------------+
    1440 
    +   |     fv2       |
    1441 
    +   +---------------+
    1442 
    +   |     fv1       |
    1443 
    +   +---------------+
    1444 
    +   |     BCO       |
    1445 
    +   +---------------+
    1446 
    +   | stg_ctoi_ret_ |
    1447 
    +   +---------------+
    1448 
    +   |    retval     |
    1449 
    +   +---------------+
    1450 
    +   | stg_ret_..... |
    1451 
    +   +---------------+
    1452 
    +
    1453 
    +where retval is the value being returned to this continuation.
    1454 
    +In the event of a stack check, heap check, context switch,
    1455 
    +or breakpoint, we need to leave the stack in a sane state so
    1456 
    +the garbage collector can find all the pointers.
    1457 
    +
    1458 
    + (1) BCO is a function:  the BCO's bitmap describes the
    1459 
    +     pointerhood of the arguments.
    1460 
    +
    1461 
    + (2) BCO is a continuation: BCO's bitmap describes the
    1462 
    +     pointerhood of the free variables.
    1463 
    +
    1464 
    +To reconstruct a valid stack state for yielding (such that when we return to
    1465 
    +the interpreter we end up in the same place from where we yielded), we need to
    1466 
    +differentiate the two cases again:
    1467 
    +
    1468 
    +  (1) For function BCOs, the arguments are directly on top of the stack, so it
    1469 
    +  suffices to add a `stg_apply_interp_info` frame header using the BCO that is
    1470 
    +  being applied to these arguments (i.e. the `obj` being run)
    1471 
    +
    1472 
    +  (2) For continuation BCOs, the stack is already consistent -- that's why we
    1473 
    +  keep the ret and ctoi frame on top of the stack when we start executing it.
    1474 
    +
    1475 
    +  We couldn't reconstruct a valid stack that resumes the case continuation
    1476 
    +  execution just from the return and free vars values alone because we wouldn't
    1477 
    +  know what kind of result it was (are we returning a pointer, non pointer int,
    1478 
    +  a tuple? etc.); especially considering some frames have different sizes,
    1479 
    +  notably unboxed tuple return frames (see Note [unboxed tuple bytecodes and tuple_BCO]).
    1480 
    +
    1481 
    +  For consistency, the first instructions in a case continuation BCO, right
    1482 
    +  after a possible BRK_FUN heading it, are two SLIDEs to remove the stg_ret_
    1483 
    +  and stg_ctoi_ frame headers, leaving only the return value followed by the
    1484 
    +  free vars. Theses slides use statically known offsets computed in StgToByteCode.hs.
    1485 
    +  Following the continuation BCO diagram above, SLIDING would result in:
    1486 
    +
    1487 
    +   |     ....      |
    1488 
    +   +---------------+
    1489 
    +   |     fv2       |
    1490 
    +   +---------------+
    1491 
    +   |     fv1       |
    1492 
    +   +---------------+
    1493 
    +   |    retval     |
    1494 
    +   +---------------+
    1495 
    +*/
    1439 1496
    1497 
    +// Ok, we now have a bco (obj), and its arguments are all on the stack as
    1498 
    +// described by Note [Stack layout when entering run_BCO].
    1499 
    +// We can start executing the byte codes.
    1500 
    +//
    1501 
    +// Sadly we have three different kinds of stack/heap/cswitch check
    1502 
    +// to do:
    1440 1503 
     run_BCO_fun:
    1441 1504 
         IF_DEBUG(sanity,
    1442 1505 
                  Sp_subW(2);
    ... ... @@ -1466,6 +1529,7 @@ run_BCO_fun:
    1466 1529
    1467 1530 
         // Now, actually interpret the BCO... (no returning to the
    1468 1531 
         // scheduler again until the stack is in an orderly state).
    1532 
    +    // See also Note [Stack layout when entering run_BCO]
    1469 1533 
     run_BCO:
    1470 1534 
         INTERP_TICK(it_BCO_entries);
    1471 1535 
         {
    ... ... @@ -1519,7 +1583,7 @@ run_BCO:
    1519 1583
    1520 1584 
         switch (bci & 0xFF) {
    1521 1585
    1522 
    -        /* check for a breakpoint on the beginning of a let binding */
    1586 
    +        /* check for a breakpoint on the beginning of a BCO */
    1523 1587 
             case bci_BRK_FUN:
    1524 1588 
             {
    1525 1589 
                 W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
    ... ... @@ -1572,6 +1636,20 @@ run_BCO:
    1572 1636 
                 {
    1573 1637 
                    breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
    1574 1638
    1639 
    +               W_ stack_head = ReadSpW(0);
    1640 
    +
    1641 
    +               // When the BRK_FUN is at the start of a case continuation BCO,
    1642 
    +               // the stack contains the frame returning the value at the start.
    1643 
    +               // See Note [Stack layout when entering run_BCO]
    1644 
    +               int is_case_cont_BCO =
    1645 
    +                       stack_head == (W_)&stg_ret_t_info
    1646 
    +                    || stack_head == (W_)&stg_ret_v_info
    1647 
    +                    || stack_head == (W_)&stg_ret_p_info
    1648 
    +                    || stack_head == (W_)&stg_ret_n_info
    1649 
    +                    || stack_head == (W_)&stg_ret_f_info
    1650 
    +                    || stack_head == (W_)&stg_ret_d_info
    1651 
    +                    || stack_head == (W_)&stg_ret_l_info;
    1652 
    +
    1575 1653 
                    // stop the current thread if either `stop_next_breakpoint` is
    1576 1654 
                    // true OR if the ignore count for this particular breakpoint is zero
    1577 1655 
                    StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
    ... ... @@ -1580,36 +1658,96 @@ run_BCO:
    1580 1658 
                       // decrement and write back ignore count
    1581 1659 
                       ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
    1582 1660 
                    }
    1583 
    -               else if (stop_next_breakpoint == true || ignore_count == 0)
    1661 
    +               else if (
    1662 
    +                  /* Doing step-in (but don't stop at case continuation BCOs,
    1663 
    +                   * those are only useful when stepping out) */
    1664 
    +                  (stop_next_breakpoint == true && !is_case_cont_BCO)
    1665 
    +                  /* Or breakpoint is explicitly enabled */
    1666 
    +                  || ignore_count == 0)
    1584 1667 
                    {
    1585 1668 
                       // make sure we don't automatically stop at the
    1586 1669 
                       // next breakpoint
    1587 1670 
                       rts_stop_next_breakpoint = 0;
    1588 1671 
                       cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
    1589 1672
    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);
    1673 
    +                  /* To yield execution we need to come up with a consistent AP_STACK
    1674 
    +                   * to store in the :history data structure.
    1675 
    +                   */
    1676 
    +                  if (is_case_cont_BCO) {
    1677 
    +
    1678 
    +                    // If the BCO is a case cont. then the stack is headed by the
    1679 
    +                    // stg_ret and a stg_ctoi frames which caused this same BCO
    1680 
    +                    // to be run. This stack is already well-formed, so it
    1681 
    +                    // needs only to be copied to the AP_STACK.
    1682 
    +                    // See Note [Stack layout when entering run_BCO]
    1683 
    +
    1684 
    +                    // stg_ret_*
    1685 
    +                    int size_returned_frame =
    1686 
    +                        (stack_head == (W_)&stg_ret_t_info)
    1687 
    +                        ? 2 /* ret_t + tuple_BCO */
    1688 
    +                          + /* Sp(2) is call_info which records the offset to the next frame
    1689 
    +                             * See also Note [unboxed tuple bytecodes and tuple_BCO] */
    1690 
    +                          ((ReadSpW(2) & 0xFF))
    1691 
    +                        : 2; /* ret_* + return value */
    1692 
    +
    1693 
    +                    StgPtr cont_frame_head
    1694 
    +                        = (StgPtr)(SpW(size_returned_frame));
    1695 
    +                    ASSERT(obj == UNTAG_CLOSURE((StgClosure*)ReadSpW(size_returned_frame+1)));
    1696 
    +
    1697 
    +                    // stg_ctoi_*
    1698 
    +                    int size_cont_frame_head =
    1699 
    +                        is_ctoi_nontuple_frame(cont_frame_head)
    1700 
    +                        ? 2 // info+bco
    1701 
    +#if defined(PROFILING)
    1702 
    +                        : 5;  // or info+bco+tuple_info+tuple_BCO+CCS
    1703 
    +#else
    1704 
    +                        : 4;  // or info+bco+tuple_info+tuple_BCO
    1705 
    +#endif
    1706 
    +
    1707 
    +                    // Continuation stack is already well formed,
    1708 
    +                    // so just copy it whole to the AP_STACK
    1709 
    +                    size_words = size_returned_frame
    1710 
    +                               + size_cont_frame_head
    1711 
    +                               + BCO_BITMAP_SIZE(obj) /* payload of cont_frame */;
    1712 
    +                    new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
    1713 
    +                    new_aps->size = size_words;
    1714 
    +                    new_aps->fun = &stg_dummy_ret_closure;
    1715 
    +
    1716 
    +                    // (1) Fill in the payload of the AP_STACK:
    1717 
    +                    for (i = 0; i < size_words; i++) {
    1718 
    +                       new_aps->payload[i] = (StgClosure *)ReadSpW(i);
    1719 
    +                    }
    1720 
    +                  }
    1721 
    +                  else {
    1722 
    +
    1723 
    +                    // The BCO is a function, therefore the arguments are
    1724 
    +                    // directly on top of the stack.
    1725 
    +                    // To construct a valid stack chunk simply add an
    1726 
    +                    // stg_apply_interp and the current BCO to the stack.
    1727 
    +                    // See also Note [Stack layout when entering run_BCO]
    1728 
    +
    1729 
    +                    // (1) Allocate memory for a new AP_STACK, enough to store
    1730 
    +                    // the top stack frame plus an stg_apply_interp_info pointer
    1731 
    +                    // and a pointer to the BCO
    1732 
    +                    size_words = BCO_BITMAP_SIZE(obj) + 2;
    1733 
    +                    new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
    1734 
    +                    new_aps->size = size_words;
    1735 
    +                    new_aps->fun = &stg_dummy_ret_closure;
    1736 
    +
    1737 
    +                    // (1.1) the continuation frame
    1738 
    +                    new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
    1739 
    +                    new_aps->payload[1] = (StgClosure *)obj;
    1740 
    +
    1741 
    +                    // (1.2.1) copy the args/free vars of the top stack frame into the AP_STACK
    1742 
    +                    for (i = 2; i < size_words; i++) {
    1743 
    +                       new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
    1744 
    +                    }
    1607 1745 
                       }
    1608 1746
    1609 1747 
                       // No write barrier is needed here as this is a new allocation
    1610 1748 
                       SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
    1611 1749
    1612 
    -                  // Arrange the stack to call the breakpoint IO action, and
    1750 
    +                  // (2) Arrange the stack to call the breakpoint IO action, and
    1613 1751 
                       // continue execution of this BCO when the IO action returns.
    1614 1752 
                       //
    1615 1753 
                       // ioAction :: Addr#       -- the breakpoint info module
    ... ... @@ -1622,12 +1760,27 @@ run_BCO:
    1622 1760 
                       ioAction = (StgClosure *) deRefStablePtr (
    1623 1761 
                           rts_breakpoint_io_action);
    1624 1762
    1625 
    -                  Sp_subW(13);
    1626 
    -                  SpW(12) = (W_)obj;
    1627 
    -                  SpW(11) = (W_)&stg_apply_interp_info;
    1763 
    +                  // (2.1) Construct the continuation to which we'll return in
    1764 
    +                  // this thread after the `rts_breakpoint_io_action` returns.
    1765 
    +                  //
    1766 
    +                  // For case cont. BCOs, the continuation to re-run this BCO
    1767 
    +                  // is already first on the stack. For function BCOs we need
    1768 
    +                  // to add an `stg_apply_interp` apply to the current BCO.
    1769 
    +                  // See Note [Stack layout when entering run_BCO]
    1770 
    +                  if (!is_case_cont_BCO) {
    1771 
    +                    Sp_subW(2); // stg_apply_interp_info + StgBCO*
    1772 
    +
    1773 
    +                    // (2.1.2) Write the continuation frame (above the stg_ret
    1774 
    +                    // frame if one exists)
    1775 
    +                    SpW(1) = (W_)obj;
    1776 
    +                    SpW(0) = (W_)&stg_apply_interp_info;
    1777 
    +                  }
    1778 
    +
    1779 
    +                  // (2.2) The `rts_breakpoint_io_action` call
    1780 
    +                  Sp_subW(11);
    1628 1781 
                       SpW(10) = (W_)new_aps;
    1629 
    -                  SpW(9) = (W_)False_closure;         // True <=> an exception
    1630 
    -                  SpW(8) = (W_)&stg_ap_ppv_info;
    1782 
    +                  SpW(9)  = (W_)False_closure;         // True <=> an exception
    1783 
    +                  SpW(8)  = (W_)&stg_ap_ppv_info;
    1631 1784 
                       SpW(7)  = (W_)arg4_info_index;
    1632 1785 
                       SpW(6)  = (W_)&stg_ap_n_info;
    1633 1786 
                       SpW(5)  = (W_)BCO_LIT(arg3_info_mod_id);

  • 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