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/CoreToIface.hs
    ... ... @@ -44,16 +44,12 @@ module GHC.CoreToIface
    44 44 
           -- * Other stuff
    45 45 
         , toIfaceLFInfo
    46 46 
         , toIfaceBooleanFormula
    47 
    -      -- * CgBreakInfo
    48 
    -    , dehydrateCgBreakInfo
    49 47 
         ) where
    50 48
    51 49 
     import GHC.Prelude
    52 50
    53 51 
     import GHC.StgToCmm.Types
    54 52
    55 
    -import GHC.ByteCode.Types
    56 
    -
    57 53 
     import GHC.Core
    58 54 
     import GHC.Core.TyCon hiding ( pprPromotionQuote )
    59 55 
     import GHC.Core.Coercion.Axiom
    ... ... @@ -702,16 +698,6 @@ toIfaceLFInfo nm lfi = case lfi of
    702 698 
         LFLetNoEscape ->
    703 699 
           panic "toIfaceLFInfo: LFLetNoEscape"
    704 700
    705 
    --- Dehydrating CgBreakInfo
    706 
    -
    707 
    -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
    708 
    -dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
    709 
    -          CgBreakInfo
    710 
    -            { cgb_tyvars = map toIfaceTvBndr ty_vars
    711 
    -            , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
    712 
    -            , cgb_resty = toIfaceType tick_ty
    713 
    -            , cgb_tick_id = bid
    714 
    -            }
    715 701
    716 702 
     {- Note [Inlining and hs-boot files]
    717 703 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  • 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)
    ... ... @@ -2684,3 +2742,14 @@ getCurrentModBreaks = BcM $ \env st -> return (modBreaks env, st)
    2684 2742
    2685 2743 
     tickFS :: FastString
    2686 2744 
     tickFS = fsLit "ticked"
    2745 
    +
    2746 
    +-- Dehydrating CgBreakInfo
    2747 
    +
    2748 
    +dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
    2749 
    +dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
    2750 
    +          CgBreakInfo
    2751 
    +            { cgb_tyvars = map toIfaceTvBndr ty_vars
    2752 
    +            , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
    2753 
    +            , cgb_resty = toIfaceType tick_ty
    2754 
    +            , cgb_tick_id = bid
    2755 
    +            }

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

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

  • rts/Disassembler.c
    ... ... @@ -92,9 +92,9 @@ disInstr ( StgBCO *bco, int pc )
    92 92 
              info_wix     = BCO_NEXT;
    93 93 
              np           = BCO_GET_LARGE_ARG;
    94 94 
              debugBelch ("BRK_FUN " );  printPtr( ptrs[p1] );
    95 
    -         debugBelch("%" FMT_Word, literals[info_mod] );
    96 
    -         debugBelch("%" FMT_Word, literals[info_unit_id] );
    97 
    -         debugBelch("%" FMT_Word, info_wix );
    95 
    +         debugBelch(" %" FMT_Word, literals[info_mod] );
    96 
    +         debugBelch(" %" FMT_Word, literals[info_unit_id] );
    97 
    +         debugBelch(" %" FMT_Word, info_wix );
    98 98 
              CostCentre* cc = (CostCentre*)literals[np];
    99 99 
              if (cc) {
    100 100 
                debugBelch(" %s", cc->label);

  • 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,19 @@ 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 StgClosure* frame) {
    302 
    +  const StgInfoTable* info = frame->header.info;
    303 
    +  return (
    304 
    +      (W_)info == (W_)&stg_ctoi_R1p_info ||
    305 
    +      (W_)info == (W_)&stg_ctoi_R1n_info ||
    306 
    +      (W_)info == (W_)&stg_ctoi_F1_info ||
    307 
    +      (W_)info == (W_)&stg_ctoi_D1_info ||
    308 
    +      (W_)info == (W_)&stg_ctoi_L1_info ||
    309 
    +      (W_)info == (W_)&stg_ctoi_V_info
    310 
    +    );
    311 
    +}
    312 
    +
    287 313 
     int rts_stop_on_exception = 0;
    288 314
    289 315 
     /* ---------------------------------------------------------------------------
    ... ... @@ -473,6 +499,72 @@ void interp_shutdown( void ){
    473 499
    474 500 
     #endif
    475 501
    502 
    +const StgPtr ctoi_tuple_infos[] = {
    503 
    +    (StgPtr) &stg_ctoi_t0_info,
    504 
    +    (StgPtr) &stg_ctoi_t1_info,
    505 
    +    (StgPtr) &stg_ctoi_t2_info,
    506 
    +    (StgPtr) &stg_ctoi_t3_info,
    507 
    +    (StgPtr) &stg_ctoi_t4_info,
    508 
    +    (StgPtr) &stg_ctoi_t5_info,
    509 
    +    (StgPtr) &stg_ctoi_t6_info,
    510 
    +    (StgPtr) &stg_ctoi_t7_info,
    511 
    +    (StgPtr) &stg_ctoi_t8_info,
    512 
    +    (StgPtr) &stg_ctoi_t9_info,
    513 
    +    (StgPtr) &stg_ctoi_t10_info,
    514 
    +    (StgPtr) &stg_ctoi_t11_info,
    515 
    +    (StgPtr) &stg_ctoi_t12_info,
    516 
    +    (StgPtr) &stg_ctoi_t13_info,
    517 
    +    (StgPtr) &stg_ctoi_t14_info,
    518 
    +    (StgPtr) &stg_ctoi_t15_info,
    519 
    +    (StgPtr) &stg_ctoi_t16_info,
    520 
    +    (StgPtr) &stg_ctoi_t17_info,
    521 
    +    (StgPtr) &stg_ctoi_t18_info,
    522 
    +    (StgPtr) &stg_ctoi_t19_info,
    523 
    +    (StgPtr) &stg_ctoi_t20_info,
    524 
    +    (StgPtr) &stg_ctoi_t21_info,
    525 
    +    (StgPtr) &stg_ctoi_t22_info,
    526 
    +    (StgPtr) &stg_ctoi_t23_info,
    527 
    +    (StgPtr) &stg_ctoi_t24_info,
    528 
    +    (StgPtr) &stg_ctoi_t25_info,
    529 
    +    (StgPtr) &stg_ctoi_t26_info,
    530 
    +    (StgPtr) &stg_ctoi_t27_info,
    531 
    +    (StgPtr) &stg_ctoi_t28_info,
    532 
    +    (StgPtr) &stg_ctoi_t29_info,
    533 
    +    (StgPtr) &stg_ctoi_t30_info,
    534 
    +    (StgPtr) &stg_ctoi_t31_info,
    535 
    +    (StgPtr) &stg_ctoi_t32_info,
    536 
    +    (StgPtr) &stg_ctoi_t33_info,
    537 
    +    (StgPtr) &stg_ctoi_t34_info,
    538 
    +    (StgPtr) &stg_ctoi_t35_info,
    539 
    +    (StgPtr) &stg_ctoi_t36_info,
    540 
    +    (StgPtr) &stg_ctoi_t37_info,
    541 
    +    (StgPtr) &stg_ctoi_t38_info,
    542 
    +    (StgPtr) &stg_ctoi_t39_info,
    543 
    +    (StgPtr) &stg_ctoi_t40_info,
    544 
    +    (StgPtr) &stg_ctoi_t41_info,
    545 
    +    (StgPtr) &stg_ctoi_t42_info,
    546 
    +    (StgPtr) &stg_ctoi_t43_info,
    547 
    +    (StgPtr) &stg_ctoi_t44_info,
    548 
    +    (StgPtr) &stg_ctoi_t45_info,
    549 
    +    (StgPtr) &stg_ctoi_t46_info,
    550 
    +    (StgPtr) &stg_ctoi_t47_info,
    551 
    +    (StgPtr) &stg_ctoi_t48_info,
    552 
    +    (StgPtr) &stg_ctoi_t49_info,
    553 
    +    (StgPtr) &stg_ctoi_t50_info,
    554 
    +    (StgPtr) &stg_ctoi_t51_info,
    555 
    +    (StgPtr) &stg_ctoi_t52_info,
    556 
    +    (StgPtr) &stg_ctoi_t53_info,
    557 
    +    (StgPtr) &stg_ctoi_t54_info,
    558 
    +    (StgPtr) &stg_ctoi_t55_info,
    559 
    +    (StgPtr) &stg_ctoi_t56_info,
    560 
    +    (StgPtr) &stg_ctoi_t57_info,
    561 
    +    (StgPtr) &stg_ctoi_t58_info,
    562 
    +    (StgPtr) &stg_ctoi_t59_info,
    563 
    +    (StgPtr) &stg_ctoi_t60_info,
    564 
    +    (StgPtr) &stg_ctoi_t61_info,
    565 
    +    (StgPtr) &stg_ctoi_t62_info,
    566 
    +};
    567 
    +
    476 568 
     #if defined(PROFILING)
    477 569
    478 570 
     //
    ... ... @@ -642,13 +734,12 @@ interpretBCO (Capability* cap)
    642 734 
             ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
    643 735
    644 736 
             StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
    645 
    -        StgWord16 bci = instrs[0];
    737 
    +        int bciPtr = 0;
    738 
    +        StgWord16 bci = BCO_NEXT;
    646 739
    647 740 
             /* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
    648 741 
              * instruction in a BCO */
    649 742 
             if ((bci & 0xFF) == bci_BRK_FUN) {
    650 
    -            // Define rest of variables used by BCO_* Macros
    651 
    -            int bciPtr = 0;
    652 743
    653 744 
                 W_ arg1_brk_array, arg4_info_index;
    654 745 
                 arg1_brk_array      = BCO_GET_LARGE_ARG;
    ... ... @@ -779,7 +870,6 @@ eval_obj:
    779 870 
                  debugBelch("\n\n");
    780 871 
                 );
    781 872
    782 
    -//    IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
    783 873 
         IF_DEBUG(sanity,checkStackFrame(Sp));
    784 874
    785 875 
         switch ( get_itbl(obj)->type ) {
    ... ... @@ -1021,11 +1111,37 @@ do_return_pointer:
    1021 1111 
             // Returning to an interpreted continuation: put the object on
    1022 1112 
             // the stack, and start executing the BCO.
    1023 1113 
             INTERP_TICK(it_retto_BCO);
    1024 
    -        Sp_subW(1);
    1025 
    -        SpW(0) = (W_)tagged_obj;
    1026 
    -        obj = (StgClosure*)ReadSpW(2);
    1114 
    +        obj = (StgClosure*)ReadSpW(1);
    1027 1115 
             ASSERT(get_itbl(obj)->type == BCO);
    1028 
    -        goto run_BCO_return_pointer;
    1116 
    +
    1117 
    +        // Heap check
    1118 
    +        if (doYouWantToGC(cap)) {
    1119 
    +            Sp_subW(2);
    1120 
    +            SpW(1) = (W_)tagged_obj;
    1121 
    +            SpW(0) = (W_)&stg_ret_p_info;
    1122 
    +            RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    1123 
    +        }
    1124 
    +        else {
    1125 
    +
    1126 
    +          // Stack checks aren't necessary at return points, the stack use
    1127 
    +          // is aggregated into the enclosing function entry point.
    1128 
    +
    1129 
    +          // Make sure to drop the RET_BCO frame header,
    1130 
    +          // but not its arguments (which are expected at the top when running the BCO).
    1131 
    +          // NOTE: Always a return_pointer (ie not a tuple ctoi frame!)
    1132 
    +
    1133 
    +          // Make sure stack is headed by a ctoi nontuple frame then drop it.
    1134 
    +          // The arguments to the BCO continuation stay on top of the stack
    1135 
    +          ASSERT(ReadSpW(0) == (W_)&stg_ctoi_R1p_info);
    1136 
    +          // TODO: NO LONGER NEEDED BC NOW WE KEEP THE FRAMES Sp_addW(2);
    1137 
    +
    1138 
    +          // Plus the return frame on top of the args
    1139 
    +          Sp_subW(2);
    1140 
    +          SpW(1) = (W_)tagged_obj;
    1141 
    +          SpW(0) = (W_)&stg_ret_p_info;
    1142 
    +        }
    1143 
    +
    1144 
    +        goto run_BCO;
    1029 1145
    1030 1146 
         default:
    1031 1147 
         do_return_unrecognised:
    ... ... @@ -1094,8 +1210,9 @@ do_return_nonpointer:
    1094 1210
    1095 1211 
             // get the offset of the header of the next stack frame
    1096 1212 
             offset = stack_frame_sizeW((StgClosure *)Sp);
    1213 
    +        StgClosure* next_frame = (StgClosure*)(SafeSpWP(offset));
    1097 1214
    1098 
    -        switch (get_itbl((StgClosure*)(SafeSpWP(offset)))->type) {
    1215 
    +        switch (get_itbl(next_frame)->type) {
    1099 1216
    1100 1217 
             case RET_BCO:
    1101 1218 
                 // Returning to an interpreted continuation: pop the return frame
    ... ... @@ -1103,8 +1220,74 @@ do_return_nonpointer:
    1103 1220 
                 // executing the BCO.
    1104 1221 
                 INTERP_TICK(it_retto_BCO);
    1105 1222 
                 obj = (StgClosure*)ReadSpW(offset+1);
    1223 
    +
    1106 1224 
                 ASSERT(get_itbl(obj)->type == BCO);
    1107 
    -            goto run_BCO_return_nonpointer;
    1225 
    +
    1226 
    +            // Heap check
    1227 
    +            if (doYouWantToGC(cap)) {
    1228 
    +                RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    1229 
    +            }
    1230 
    +            else {
    1231 
    +              // Stack checks aren't necessary at return points, the stack use
    1232 
    +              // is aggregated into the enclosing function entry point.
    1233 
    +
    1234 
    +#if defined(PROFILING)
    1235 
    +              /*
    1236 
    +                 Restore the current cost centre stack if a tuple is being returned.
    1237 
    +
    1238 
    +                 When a "simple" unlifted value is returned, the cccs is restored with
    1239 
    +                 an stg_restore_cccs frame on the stack, for example:
    1240 
    +
    1241 
    +                     ...
    1242 
    +                     stg_ctoi_D1
    1243 
    +                     <CCCS>
    1244 
    +                     stg_restore_cccs
    1245 
    +
    1246 
    +                 But stg_restore_cccs cannot deal with tuples, which may have more
    1247 
    +                 things on the stack. Therefore we store the CCCS inside the
    1248 
    +                 stg_ctoi_t frame.
    1249 
    +
    1250 
    +                 If we have a tuple being returned, the stack looks like this:
    1251 
    +
    1252 
    +                     ...
    1253 
    +                     <CCCS>           <- to restore, Sp offset <next frame + 4 words>
    1254 
    +                     tuple_BCO
    1255 
    +                     tuple_info
    1256 
    +                     cont_BCO
    1257 
    +                     stg_ctoi_t       <- next frame
    1258 
    +                     tuple_data_1
    1259 
    +                     ...
    1260 
    +                     tuple_data_n
    1261 
    +                     tuple_info
    1262 
    +                     tuple_BCO
    1263 
    +                     stg_ret_t        <- Sp
    1264 
    +               */
    1265 
    +
    1266 
    +              if(SpW(0) == (W_)&stg_ret_t_info) {
    1267 
    +                  cap->r.rCCCS = (CostCentreStack*)ReadSpW(offset + 4);
    1268 
    +              }
    1269 
    +#endif
    1270 
    +              /* Drop the RET_BCO header (next_frame),
    1271 
    +               * but not its arguments (which are expected at the top when running the BCO)
    1272 
    +               *
    1273 
    +               * NEVERMINDDDDD JUST KEEP THE FRAMES.
    1274 
    +               * WRITE NEW NOTE
    1275 
    +               */
    1276 
    +//               W_ n  = offset;
    1277 
    +//               W_ by = is_ctoi_nontuple_frame(next_frame)
    1278 
    +//                           ? 2 // info+bco
    1279 
    +// #if defined(PROFILING)
    1280 
    +//                           : 5;  // or info+bco+tuple_info+tuple_BCO+CCS
    1281 
    +// #else
    1282 
    +//                           : 4;  // or info+bco+tuple_info+tuple_BCO
    1283 
    +// #endif
    1284 
    +//              SpSlide(n, by);
    1285 
    +
    1286 
    +              /* Keep the stg_ret_*_info header (i.e. don't drop it)
    1287 
    +               * See Note [The Stack when running a Case Continuation BCO]
    1288 
    +               */
    1289 
    +              goto run_BCO;
    1290 
    +            }
    1108 1291
    1109 1292 
             default:
    1110 1293 
             {
    ... ... @@ -1271,8 +1454,8 @@ do_apply:
    1271 1454 
         // Ok, we now have a bco (obj), and its arguments are all on the
    1272 1455 
         // stack.  We can start executing the byte codes.
    1273 1456 
         //
    1274 
    -    // The stack is in one of two states.  First, if this BCO is a
    1275 
    -    // function:
    1457 
    +    // The stack is in one of two states. First, if this BCO is a
    1458 
    +    // function
    1276 1459 
         //
    1277 1460 
         //    |     ....      |
    1278 1461 
         //    +---------------+
    ... ... @@ -1289,10 +1472,6 @@ do_apply:
    1289 1472 
         //    +---------------+
    1290 1473 
         //    |     fv1       |
    1291 1474 
         //    +---------------+
    1292 
    -    //    |     BCO       |
    1293 
    -    //    +---------------+
    1294 
    -    //    | stg_ctoi_ret_ |
    1295 
    -    //    +---------------+
    1296 1475 
         //    |    retval     |
    1297 1476 
         //    +---------------+
    1298 1477 
         //
    ... ... @@ -1310,68 +1489,6 @@ do_apply:
    1310 1489 
         // Sadly we have three different kinds of stack/heap/cswitch check
    1311 1490 
         // to do:
    1312 1491
    1313 
    -
    1314 
    -run_BCO_return_pointer:
    1315 
    -    // Heap check
    1316 
    -    if (doYouWantToGC(cap)) {
    1317 
    -        Sp_subW(1); SpW(0) = (W_)&stg_ret_p_info;
    1318 
    -        RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    1319 
    -    }
    1320 
    -    // Stack checks aren't necessary at return points, the stack use
    1321 
    -    // is aggregated into the enclosing function entry point.
    1322 
    -
    1323 
    -    goto run_BCO;
    1324 
    -
    1325 
    -run_BCO_return_nonpointer:
    1326 
    -    // Heap check
    1327 
    -    if (doYouWantToGC(cap)) {
    1328 
    -        RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
    1329 
    -    }
    1330 
    -    // Stack checks aren't necessary at return points, the stack use
    1331 
    -    // is aggregated into the enclosing function entry point.
    1332 
    -
    1333 
    -#if defined(PROFILING)
    1334 
    -    /*
    1335 
    -       Restore the current cost centre stack if a tuple is being returned.
    1336 
    -
    1337 
    -       When a "simple" unlifted value is returned, the cccs is restored with
    1338 
    -       an stg_restore_cccs frame on the stack, for example:
    1339 
    -
    1340 
    -           ...
    1341 
    -           stg_ctoi_D1
    1342 
    -           <CCCS>
    1343 
    -           stg_restore_cccs
    1344 
    -
    1345 
    -       But stg_restore_cccs cannot deal with tuples, which may have more
    1346 
    -       things on the stack. Therefore we store the CCCS inside the
    1347 
    -       stg_ctoi_t frame.
    1348 
    -
    1349 
    -       If we have a tuple being returned, the stack looks like this:
    1350 
    -
    1351 
    -           ...
    1352 
    -           <CCCS>           <- to restore, Sp offset <next frame + 4 words>
    1353 
    -           tuple_BCO
    1354 
    -           tuple_info
    1355 
    -           cont_BCO
    1356 
    -           stg_ctoi_t       <- next frame
    1357 
    -           tuple_data_1
    1358 
    -           ...
    1359 
    -           tuple_data_n
    1360 
    -           tuple_info
    1361 
    -           tuple_BCO
    1362 
    -           stg_ret_t        <- Sp
    1363 
    -     */
    1364 
    -
    1365 
    -    if(SpW(0) == (W_)&stg_ret_t_info) {
    1366 
    -        cap->r.rCCCS = (CostCentreStack*)ReadSpW(stack_frame_sizeW((StgClosure *)Sp) + 4);
    1367 
    -    }
    1368 
    -#endif
    1369 
    -
    1370 
    -    if (SpW(0) != (W_)&stg_ret_t_info) {
    1371 
    -      Sp_addW(1);
    1372 
    -    }
    1373 
    -    goto run_BCO;
    1374 
    -
    1375 1492 
     run_BCO_fun:
    1376 1493 
         IF_DEBUG(sanity,
    1377 1494 
                  Sp_subW(2);
    ... ... @@ -1454,7 +1571,7 @@ run_BCO:
    1454 1571
    1455 1572 
         switch (bci & 0xFF) {
    1456 1573
    1457 
    -        /* check for a breakpoint on the beginning of a let binding */
    1574 
    +        /* check for a breakpoint on the beginning of a BCO */
    1458 1575 
             case bci_BRK_FUN:
    1459 1576 
             {
    1460 1577 
                 W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
    ... ... @@ -1522,29 +1639,81 @@ run_BCO:
    1522 1639 
                       rts_stop_next_breakpoint = 0;
    1523 1640 
                       cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
    1524 1641
    1525 
    -                  // allocate memory for a new AP_STACK, enough to
    1526 
    -                  // store the top stack frame plus an
    1527 
    -                  // stg_apply_interp_info pointer and a pointer to
    1528 
    -                  // the BCO
    1529 
    -                  size_words = BCO_BITMAP_SIZE(obj) + 2;
    1530 
    -                  new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
    1531 
    -                  new_aps->size = size_words;
    1532 
    -                  new_aps->fun = &stg_dummy_ret_closure;
    1533 
    -
    1534 
    -                  // fill in the payload of the AP_STACK
    1535 
    -                  new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
    1536 
    -                  new_aps->payload[1] = (StgClosure *)obj;
    1537 
    -
    1538 
    -                  // copy the contents of the top stack frame into the AP_STACK
    1539 
    -                  for (i = 2; i < size_words; i++)
    1540 
    -                  {
    1541 
    -                     new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
    1642 
    +                  W_ stack_head = ReadSpW(0);
    1643 
    +
    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 
    +
    1653 
    +                  // TODO: WRITE NOTE
    1654 
    +                  if (is_case_cont_BCO) {
    1655 
    +
    1656 
    +                    // TODO: WRITE NOTE
    1657 
    +                    // A case cont. BCO is headed by a ret_frame with the returned value
    1658 
    +                    // We need the frame here if we are going to yield to construct a well formed stack
    1659 
    +                    // Then, just afterwards, we SLIDE the header off. This is generated code (see StgToByteCode)
    1660 
    +                    int size_returned_frame =
    1661 
    +                        (stack_head == (W_)&stg_ret_t_info)
    1662 
    +                        ? 2 /* ret_t + tuple_BCO */
    1663 
    +                          + /* Sp(2) is call_info which records the offset to the next frame
    1664 
    +                             * See also Note [unboxed tuple bytecodes and tuple_BCO] */
    1665 
    +                          ((ReadSpW(2) & 0xFF))
    1666 
    +                        : 2; /* ret_* + return value */
    1667 
    +
    1668 
    +                    StgClosure* cont_frame_head
    1669 
    +                        = (StgClosure*)(SpW(size_returned_frame));
    1670 
    +
    1671 
    +                    // stg_ctoi_*
    1672 
    +                    int size_cont_frame =
    1673 
    +                        is_ctoi_nontuple_frame(cont_frame_head)
    1674 
    +                        ? 2 // info+bco
    1675 
    +#if defined(PROFILING)
    1676 
    +                        : 5;  // or info+bco+tuple_info+tuple_BCO+CCS
    1677 
    +#else
    1678 
    +                        : 4;  // or info+bco+tuple_info+tuple_BCO
    1679 
    +#endif
    1680 
    +
    1681 
    +                    // Continuation stack is already well formed,
    1682 
    +                    // so just copy it whole to the AP_STACK
    1683 
    +                    size_words = size_returned_frame
    1684 
    +                               + size_cont_frame;
    1685 
    +                    new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
    1686 
    +                    new_aps->size = size_words;
    1687 
    +                    new_aps->fun = &stg_dummy_ret_closure;
    1688 
    +
    1689 
    +                    // (1) Fill in the payload of the AP_STACK:
    1690 
    +                    for (i = 0; i < size_words; i++) {
    1691 
    +                       new_aps->payload[i] = (StgClosure *)ReadSpW(i);
    1692 
    +                    }
    1693 
    +                  }
    1694 
    +                  else {
    1695 
    +                    // (1) Allocate memory for a new AP_STACK, enough to store
    1696 
    +                    // the top stack frame plus an stg_apply_interp_info pointer
    1697 
    +                    // and a pointer to the BCO
    1698 
    +                    size_words = BCO_BITMAP_SIZE(obj) + 2;
    1699 
    +                    new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
    1700 
    +                    new_aps->size = size_words;
    1701 
    +                    new_aps->fun = &stg_dummy_ret_closure;
    1702 
    +
    1703 
    +                    // (1.1) the continuation frame
    1704 
    +                    new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
    1705 
    +                    new_aps->payload[1] = (StgClosure *)obj;
    1706 
    +
    1707 
    +                    // (1.2.1) copy the args/free vars of the top stack frame into the AP_STACK
    1708 
    +                    for (i = 2; i < size_words; i++) {
    1709 
    +                       new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
    1710 
    +                    }
    1542 1711 
                       }
    1543 1712
    1544 1713 
                       // No write barrier is needed here as this is a new allocation
    1545 1714 
                       SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
    1546 1715
    1547 
    -                  // Arrange the stack to call the breakpoint IO action, and
    1716 
    +                  // (2) Arrange the stack to call the breakpoint IO action, and
    1548 1717 
                       // continue execution of this BCO when the IO action returns.
    1549 1718 
                       //
    1550 1719 
                       // ioAction :: Addr#       -- the breakpoint info module
    ... ... @@ -1557,12 +1726,27 @@ run_BCO:
    1557 1726 
                       ioAction = (StgClosure *) deRefStablePtr (
    1558 1727 
                           rts_breakpoint_io_action);
    1559 1728
    1560 
    -                  Sp_subW(13);
    1561 
    -                  SpW(12) = (W_)obj;
    1562 
    -                  SpW(11) = (W_)&stg_apply_interp_info;
    1729 
    +                  // (2.1) Construct the continuation to which we'll return in
    1730 
    +                  // this thread after the `rts_breakpoint_io_action` returns.
    1731 
    +                  //
    1732 
    +                  // For case continuation BCOs, the continuation that re-runs
    1733 
    +                  // it is always ready at the start of the BCO. It gets
    1734 
    +                  // dropped soon after if we don't stop there by SLIDEing.
    1735 
    +                  // See Note [TODO]
    1736 
    +                  if (!is_case_cont_BCO) {
    1737 
    +                    Sp_subW(2); // stg_apply_interp_info + StgBCO*
    1738 
    +
    1739 
    +                    // (2.1.2) Write the continuation frame (above the stg_ret
    1740 
    +                    // frame if one exists)
    1741 
    +                    SpW(1) = (W_)obj;
    1742 
    +                    SpW(0) = (W_)&stg_apply_interp_info;
    1743 
    +                  }
    1744 
    +
    1745 
    +                  // (2.2) The `rts_breakpoint_io_action` call
    1746 
    +                  Sp_subW(11);
    1563 1747 
                       SpW(10) = (W_)new_aps;
    1564 
    -                  SpW(9) = (W_)False_closure;         // True <=> an exception
    1565 
    -                  SpW(8) = (W_)&stg_ap_ppv_info;
    1748 
    +                  SpW(9)  = (W_)False_closure;         // True <=> an exception
    1749 
    +                  SpW(8)  = (W_)&stg_ap_ppv_info;
    1566 1750 
                       SpW(7)  = (W_)arg4_info_index;
    1567 1751 
                       SpW(6)  = (W_)&stg_ap_n_info;
    1568 1752 
                       SpW(5)  = (W_)BCO_LIT(arg3_info_mod_id);
    ... ... @@ -1733,6 +1917,10 @@ run_BCO:
    1733 1917 
                 Sp_subW(2);
    1734 1918 
                 SpW(1) = BCO_PTR(o_bco);
    1735 1919 
                 SpW(0) = (W_)&stg_ctoi_R1p_info;
    1920 
    +
    1921 
    +            // The o_bco expects its arguments (as per the BCO_BITMAP_SIZE) to
    1922 
    +            // be found on the stack before it.
    1923 
    +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
    1736 1924 
     #if defined(PROFILING)
    1737 1925 
                 Sp_subW(2);
    1738 1926 
                 SpW(1) = (W_)cap->r.rCCCS;
    ... ... @@ -1746,6 +1934,8 @@ run_BCO:
    1746 1934 
                 SpW(-2) = (W_)&stg_ctoi_R1n_info;
    1747 1935 
                 SpW(-1) = BCO_PTR(o_bco);
    1748 1936 
                 Sp_subW(2);
    1937 
    +
    1938 
    +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
    1749 1939 
     #if defined(PROFILING)
    1750 1940 
                 Sp_subW(2);
    1751 1941 
                 SpW(1) = (W_)cap->r.rCCCS;
    ... ... @@ -1759,6 +1949,8 @@ run_BCO:
    1759 1949 
                 SpW(-2) = (W_)&stg_ctoi_F1_info;
    1760 1950 
                 SpW(-1) = BCO_PTR(o_bco);
    1761 1951 
                 Sp_subW(2);
    1952 
    +
    1953 
    +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
    1762 1954 
     #if defined(PROFILING)
    1763 1955 
                 Sp_subW(2);
    1764 1956 
                 SpW(1) = (W_)cap->r.rCCCS;
    ... ... @@ -1772,6 +1964,8 @@ run_BCO:
    1772 1964 
                 SpW(-2) = (W_)&stg_ctoi_D1_info;
    1773 1965 
                 SpW(-1) = BCO_PTR(o_bco);
    1774 1966 
                 Sp_subW(2);
    1967 
    +
    1968 
    +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
    1775 1969 
     #if defined(PROFILING)
    1776 1970 
                 Sp_subW(2);
    1777 1971 
                 SpW(1) = (W_)cap->r.rCCCS;
    ... ... @@ -1785,6 +1979,8 @@ run_BCO:
    1785 1979 
                 SpW(-2) = (W_)&stg_ctoi_L1_info;
    1786 1980 
                 SpW(-1) = BCO_PTR(o_bco);
    1787 1981 
                 Sp_subW(2);
    1982 
    +
    1983 
    +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
    1788 1984 
     #if defined(PROFILING)
    1789 1985 
                 Sp_subW(2);
    1790 1986 
                 SpW(1) = (W_)cap->r.rCCCS;
    ... ... @@ -1798,6 +1994,8 @@ run_BCO:
    1798 1994 
                 SpW(-2) = (W_)&stg_ctoi_V_info;
    1799 1995 
                 SpW(-1) = BCO_PTR(o_bco);
    1800 1996 
                 Sp_subW(2);
    1997 
    +
    1998 
    +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
    1801 1999 
     #if defined(PROFILING)
    1802 2000 
                 Sp_subW(2);
    1803 2001 
                 SpW(1) = (W_)cap->r.rCCCS;
    ... ... @@ -1811,6 +2009,7 @@ run_BCO:
    1811 2009 
                 W_ tuple_info = (W_)BCO_LIT(BCO_GET_LARGE_ARG);
    1812 2010 
                 W_ o_tuple_bco = BCO_GET_LARGE_ARG;
    1813 2011
    2012 
    +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
    1814 2013 
     #if defined(PROFILING)
    1815 2014 
                 SpW(-1) = (W_)cap->r.rCCCS;
    1816 2015 
                 Sp_subW(1);
    ... ... @@ -1819,82 +2018,11 @@ run_BCO:
    1819 2018 
                 SpW(-1) = BCO_PTR(o_tuple_bco);
    1820 2019 
                 SpW(-2) = tuple_info;
    1821 2020 
                 SpW(-3) = BCO_PTR(o_bco);
    1822 
    -            W_ ctoi_t_offset;
    1823 2021 
                 int tuple_stack_words = (tuple_info >> 24) & 0xff;
    1824 
    -            switch(tuple_stack_words) {
    1825 
    -                case 0:  ctoi_t_offset = (W_)&stg_ctoi_t0_info;  break;
    1826 
    -                case 1:  ctoi_t_offset = (W_)&stg_ctoi_t1_info;  break;
    1827 
    -                case 2:  ctoi_t_offset = (W_)&stg_ctoi_t2_info;  break;
    1828 
    -                case 3:  ctoi_t_offset = (W_)&stg_ctoi_t3_info;  break;
    1829 
    -                case 4:  ctoi_t_offset = (W_)&stg_ctoi_t4_info;  break;
    1830 
    -                case 5:  ctoi_t_offset = (W_)&stg_ctoi_t5_info;  break;
    1831 
    -                case 6:  ctoi_t_offset = (W_)&stg_ctoi_t6_info;  break;
    1832 
    -                case 7:  ctoi_t_offset = (W_)&stg_ctoi_t7_info;  break;
    1833 
    -                case 8:  ctoi_t_offset = (W_)&stg_ctoi_t8_info;  break;
    1834 
    -                case 9:  ctoi_t_offset = (W_)&stg_ctoi_t9_info;  break;
    1835 
    -
    1836 
    -                case 10: ctoi_t_offset = (W_)&stg_ctoi_t10_info; break;
    1837 
    -                case 11: ctoi_t_offset = (W_)&stg_ctoi_t11_info; break;
    1838 
    -                case 12: ctoi_t_offset = (W_)&stg_ctoi_t12_info; break;
    1839 
    -                case 13: ctoi_t_offset = (W_)&stg_ctoi_t13_info; break;
    1840 
    -                case 14: ctoi_t_offset = (W_)&stg_ctoi_t14_info; break;
    1841 
    -                case 15: ctoi_t_offset = (W_)&stg_ctoi_t15_info; break;
    1842 
    -                case 16: ctoi_t_offset = (W_)&stg_ctoi_t16_info; break;
    1843 
    -                case 17: ctoi_t_offset = (W_)&stg_ctoi_t17_info; break;
    1844 
    -                case 18: ctoi_t_offset = (W_)&stg_ctoi_t18_info; break;
    1845 
    -                case 19: ctoi_t_offset = (W_)&stg_ctoi_t19_info; break;
    1846 
    -
    1847 
    -                case 20: ctoi_t_offset = (W_)&stg_ctoi_t20_info; break;
    1848 
    -                case 21: ctoi_t_offset = (W_)&stg_ctoi_t21_info; break;
    1849 
    -                case 22: ctoi_t_offset = (W_)&stg_ctoi_t22_info; break;
    1850 
    -                case 23: ctoi_t_offset = (W_)&stg_ctoi_t23_info; break;
    1851 
    -                case 24: ctoi_t_offset = (W_)&stg_ctoi_t24_info; break;
    1852 
    -                case 25: ctoi_t_offset = (W_)&stg_ctoi_t25_info; break;
    1853 
    -                case 26: ctoi_t_offset = (W_)&stg_ctoi_t26_info; break;
    1854 
    -                case 27: ctoi_t_offset = (W_)&stg_ctoi_t27_info; break;
    1855 
    -                case 28: ctoi_t_offset = (W_)&stg_ctoi_t28_info; break;
    1856 
    -                case 29: ctoi_t_offset = (W_)&stg_ctoi_t29_info; break;
    1857 
    -
    1858 
    -                case 30: ctoi_t_offset = (W_)&stg_ctoi_t30_info; break;
    1859 
    -                case 31: ctoi_t_offset = (W_)&stg_ctoi_t31_info; break;
    1860 
    -                case 32: ctoi_t_offset = (W_)&stg_ctoi_t32_info; break;
    1861 
    -                case 33: ctoi_t_offset = (W_)&stg_ctoi_t33_info; break;
    1862 
    -                case 34: ctoi_t_offset = (W_)&stg_ctoi_t34_info; break;
    1863 
    -                case 35: ctoi_t_offset = (W_)&stg_ctoi_t35_info; break;
    1864 
    -                case 36: ctoi_t_offset = (W_)&stg_ctoi_t36_info; break;
    1865 
    -                case 37: ctoi_t_offset = (W_)&stg_ctoi_t37_info; break;
    1866 
    -                case 38: ctoi_t_offset = (W_)&stg_ctoi_t38_info; break;
    1867 
    -                case 39: ctoi_t_offset = (W_)&stg_ctoi_t39_info; break;
    1868 
    -
    1869 
    -                case 40: ctoi_t_offset = (W_)&stg_ctoi_t40_info; break;
    1870 
    -                case 41: ctoi_t_offset = (W_)&stg_ctoi_t41_info; break;
    1871 
    -                case 42: ctoi_t_offset = (W_)&stg_ctoi_t42_info; break;
    1872 
    -                case 43: ctoi_t_offset = (W_)&stg_ctoi_t43_info; break;
    1873 
    -                case 44: ctoi_t_offset = (W_)&stg_ctoi_t44_info; break;
    1874 
    -                case 45: ctoi_t_offset = (W_)&stg_ctoi_t45_info; break;
    1875 
    -                case 46: ctoi_t_offset = (W_)&stg_ctoi_t46_info; break;
    1876 
    -                case 47: ctoi_t_offset = (W_)&stg_ctoi_t47_info; break;
    1877 
    -                case 48: ctoi_t_offset = (W_)&stg_ctoi_t48_info; break;
    1878 
    -                case 49: ctoi_t_offset = (W_)&stg_ctoi_t49_info; break;
    1879 
    -
    1880 
    -                case 50: ctoi_t_offset = (W_)&stg_ctoi_t50_info; break;
    1881 
    -                case 51: ctoi_t_offset = (W_)&stg_ctoi_t51_info; break;
    1882 
    -                case 52: ctoi_t_offset = (W_)&stg_ctoi_t52_info; break;
    1883 
    -                case 53: ctoi_t_offset = (W_)&stg_ctoi_t53_info; break;
    1884 
    -                case 54: ctoi_t_offset = (W_)&stg_ctoi_t54_info; break;
    1885 
    -                case 55: ctoi_t_offset = (W_)&stg_ctoi_t55_info; break;
    1886 
    -                case 56: ctoi_t_offset = (W_)&stg_ctoi_t56_info; break;
    1887 
    -                case 57: ctoi_t_offset = (W_)&stg_ctoi_t57_info; break;
    1888 
    -                case 58: ctoi_t_offset = (W_)&stg_ctoi_t58_info; break;
    1889 
    -                case 59: ctoi_t_offset = (W_)&stg_ctoi_t59_info; break;
    1890 
    -
    1891 
    -                case 60: ctoi_t_offset = (W_)&stg_ctoi_t60_info; break;
    1892 
    -                case 61: ctoi_t_offset = (W_)&stg_ctoi_t61_info; break;
    1893 
    -                case 62: ctoi_t_offset = (W_)&stg_ctoi_t62_info; break;
    1894 
    -
    1895 
    -                default: barf("unsupported tuple size %d", tuple_stack_words);
    2022 
    +            if (tuple_stack_words > 62) {
    2023 
    +                barf("unsupported tuple size %d", tuple_stack_words);
    1896 2024 
                 }
    1897 
    -
    2025 
    +            W_ ctoi_t_offset = (W_) ctoi_tuple_infos[tuple_stack_words];
    1898 2026 
                 SpW(-4) = ctoi_t_offset;
    1899 2027 
                 Sp_subW(4);
    1900 2028 
                 goto nextInsn;
    ... ... @@ -1987,15 +2115,7 @@ run_BCO:
    1987 2115 
             case bci_SLIDE: {
    1988 2116 
                 W_ n  = BCO_GET_LARGE_ARG;
    1989 2117 
                 W_ by = BCO_GET_LARGE_ARG;
    1990 
    -            /*
    1991 
    -             * a_1 ... a_n, b_1 ... b_by, k
    1992 
    -             *           =>
    1993 
    -             * a_1 ... a_n, k
    1994 
    -             */
    1995 
    -            while(n-- > 0) {
    1996 
    -                SpW(n+by) = ReadSpW(n);
    1997 
    -            }
    1998 
    -            Sp_addW(by);
    2118 
    +            SpSlide(n, by);
    1999 2119 
                 INTERP_TICK(it_slides);
    2000 2120 
                 goto nextInsn;
    2001 2121 
             }

  • testsuite/tests/count-deps/CountDepsAst.stdout
    ... ... @@ -5,14 +5,9 @@ GHC.Builtin.Types
    5 5 
     GHC.Builtin.Types.Literals
    6 6 
     GHC.Builtin.Types.Prim
    7 7 
     GHC.Builtin.Uniques
    8 
    -GHC.ByteCode.Breakpoints
    9 
    -GHC.ByteCode.Types
    10 8 
     GHC.Cmm.BlockId
    11 9 
     GHC.Cmm.CLabel
    12 10 
     GHC.Cmm.Dataflow.Label
    13 
    -GHC.Cmm.Expr
    14 
    -GHC.Cmm.MachOp
    15 
    -GHC.Cmm.Reg
    16 11 
     GHC.Cmm.Type
    17 12 
     GHC.CmmToAsm.CFG.Weight
    18 13 
     GHC.Core
    ... ... @@ -65,7 +60,6 @@ GHC.Data.FastMutInt
    65 60 
     GHC.Data.FastString
    66 61 
     GHC.Data.FastString.Env
    67 62 
     GHC.Data.FiniteMap
    68 
    -GHC.Data.FlatBag
    69 63 
     GHC.Data.Graph.Directed
    70 64 
     GHC.Data.Graph.Directed.Internal
    71 65 
     GHC.Data.Graph.UnVar
    ... ... @@ -77,7 +71,6 @@ GHC.Data.Maybe
    77 71 
     GHC.Data.OrdList
    78 72 
     GHC.Data.OsPath
    79 73 
     GHC.Data.Pair
    80 
    -GHC.Data.SmallArray
    81 74 
     GHC.Data.Strict
    82 75 
     GHC.Data.StringBuffer
    83 76 
     GHC.Data.TrieMap
    ... ... @@ -111,8 +104,6 @@ GHC.Hs.Pat
    111 104 
     GHC.Hs.Specificity
    112 105 
     GHC.Hs.Type
    113 106 
     GHC.Hs.Utils
    114 
    -GHC.HsToCore.Breakpoints
    115 
    -GHC.HsToCore.Ticks
    116 107 
     GHC.Iface.Errors.Types
    117 108 
     GHC.Iface.Ext.Fields
    118 109 
     GHC.Iface.Flags
    ... ... @@ -182,7 +173,6 @@ GHC.Types.RepType
    182 173 
     GHC.Types.SafeHaskell
    183 174 
     GHC.Types.SourceFile
    184 175 
     GHC.Types.SourceText
    185 
    -GHC.Types.SptEntry
    186 176 
     GHC.Types.SrcLoc
    187 177 
     GHC.Types.ThLevelIndex
    188 178 
     GHC.Types.Tickish

  • testsuite/tests/count-deps/CountDepsParser.stdout
    ... ... @@ -5,14 +5,9 @@ GHC.Builtin.Types
    5 5 
     GHC.Builtin.Types.Literals
    6 6 
     GHC.Builtin.Types.Prim
    7 7 
     GHC.Builtin.Uniques
    8 
    -GHC.ByteCode.Breakpoints
    9 
    -GHC.ByteCode.Types
    10 8 
     GHC.Cmm.BlockId
    11 9 
     GHC.Cmm.CLabel
    12 10 
     GHC.Cmm.Dataflow.Label
    13 
    -GHC.Cmm.Expr
    14 
    -GHC.Cmm.MachOp
    15 
    -GHC.Cmm.Reg
    16 11 
     GHC.Cmm.Type
    17 12 
     GHC.CmmToAsm.CFG.Weight
    18 13 
     GHC.Core
    ... ... @@ -66,7 +61,6 @@ GHC.Data.FastMutInt
    66 61 
     GHC.Data.FastString
    67 62 
     GHC.Data.FastString.Env
    68 63 
     GHC.Data.FiniteMap
    69 
    -GHC.Data.FlatBag
    70 64 
     GHC.Data.Graph.Directed
    71 65 
     GHC.Data.Graph.Directed.Internal
    72 66 
     GHC.Data.Graph.Directed.Reachability
    ... ... @@ -79,7 +73,6 @@ GHC.Data.Maybe
    79 73 
     GHC.Data.OrdList
    80 74 
     GHC.Data.OsPath
    81 75 
     GHC.Data.Pair
    82 
    -GHC.Data.SmallArray
    83 76 
     GHC.Data.Strict
    84 77 
     GHC.Data.StringBuffer
    85 78 
     GHC.Data.TrieMap
    ... ... @@ -115,10 +108,8 @@ GHC.Hs.Pat
    115 108 
     GHC.Hs.Specificity
    116 109 
     GHC.Hs.Type
    117 110 
     GHC.Hs.Utils
    118 
    -GHC.HsToCore.Breakpoints
    119 111 
     GHC.HsToCore.Errors.Types
    120 112 
     GHC.HsToCore.Pmc.Solver.Types
    121 
    -GHC.HsToCore.Ticks
    122 113 
     GHC.Iface.Errors.Types
    123 114 
     GHC.Iface.Ext.Fields
    124 115 
     GHC.Iface.Flags
    ... ... @@ -205,7 +196,6 @@ GHC.Types.RepType
    205 196 
     GHC.Types.SafeHaskell
    206 197 
     GHC.Types.SourceFile
    207 198 
     GHC.Types.SourceText
    208 
    -GHC.Types.SptEntry
    209 199 
     GHC.Types.SrcLoc
    210 200 
     GHC.Types.Target
    211 201 
     GHC.Types.ThLevelIndex

  • testsuite/tests/ghci.debugger/scripts/all.T
    ... ... @@ -147,7 +147,7 @@ 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 152 
     test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
    153 153 
     test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop

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