GitLab

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

Commits:

01d3154e
by Wen Kokke at 2025-07-10T17:06:36+01:00
```
Fix documentation for HEAP_PROF_SAMPLE_STRING
```

ac259c48

by Wen Kokke at 2025-07-10T17:06:38+01:00

Fix documentation for HEAP_PROF_SAMPLE_COST_CENTRE

2b4db9ba
by Pi Delport at 2025-07-11T16:40:52-04:00
```
(Applicative docs typo: missing "one")
```

b56d108c

by Rodrigo Mesquita at 2025-07-16T10:32:32+01:00

build: Relax ghc/ghc-boot Cabal bound to 3.16

Fixes #26202

bd2949c6

by Rodrigo Mesquita at 2025-07-16T10:32:47+01:00

cabal-reinstall: Use haddock-api +in-tree-ghc

Fixes #26202

d19e3e4a

by Rodrigo Mesquita at 2025-07-16T10:32:50+01:00

cabal-reinstall: Pass --strict to Happy

This is necessary to make the generated Parser build successfully
This mimics Hadrian, which always passes --strict to happy.

Fixes #26202

4da0a66b

by Rodrigo Mesquita at 2025-07-17T09:44:05+01:00

debugger: Uniquely identify breakpoints by internal id

Since b85b11994e0130ff2401dd4bbdf52330e0bcf776 (support inlining
breakpoints), a breakpoint has been identified at runtime by *two* pairs
of <module,index>.

- The first, aka a 'BreakpointId', uniquely identifies a breakpoint in
  the source of a module by using the Tick index. A Tick index can index
  into ModBreaks.modBreaks_xxx to fetch source-level information about
  where that tick originated.

    - When a user specifies e.g. a line breakpoint using :break, we'll reverse
      engineer what a Tick index for that line
    - We update the `BreakArray` of that module (got from the
      LoaderState) at that tick index to `breakOn`.
    - A BCO we can stop at is headed by a BRK_FUN instruction. This
      instruction stores in an operand the `tick index` it is associated
      to. We look it up in the associated `BreakArray` (also an operand)
      and check wheter it was set to `breakOn`.

- The second, aka the `ibi_info_mod` + `ibi_info_ix` of the
  `InternalBreakpointId`, uniquely index into the `imodBreaks_breakInfo`
  -- the information we gathered during code generation about the
  existing breakpoint *ocurrences*.

  - Note that with optimisation there may be many occurrences of the
    same source-tick-breakpoint across different modules. The
    `ibi_info_ix` is unique per occurrence, but the `bi_tick_ix` may be
    shared. See Note [Breakpoint identifiers] about this.

  - Note that besides the tick ids, info ids are also stored in
    `BRK_FUN` so the break handler can refer to the associated
    `CgBreakInfo`.

In light of that, the driving changes come from the desire to have the
info_id uniquely identify the breakpoint at runtime, and the source tick
id being derived from it:

- An InternalBreakpointId should uniquely identify a breakpoint just
  from the code-generation identifiers of `ibi_info_ix` and `ibi_info_mod`.
  So we drop `ibi_tick_mod` and `ibi_tick_ix`.
- A BRK_FUN instruction need only record the "internal breakpoint id",
  not the tick-level id.
  So we drop the tick mod and tick index operands.
- A BreakArray should be indexed by InternalBreakpointId rather than
  BreakpointId

That means we need to do some more work when setting a breakpoint.
Specifically, we need to figure out the internal ids (occurrences of a
breakpoint) from the source-level BreakpointId we want to set the
breakpoint at (recall :break refers to breaks at the source level).

Besides this change being an improvement to the handling of breakpoints
(it's clearer to have a single unique identifier than two competing
ones), it unlocks the possibility of generating "internal" breakpoints
during Cg (needed for #26042).
It should also be easier to introduce multi-threaded-aware `BreakArrays`
following this change (needed for #26064).

Se also the new Note [ModBreaks vs InternalModBreaks]

d1439072

by Rodrigo Mesquita at 2025-07-17T09:44:06+01:00

cleanup: Move dehydrateCgBreakInfo to Stg2Bc

This no longer has anything to do with Core.

9e37cf61

by Ben Gamari at 2025-07-17T09:44:06+01:00

rts/Interpreter: Factor out ctoi tuple info tables into data

Instead of a massive case let's put this into data which we can reuse
elsewhere.

eab05af0
by Rodrigo Mesquita at 2025-07-17T09:44:06+01:00
```
rts/Disassembler: Fix spacing of BRK_FUN
```

2692e656

by Rodrigo Mesquita at 2025-07-18T18:28:49+01:00

Makes sure run_BCO has variables directly on top of the stack

Instead we kept ctoi_ret frames when entering run_BCO, and the ByteCode
generator accounted for the frame header and then slided it off.

Now, when run_BCO is called for a case continuation, the return value
and free variables are directly on top.

02e468b0

by Rodrigo Mesquita at 2025-07-18T18:29:12+01:00

Working on making BRK_FUNs for case cont. BCO [skip ci]

28 changed files:

cabal.project-reinstall
compiler/GHC/ByteCode/Asm.hs
compiler/GHC/ByteCode/Breakpoints.hs
compiler/GHC/ByteCode/Instr.hs
compiler/GHC/ByteCode/Linker.hs
compiler/GHC/ByteCode/Types.hs
compiler/GHC/CoreToIface.hs
compiler/GHC/HsToCore/Breakpoints.hs
compiler/GHC/Linker/Loader.hs
compiler/GHC/Runtime/Debugger/Breakpoints.hs
compiler/GHC/Runtime/Eval.hs
compiler/GHC/Runtime/Interpreter.hs
compiler/GHC/StgToByteCode.hs
compiler/Setup.hs
compiler/ghc.cabal.in
docs/users_guide/eventlog-formats.rst
ghc/GHCi/UI.hs
ghc/GHCi/UI/Monad.hs
libraries/ghc-boot/Setup.hs
libraries/ghc-boot/ghc-boot.cabal.in
libraries/ghc-internal/src/GHC/Internal/Base.hs
libraries/ghci/GHCi/Debugger.hs
libraries/ghci/GHCi/Message.hs
libraries/ghci/GHCi/Run.hs
rts/Disassembler.c
rts/Exception.cmm
rts/Interpreter.c
testsuite/tests/ghci.debugger/scripts/all.T

Changes:

cabal.project-reinstall

@@ -59,6 +59,7 @@ constraints: ghc +internal-interpreter +dynamic-system-linke,
               ghc-bin +internal-interpreter +threaded,
               ghci +internal-interpreter,
               haddock +in-ghc-tree,
 +             haddock-api +in-ghc-tree,
               any.array installed,
               any.base installed,
               any.deepseq installed,
@@ -69,6 +70,9 @@ constraints: ghc +internal-interpreter +dynamic-system-linke,
               any.template-haskell installed
 +package *
 +    happy-options: --strict
++
  benchmarks: False
  tests: False
  allow-boot-library-installs: True

compiler/GHC/ByteCode/Asm.hs

@@ -841,24 +841,18 @@ assembleI platform i = case i of
      W8                   -> emit_ bci_OP_INDEX_ADDR_08 []
      _                    -> unsupported_width
 -  BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox) -> do
 +  BRK_FUN ibi@(InternalBreakpointId info_mod infox) byteOff -> do
 +    p1 <- ptr $ BCOPtrBreakArray info_mod
      let -- cast that checks that round-tripping through Word16 doesn't change the value
          toW16 x = let r = fromIntegral x :: Word16
                    in if fromIntegral r == x
                      then r
                      else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
 -    p1 <- ptr $ BCOPtrBreakArray tick_mod
 -    tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
 -    info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
 -    tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
 -    info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
 -    np <- lit1 $ BCONPtrCostCentre (BreakpointId tick_mod tickx)
 -    emit_ bci_BRK_FUN [ Op p1
 -                     , Op tick_addr, Op info_addr
 -                     , Op tick_unitid_addr, Op info_unitid_addr
 -                     , SmallOp (toW16 tickx), SmallOp (toW16 infox)
 -                     , Op np
 -                     ]
 +    info_addr        <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
 +    info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS     $ moduleUnitId info_mod
 +    np               <- lit1 $ BCONPtrCostCentre ibi
 +    emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
 +                      , SmallOp (toW16 infox), SmallOp (toW16 byteOff), Op np ]
    BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)]

compiler/GHC/ByteCode/Breakpoints.hs

  {-# LANGUAGE RecordWildCards #-}
 +{-# LANGUAGE DerivingStrategies #-}
  -- | Breakpoint information constructed during ByteCode generation.
  --
@@ -7,23 +8,24 @@
  -- 'InternalModBreaks', and is uniquely identified at runtime by an
  -- 'InternalBreakpointId'.
  --
 --- See Note [Breakpoint identifiers]
 +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
  module GHC.ByteCode.Breakpoints
    ( -- * Internal Mod Breaks
      InternalModBreaks(..), CgBreakInfo(..)
 -  , mkInternalModBreaks
 +  , mkInternalModBreaks, imodBreaks_module
      -- ** Internal breakpoint identifier
    , InternalBreakpointId(..), BreakInfoIndex
 +  , InternalBreakLoc(..)
      -- * Operations
 -  , toBreakpointId
      -- ** Internal-level operations
 -  , getInternalBreak, addInternalBreak
 +  , getInternalBreak
      -- ** Source-level information operations
    , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
 +  , getBreakSourceId, getBreakSourceMod
      -- * Utils
    , seqInternalModBreaks
@@ -47,6 +49,31 @@ import GHC.Utils.Panic
  import Data.Array
  {-
 +Note [ModBreaks vs InternalModBreaks]
 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 +'ModBreaks' and 'BreakpointId's must not to be confused with
 +'InternalModBreaks' and 'InternalBreakId's.
++
 +'ModBreaks' is constructed once during HsToCore from the information attached
 +to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
 +can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
 +within the list of breakpoint information for a given module's 'ModBreaks'.
++
 +'InternalModBreaks' are constructed during bytecode generation and are indexed
 +by a 'InternalBreakpointId'. They contain all the information relevant to a
 +breakpoint for code generation that can be accessed during runtime execution
 +(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
 +are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
 +instruction receives 'InternalBreakpointId' as an argument.
++
 +We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
 +to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
++
 +Notably, 'InternalModBreaks' can contain entries for so-called internal
 +breakpoints, which do not necessarily have a source-level location attached to
 +it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
 +introduce breakpoints during code generation for features such as stepping-out.
++
  Note [Breakpoint identifiers]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Before optimization a breakpoint is identified uniquely with a tick module
@@ -64,6 +91,10 @@ So every breakpoint occurrence gets assigned a module-unique *info index* and
  we store it alongside the occurrence module (*info module*) in the
  'InternalBreakpointId' datatype. This is the index that we use at runtime to
  identify a breakpoint.
++
 +When the internal breakpoint has a matching tick-level breakpoint we can fetch
 +the related tick-level information by first looking up a mapping
 +@'InternalBreakpointId' -> 'BreakpointId'@ in @'CgBreakInfo'@.
  -}
  --------------------------------------------------------------------------------
@@ -78,19 +109,11 @@ type BreakInfoIndex = Int
  -- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
  -- See Note [Breakpoint identifiers]
  data InternalBreakpointId = InternalBreakpointId
 -  { ibi_tick_mod   :: !Module         -- ^ Breakpoint tick module
 -  , ibi_tick_index :: !Int            -- ^ Breakpoint tick index
 -  , ibi_info_mod   :: !Module         -- ^ Breakpoint tick module
 +  { ibi_info_mod   :: !Module         -- ^ Breakpoint tick module
    , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
+   }
    deriving (Eq, Ord)
 -toBreakpointId :: InternalBreakpointId -> BreakpointId
 -toBreakpointId ibi = BreakpointId
 -  { bi_tick_mod   = ibi_tick_mod ibi
 -  , bi_tick_index = ibi_tick_index ibi
 -  }
+-
  --------------------------------------------------------------------------------
  -- * Internal Mod Breaks
  --------------------------------------------------------------------------------
@@ -107,18 +130,34 @@ data InternalModBreaks = InternalModBreaks
          -- 'InternalBreakpointId'.
        , imodBreaks_modBreaks :: !ModBreaks
 -        -- ^ Store the original ModBreaks for this module, unchanged.
 -        -- Allows us to query about source-level breakpoint information using
 -        -- an internal breakpoint id.
 +        -- ^ Store the ModBreaks for this module
 +        --
 +        -- Recall Note [Breakpoint identifiers]: for some module A, an
 +        -- *occurrence* of a breakpoint in A may have been inlined from some
 +        -- breakpoint *defined* in module B.
 +        --
 +        -- This 'ModBreaks' contains information regarding all the breakpoints
 +        -- defined in the module this 'InternalModBreaks' corresponds to. It
 +        -- /does not/ necessarily have information regarding all the breakpoint
 +        -- occurrences registered in 'imodBreaks_breakInfo'. Some of those
 +        -- occurrences may refer breakpoints inlined from other modules.
+       }
 --- | Construct an 'InternalModBreaks'
 +-- | Construct an 'InternalModBreaks'.
 +--
 +-- INVARIANT: The given 'ModBreaks' correspond to the same module as this
 +-- 'InternalModBreaks' module (the first argument) and its breakpoint infos
 +-- (the @IntMap CgBreakInfo@ argument)
  mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
  mkInternalModBreaks mod im mbs =
    assertPpr (mod == modBreaks_module mbs)
      (text "Constructing InternalModBreaks with the ModBreaks of a different module!") $
        InternalModBreaks im mbs
 +-- | Get the module to which these 'InternalModBreaks' correspond
 +imodBreaks_module :: InternalModBreaks -> Module
 +imodBreaks_module = modBreaks_module . imodBreaks_modBreaks
++
  -- | Information about a breakpoint that we know at code-generation time
  -- In order to be used, this needs to be hydrated relative to the current HscEnv by
  -- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
@@ -128,20 +167,32 @@ data CgBreakInfo
     { cgb_tyvars  :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
     , cgb_vars    :: ![Maybe (IfaceIdBndr, Word)]
     , cgb_resty   :: !IfaceType
 +   , cgb_tick_id :: !(Either InternalBreakLoc BreakpointId)
 +     -- ^ This field records the original breakpoint tick identifier for this
 +     -- internal breakpoint info. It is used to convert a breakpoint
 +     -- *occurrence* index ('InternalBreakpointId') into a *definition* index
 +     -- ('BreakpointId').
 +     --
 +     -- The modules of breakpoint occurrence and breakpoint definition are not
 +     -- necessarily the same: See Note [Breakpoint identifiers].
 +     --
 +     -- If there is no original tick identifier (that is, the breakpoint was
 +     -- created during code generation), instead refer directly to the SrcSpan
 +     -- we want to use for it. See Note [Internal Breakpoint Locations]
+    }
  -- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
 +-- | Breakpoints created during code generation don't have a source-level tick
 +-- location. Instead, we come up with one ourselves.
 +-- See Note [Internal Breakpoint Locations]
 +newtype InternalBreakLoc = InternalBreakLoc SrcSpan
 +  deriving newtype (Eq, Show, NFData, Outputable)
++
  -- | Get an internal breakpoint info by 'InternalBreakpointId'
  getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
 -getInternalBreak (InternalBreakpointId _ _ info_mod info_ix) imbs =
 -  assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
 -    imodBreaks_breakInfo imbs IM.! info_ix
+-
 --- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
 -addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
 -addInternalBreak (InternalBreakpointId _ _ info_mod info_ix) info imbs =
 -  assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
 -    imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)}
 +getInternalBreak (InternalBreakpointId mod ix) imbs =
 +  assert_modules_match mod (imodBreaks_module imbs) $
 +    imodBreaks_breakInfo imbs IM.! ix
  -- | Assert that the module in the 'InternalBreakpointId' and in
  -- 'InternalModBreaks' match.
@@ -155,27 +206,70 @@ assert_modules_match ibi_mod imbs_mod =
  -- Tick-level Breakpoint information
  --------------------------------------------------------------------------------
 +-- | Get the source module and tick index for this breakpoint
 +-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
 +getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> Either InternalBreakLoc BreakpointId
 +getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
 +  assert_modules_match ibi_mod (imodBreaks_module imbs) $
 +    let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
 +     in cgb_tick_id cgb
++
 +-- | Get the source module for this breakpoint (where the breakpoint is defined)
 +getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module
 +getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs =
 +  assert_modules_match ibi_mod (imodBreaks_module imbs) $
 +    let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
 +     in case cgb_tick_id cgb of
 +      Left InternalBreakLoc{} -> imodBreaks_module imbs
 +      Right BreakpointId{bi_tick_mod} -> bi_tick_mod
++
  -- | Get the source span for this breakpoint
 -getBreakLoc  :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
 -getBreakLoc = getBreakXXX modBreaks_locs
 +getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
 +getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
  -- | Get the vars for this breakpoint
 -getBreakVars  :: InternalBreakpointId -> InternalModBreaks -> [OccName]
 -getBreakVars = getBreakXXX modBreaks_vars
 +getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
 +getBreakVars = getBreakXXX modBreaks_vars (const [])
  -- | Get the decls for this breakpoint
 -getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
 -getBreakDecls = getBreakXXX modBreaks_decls
 +getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
 +getBreakDecls = getBreakXXX modBreaks_decls (const [])
  -- | Get the decls for this breakpoint
 -getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
 -getBreakCCS = getBreakXXX modBreaks_ccs
 +getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
 +getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
  -- | Internal utility to access a ModBreaks field at a particular breakpoint index
 -getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a
 -getBreakXXX view (InternalBreakpointId tick_mod tick_id _ _) imbs =
 -  assert_modules_match tick_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ do
 -    view (imodBreaks_modBreaks imbs) ! tick_id
 +--
 +-- Recall Note [Breakpoint identifiers]: the internal breakpoint module (the
 +-- *occurrence* module) doesn't necessarily match the module where the
 +-- tick breakpoint was defined with the relevant 'ModBreaks'.
 +--
 +-- When the tick module is the same as the internal module, we use the stored
 +-- 'ModBreaks'. When the tick module is different, we need to look up the
 +-- 'ModBreaks' in the HUG for that other module.
 +--
 +-- When there is no tick module (the breakpoint was generated at codegen), use
 +-- the function on internal mod breaks.
 +--
 +-- To avoid cyclic dependencies, we instead receive a function that looks up
 +-- the 'ModBreaks' given a 'Module'
 +getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
 +getBreakXXX view viewInternal lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
 +  assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
 +    let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
 +    case cgb_tick_id cgb of
 +      Right BreakpointId{bi_tick_mod, bi_tick_index}
 +        | bi_tick_mod == ibi_mod
 +        -> do
 +          let these_mbs = imodBreaks_modBreaks imbs
 +          return $ view these_mbs ! bi_tick_index
 +        | otherwise
 +        -> do
 +          other_mbs <- lookupModule bi_tick_mod
 +          return $ view other_mbs ! bi_tick_index
 +      Left l ->
 +          return $ viewInternal l
  --------------------------------------------------------------------------------
  -- Instances
@@ -190,7 +284,8 @@ seqInternalModBreaks InternalModBreaks{..} =
      seqCgBreakInfo CgBreakInfo{..} =
          rnf cgb_tyvars `seq`
          rnf cgb_vars `seq`
 -        rnf cgb_resty
 +        rnf cgb_resty `seq`
 +        rnf cgb_tick_id
  instance Outputable InternalBreakpointId where
    ppr InternalBreakpointId{..} =
@@ -203,4 +298,5 @@ instance NFData InternalBreakpointId where
  instance Outputable CgBreakInfo where
     ppr info = text "CgBreakInfo" <+>
                parens (ppr (cgb_vars info) <+>
 -                      ppr (cgb_resty info))
 +                      ppr (cgb_resty info) <+>
 +                      ppr (cgb_tick_id info))

compiler/GHC/ByteCode/Instr.hs

@@ -258,7 +258,7 @@ data BCInstr
                     -- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode
     -- Breakpoints
 -   | BRK_FUN          !InternalBreakpointId
 +   | BRK_FUN          !InternalBreakpointId !ByteOff
     -- An internal breakpoint for triggering a break on any case alternative
     -- See Note [Debugger: BRK_ALTS]
@@ -454,10 +454,10 @@ instance Outputable BCInstr where
     ppr ENTER                 = text "ENTER"
     ppr (RETURN pk)           = text "RETURN  " <+> ppr pk
     ppr (RETURN_TUPLE)        = text "RETURN_TUPLE"
 -   ppr (BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox))
 +   ppr (BRK_FUN (InternalBreakpointId info_mod infox) bo)
                               = text "BRK_FUN" <+> text "<breakarray>"
 -                               <+> ppr tick_mod <+> ppr tickx
                                 <+> ppr info_mod <+> ppr infox
 +                               <+> ppr bo
                                 <+> text "<cc>"
     ppr (BRK_ALTS active)     = text "BRK_ALTS" <+> ppr active
  #if MIN_VERSION_rts(1,0,3)

compiler/GHC/ByteCode/Linker.hs

@@ -98,9 +98,9 @@ lookupLiteral interp pkgs_loaded le lb ptr = case ptr of
    BCONPtrFFIInfo (FFIInfo {..}) -> do
      RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
      pure $ fromIntegral p
 -  BCONPtrCostCentre BreakpointId{..}
 +  BCONPtrCostCentre InternalBreakpointId{..}
      | interpreterProfiled interp -> do
 -        case expectJust (lookupModuleEnv (ccs_env lb) bi_tick_mod) ! bi_tick_index of
 +        case expectJust (lookupModuleEnv (ccs_env lb) ibi_info_mod) ! ibi_info_index of
            RemotePtr p -> pure $ fromIntegral p
      | otherwise ->
          case toRemotePtr nullPtr of

compiler/GHC/ByteCode/Types.hs

@@ -285,7 +285,7 @@ data BCONPtr
    -- | A libffi ffi_cif function prototype.
    | BCONPtrFFIInfo !FFIInfo
    -- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
 -  | BCONPtrCostCentre !BreakpointId
 +  | BCONPtrCostCentre !InternalBreakpointId
  instance NFData BCONPtr where
    rnf x = x `seq` ()

compiler/GHC/CoreToIface.hs

@@ -44,16 +44,12 @@ module GHC.CoreToIface
        -- * Other stuff
      , toIfaceLFInfo
      , toIfaceBooleanFormula
 -      -- * CgBreakInfo
 -    , dehydrateCgBreakInfo
      ) where
  import GHC.Prelude
  import GHC.StgToCmm.Types
 -import GHC.ByteCode.Types
+-
  import GHC.Core
  import GHC.Core.TyCon hiding ( pprPromotionQuote )
  import GHC.Core.Coercion.Axiom
@@ -702,15 +698,6 @@ toIfaceLFInfo nm lfi = case lfi of
      LFLetNoEscape ->
        panic "toIfaceLFInfo: LFLetNoEscape"
 --- Dehydrating CgBreakInfo
+-
 -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
 -dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
 -          CgBreakInfo
 -            { cgb_tyvars = map toIfaceTvBndr ty_vars
 -            , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
 -            , cgb_resty = toIfaceType tick_ty
 -            }
  {- Note [Inlining and hs-boot files]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

compiler/GHC/HsToCore/Breakpoints.hs

@@ -12,7 +12,7 @@
  -- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
  -- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
  --
 --- See Note [Breakpoint identifiers]
 +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
  module GHC.HsToCore.Breakpoints
    ( -- * ModBreaks
      mkModBreaks, ModBreaks(..)

compiler/GHC/Linker/Loader.hs

@@ -58,6 +58,7 @@ import GHCi.RemoteTypes
  import GHC.Iface.Load
  import GHCi.Message (ConInfoTable(..), LoadedDLL)
 +import GHC.ByteCode.Breakpoints
  import GHC.ByteCode.Linker
  import GHC.ByteCode.Asm
  import GHC.ByteCode.Types
@@ -124,7 +125,9 @@ import GHC.Utils.Exception
  import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey)
  import GHC.Driver.Downsweep
  import qualified GHC.Runtime.Interpreter as GHCi
 -import Data.Array.Base (numElements)
 +import qualified Data.IntMap.Strict as IM
 +import qualified Data.Map.Strict as M
 +import Foreign.Ptr (nullPtr)
  -- Note [Linkers and loaders]
  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1666,10 +1669,10 @@ allocateBreakArrays ::
    IO (ModuleEnv (ForeignRef BreakArray))
  allocateBreakArrays interp =
    foldlM
 -    ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
 +    ( \be0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks {..}} -> do
          -- If no BreakArray is assigned to this module yet, create one
          if not $ elemModuleEnv modBreaks_module be0 then do
 -          let count = numElements modBreaks_locs
 +          let count = 1 + (maybe 0 fst $ IM.lookupMax imodBreaks_breakInfo)
            breakArray <- GHCi.newBreakArray interp count
            evaluate $ extendModuleEnv be0 modBreaks_module breakArray
          else
@@ -1679,29 +1682,53 @@ allocateBreakArrays interp =
  -- | Given a list of 'InternalModBreaks' collected from a list
  -- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
  -- enabled.
 +--
 +-- Note that the resulting arrays are indexed by 'BreakInfoIndex' (internal
 +-- breakpoint index), not by tick index
  allocateCCS ::
    Interp ->
 -  ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
 +  ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)) ->
    [InternalModBreaks] ->
 -  IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
 +  IO (ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)))
  allocateCCS interp ce mbss
 -  | interpreterProfiled interp =
 -      foldlM
 -        ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
 -            ccs <-
 +  | interpreterProfiled interp = do
 +      -- 1. Create a mapping from source BreakpointId to CostCentre ptr
 +      ccss <- M.unions <$> mapM
 +        ( \InternalModBreaks{imodBreaks_modBreaks=ModBreaks{..}} -> do
 +            ccs <- {- one ccs ptr per tick index -}
                mkCostCentres
                  interp
                  (moduleNameString $ moduleName modBreaks_module)
                  (elems modBreaks_ccs)
 -            if not $ elemModuleEnv modBreaks_module ce0 then do
 -              evaluate $
 -                extendModuleEnv ce0 modBreaks_module $
 -                  listArray
 -                    (0, length ccs - 1)
 -                    ccs
 +            return $ M.fromList $
 +              zipWith (\el ix -> (BreakpointId modBreaks_module ix, el)) ccs [0..]
 +        )
 +        mbss
 +      -- 2. Create an array with one element for every InternalBreakpointId,
 +      --    where every element has the CCS for the corresponding BreakpointId
 +      foldlM
 +        (\ce0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks{..}} -> do
 +            if not $ elemModuleEnv modBreaks_module ce then do
 +              let count = 1 + (maybe 0 fst $ IM.lookupMax imodBreaks_breakInfo)
 +              let ccs = IM.map
 +                    (\info ->
 +                      case cgb_tick_id info of
 +                        Right bi -> fromMaybe (toRemotePtr nullPtr)
 +                          (M.lookup bi ccss)
 +                        Left InternalBreakLoc{} -> toRemotePtr nullPtr
 +                    )
 +                    imodBreaks_breakInfo
 +              assertPpr (count == length ccs)
 +                (text "expected CgBreakInfo map to have one entry per valid ix") $
 +                evaluate $
 +                  extendModuleEnv ce0 modBreaks_module $
 +                    listArray
 +                      (0, count)
 +                      (IM.elems ccs)
              else
                return ce0
+         )
          ce
          mbss
++
    | otherwise = pure ce

compiler/GHC/Runtime/Debugger/Breakpoints.hs

@@ -31,6 +31,9 @@ import GHC.Unit.Module.ModSummary
  import GHC.Utils.Outputable
  import GHC.Utils.Panic
  import qualified GHC.Data.Strict as Strict
 +import qualified Data.IntMap.Strict as IntMap
 +import qualified GHC.Unit.Home.Graph as HUG
 +import qualified GHC.Unit.Home.PackageTable as HPT
  --------------------------------------------------------------------------------
  -- Finding Module breakpoints
@@ -213,6 +216,50 @@ getModBreak m = do
     mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m
     pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info
 +--------------------------------------------------------------------------------
 +-- Mapping source-level BreakpointIds to IBI occurrences
 +-- (See Note [Breakpoint identifiers])
 +--------------------------------------------------------------------------------
++
 +-- | A source-level breakpoint may have been inlined into many occurrences, now
 +-- referred by 'InternalBreakpointId'. When a breakpoint is set on a certain
 +-- source breakpoint, it means all *ocurrences* of that breakpoint across
 +-- modules should be stopped at -- hence we keep a trie from BreakpointId to
 +-- the list of internal break ids using it.
 +-- See also Note [Breakpoint identifiers]
 +type BreakpointOccurrences = ModuleEnv (IntMap.IntMap [InternalBreakpointId])
++
 +-- | Lookup all InternalBreakpointIds matching the given BreakpointId
 +-- Nothing if BreakpointId not in map
 +lookupBreakpointOccurrences :: BreakpointOccurrences -> BreakpointId -> Maybe [InternalBreakpointId]
 +lookupBreakpointOccurrences bmp (BreakpointId md tick) =
 +  lookupModuleEnv bmp md >>= IntMap.lookup tick
++
 +-- | Construct a mapping from Source 'BreakpointId's to 'InternalBreakpointId's from the given list of 'ModInfo's
 +mkBreakpointOccurrences :: forall m. GhcMonad m => m BreakpointOccurrences
 +mkBreakpointOccurrences = do
 +  hug <- hsc_HUG <$> getSession
 +  liftIO $ foldr go (pure emptyModuleEnv) hug
 +  where
 +    go :: HUG.HomeUnitEnv -> IO BreakpointOccurrences -> IO BreakpointOccurrences
 +    go hue mbmp = do
 +      bmp <- mbmp
 +      ibrkss <- HPT.concatHpt (\hmi -> maybeToList (getModBreaks hmi))
 +                             (HUG.homeUnitEnv_hpt hue)
 +      return $ foldr addBreakToMap bmp ibrkss
++
 +    addBreakToMap :: InternalModBreaks -> BreakpointOccurrences -> BreakpointOccurrences
 +    addBreakToMap ibrks bmp0 = do
 +      let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
 +      IntMap.foldrWithKey (\info_ix cgi bmp -> do
 +          let ibi = InternalBreakpointId imod info_ix
 +          case cgb_tick_id cgi of
 +            Right (BreakpointId tick_mod tick_ix)
 +              -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
 +            Left _
 +              -> bmp
 +        ) bmp0 (imodBreaks_breakInfo ibrks)
++
  --------------------------------------------------------------------------------
  -- Getting current breakpoint information
  --------------------------------------------------------------------------------
@@ -235,9 +282,15 @@ getCurrentBreakSpan = do
  getCurrentBreakModule :: GhcMonad m => m (Maybe Module)
  getCurrentBreakModule = do
    resumes <- getResumeContext
 -  return $ case resumes of
 -    [] -> Nothing
 +  hug <- hsc_HUG <$> getSession
 +  liftIO $ case resumes of
 +    [] -> pure Nothing
      (r:_) -> case resumeHistoryIx r of
 -      0  -> ibi_tick_mod <$> resumeBreakpointId r
 -      ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1)
 +      0  -> case resumeBreakpointId r of
 +        Nothing -> pure Nothing
 +        Just ibi -> do
 +          brks <- readIModBreaks hug ibi
 +          return $ Just $ getBreakSourceMod ibi brks
 +      ix ->
 +          Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))

compiler/GHC/Runtime/Eval.hs

@@ -18,7 +18,7 @@ module GHC.Runtime.Eval (
          abandon, abandonAll,
          getResumeContext,
          getHistorySpan,
 -        getModBreaks, readModBreaks,
 +        getModBreaks, readIModBreaks, readIModModBreaks,
          getHistoryModule,
          setupBreakpoint,
          back, forward,
@@ -147,14 +147,17 @@ getResumeContext = withSession (return . ic_resume . hsc_IC)
  mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO History
  mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi
 -getHistoryModule :: History -> Module
 -getHistoryModule = ibi_tick_mod . historyBreakpointId
 +getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
 +getHistoryModule hug hist = do
 +  let ibi = historyBreakpointId hist
 +  brks <- readIModBreaks hug ibi
 +  return $ getBreakSourceMod ibi brks
  getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
  getHistorySpan hug hist = do
    let ibi = historyBreakpointId hist
 -  brks <- readModBreaks hug (ibi_tick_mod ibi)
 -  return $ getBreakLoc ibi brks
 +  brks <- readIModBreaks hug ibi
 +  getBreakLoc (readIModModBreaks hug) ibi brks
  {- | Finds the enclosing top level function name -}
  -- ToDo: a better way to do this would be to keep hold of the decl_path computed
@@ -162,8 +165,8 @@ getHistorySpan hug hist = do
  -- for each tick.
  findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
  findEnclosingDecls hug ibi = do
 -  brks <- readModBreaks hug (ibi_tick_mod ibi)
 -  return $ getBreakDecls ibi brks
 +  brks <- readIModBreaks hug ibi
 +  getBreakDecls (readIModModBreaks hug) ibi brks
  -- | Update fixity environment in the current interactive context.
  updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
@@ -350,15 +353,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
      EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
        let ibi = evalBreakpointToId eval_break
        let hug = hsc_HUG hsc_env
 -      tick_brks  <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
 -      let
 -        span = getBreakLoc ibi tick_brks
 -        decl = intercalate "." $ getBreakDecls ibi tick_brks
 +      info_brks  <- liftIO $ readIModBreaks hug ibi
 +      span <- liftIO $ getBreakLoc (readIModModBreaks hug) ibi info_brks
 +      decl <- liftIO $ intercalate "." <$> getBreakDecls (readIModModBreaks hug) ibi info_brks
        -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
        bactive <- liftIO $ do
 -        breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks
 -        breakpointStatus interp breakArray (ibi_tick_index ibi)
 +        breakArray <- getBreakArray interp ibi info_brks
 +        breakpointStatus interp breakArray (ibi_info_index ibi)
        apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
        resume_ctxt_fhv   <- liftIO $ mkFinalizedHValue interp resume_ctxt
@@ -446,7 +448,7 @@ resumeExec step mbCnt
                  -- When the user specified a break ignore count, set it
                  -- in the interpreter
                  case (mb_brkpt, mbCnt) of
 -                  (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt
 +                  (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt
                    _ -> return ()
                  let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
@@ -462,17 +464,18 @@ resumeExec step mbCnt
                           | otherwise -> pure prevHistoryLst
                  handleRunStatus step expr bindings final_ids status =<< hist'
 -setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m ()   -- #19157
 -setupBreakpoint interp bi cnt = do
 +setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m ()   -- #19157
 +setupBreakpoint interp ibi cnt = do
    hug <- hsc_HUG <$> getSession
 -  modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
 -  breakArray <- liftIO $ getBreakArray interp bi modBreaks
 -  liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt
 +  liftIO $ do
 +    modBreaks <- readIModBreaks hug ibi
 +    breakArray <- getBreakArray interp ibi modBreaks
 +    GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt
 -getBreakArray :: Interp -> BreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
 -getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
 +getBreakArray :: Interp -> InternalBreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray)
 +getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do
    breaks0 <- linked_breaks . fromMaybe (panic "Loader not initialised") <$> getLoaderState interp
 -  case lookupModuleEnv (breakarray_env breaks0) bi_tick_mod of
 +  case lookupModuleEnv (breakarray_env breaks0) ibi_info_mod of
      Just ba -> return ba
      Nothing -> do
        modifyLoaderState interp $ \ld_st -> do
@@ -483,13 +486,12 @@ getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
          ba_env <- allocateBreakArrays interp (breakarray_env lb) [imbs]
          let ld_st' = ld_st { linked_breaks = lb{breakarray_env = ba_env} }
 -        let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env bi_tick_mod
 +        let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env ibi_info_mod
          return
            ( ld_st'
            , ba
+           )
+-
  back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
  back n = moveHist (+n)
@@ -517,8 +519,9 @@ moveHist fn = do
              span <- case mb_info of
                        Nothing  -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
                        Just ibi -> liftIO $ do
 -                        brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
 -                        return $ getBreakLoc ibi brks
 +                        let hug = hsc_HUG hsc_env
 +                        brks <- readIModBreaks hug ibi
 +                        getBreakLoc (readIModModBreaks hug) ibi brks
              (hsc_env1, names) <-
                liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
              let ic = hsc_IC hsc_env1
@@ -579,11 +582,10 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do
  -- of the breakpoint and the free variables of the expression.
  bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
     let hug = hsc_HUG hsc_env
 -   info_brks <- readModBreaks hug (ibi_info_mod ibi)
 -   tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
 -   let info   = getInternalBreak ibi (info_brks)
 +   info_brks <- readIModBreaks hug ibi
 +   let info   = getInternalBreak ibi info_brks
         interp = hscInterp hsc_env
 -       occs   = getBreakVars ibi tick_brks
 +   occs <- getBreakVars (readIModModBreaks hug) ibi info_brks
    -- Rehydrate to understand the breakpoint info relative to the current environment.
    -- This design is critical to preventing leaks (#22530)

compiler/GHC/Runtime/Interpreter.hs

@@ -27,7 +27,9 @@ module GHC.Runtime.Interpreter
    , getClosure
    , whereFrom
    , getModBreaks
 -  , readModBreaks
 +  , readIModBreaks
 +  , readIModBreaksMaybe
 +  , readIModModBreaks
    , seqHValue
    , evalBreakpointToId
@@ -92,7 +94,6 @@ import GHC.Utils.Fingerprint
  import GHC.Unit.Module
  import GHC.Unit.Home.ModInfo
 -import GHC.Unit.Home.Graph (lookupHugByModule)
  import GHC.Unit.Env
  #if defined(HAVE_INTERNAL_INTERPRETER)
@@ -411,15 +412,10 @@ evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
  evalBreakpointToId eval_break =
    let
      mkUnitId u = fsToUnit $ mkFastStringShortByteString u
+-
      toModule u n = mkModule (mkUnitId u) (mkModuleName n)
 -    tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
 -    infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
    in
      InternalBreakpointId
 -      { ibi_tick_mod   = tickl
 -      , ibi_tick_index = eb_tick_index eval_break
 -      , ibi_info_mod   = infol
 +      { ibi_info_mod   = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
        , ibi_info_index = eb_info_index eval_break
+       }
@@ -440,17 +436,18 @@ handleSeqHValueStatus interp unit_env eval_status =
            -- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
          Just break -> do
 -          let bi = evalBreakpointToId break
 +          let ibi = evalBreakpointToId break
 +              hug = ue_home_unit_graph unit_env
            -- Just case: Stopped at a breakpoint, extract SrcSpan information
            -- from the breakpoint.
 -          mb_modbreaks <- getModBreaks . expectJust <$>
 -                          lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
 +          mb_modbreaks <- readIModBreaksMaybe hug (ibi_info_mod ibi)
            case mb_modbreaks of
              -- Nothing case - should not occur! We should have the appropriate
              -- breakpoint information
              Nothing -> nothing_case
 -            Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks
 +            Just modbreaks -> put . brackets . ppr =<<
 +              getBreakLoc (readIModModBreaks hug) ibi modbreaks
        -- resume the seq (:force) processing in the iserv process
        withForeignRef resume_ctxt_fhv $ \hval -> do
@@ -745,10 +742,18 @@ getModBreaks hmi
    | otherwise
    = Nothing -- probably object code
 --- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
 --- from the 'HomeUnitGraph'.
 -readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks
 -readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
 +-- | Read the 'InternalModBreaks' of the given home 'Module' (via
 +-- 'InternalBreakpointId') from the 'HomeUnitGraph'.
 +readIModBreaks :: HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks
 +readIModBreaks hug ibi = expectJust <$> readIModBreaksMaybe hug (ibi_info_mod ibi)
++
 +-- | Read the 'InternalModBreaks' of the given home 'Module' from the 'HomeUnitGraph'.
 +readIModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe InternalModBreaks)
 +readIModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
++
 +-- | Read the 'ModBreaks' from the given module's 'InternalModBreaks'
 +readIModModBreaks :: HUG.HomeUnitGraph -> Module -> IO ModBreaks
 +readIModModBreaks hug mod = imodBreaks_modBreaks . expectJust <$> readIModBreaksMaybe hug mod
  -- -----------------------------------------------------------------------------
  -- Misc utils

compiler/GHC/StgToByteCode.hs

@@ -31,7 +31,6 @@ import GHC.Cmm.Utils
  import GHC.Platform
  import GHC.Platform.Profile
 -import GHC.Runtime.Interpreter
  import GHCi.FFI
  import GHC.Types.Basic
  import GHC.Utils.Outputable
@@ -64,6 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
                                assertNonVoidIds, assertNonVoidStgArgs )
  import GHC.StgToCmm.Layout
  import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
 +import GHC.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks )
  import GHC.Data.Bitmap
  import GHC.Data.FlatBag as FlatBag
  import GHC.Data.OrdList
@@ -79,7 +79,6 @@ import Control.Monad
  import Data.Char
  import GHC.Unit.Module
 -import qualified GHC.Unit.Home.Graph as HUG
  import Data.Coerce (coerce)
  #if MIN_VERSION_rts(1,0,3)
@@ -100,6 +99,7 @@ import GHC.CoreToIface
  import Control.Monad.IO.Class
  import Control.Monad.Trans.Reader (ReaderT(..))
  import Control.Monad.Trans.State  (StateT(..))
 +import Data.Array ((!))
  -- -----------------------------------------------------------------------------
  -- Generating byte code for a complete module
@@ -394,65 +394,32 @@ schemeR_wrk fvs nm original_body (args, body)
  -- | Introduce break instructions for ticked expressions.
  -- If no breakpoint information is available, the instruction is omitted.
  schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
 -schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
 -  code <- schemeE d 0 p rhs
 -  hsc_env <- getHscEnv
 -  current_mod <- getCurrentModule
 -  mb_current_mod_breaks <- getCurrentModBreaks
 -  case mb_current_mod_breaks of
 -    -- if we're not generating ModBreaks for this module for some reason, we
 -    -- can't store breakpoint occurrence information.
 -    Nothing -> pure code
 -    Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
 -      Nothing -> pure code
 -      Just ModBreaks{modBreaks_module = tick_mod} -> do
 -        platform <- profilePlatform <$> getProfile
 -        let idOffSets = getVarOffSets platform d p fvs
 -            ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
 -            toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
 -            toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
 -            breakInfo  = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
+-
 -        let info_mod = modBreaks_module current_mod_breaks
 -        infox <- newBreakInfo breakInfo
 +schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
 +  platform <- profilePlatform <$> getProfile
++
 +  code <- case rhs of
 +    -- When we find a tick surrounding a case expression we introduce a new BRK_FUN
 +    -- instruction at the start of the case *continuation*, in addition to the
 +    -- usual BRK_FUN surrounding the StgCase)
 +    -- See Note [TODO]
 +    StgCase scrut bndr _ alts
 +      -> doCase d 0 p (Just bp) scrut bndr alts
 +    _ -> schemeE d 0 p rhs
++
 +  let idOffSets = getVarOffSets platform d p fvs
 +      ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
 +      toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
 +      toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
 +      breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Right tick_id)
++
 +  mibi <- newBreakInfo breakInfo
++
 +  return $ case mibi of
 +    Nothing  -> code
 +    Just ibi -> BRK_FUN ibi 0 `consOL` code
 -        let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox)
 -        return $ breakInstr `consOL` code
  schemeER_wrk d p rhs = schemeE d 0 p rhs
 --- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
 --- from which the breakpoint originates.
 --- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs
 --- to refer to pointers in GHCi's address space.
 --- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by
 --- 'GHC.HsToCore.deSugar'.
 ---
 --- Breakpoints might be disabled because we're in TH, because
 --- @-fno-break-points@ was specified, or because a module was reloaded without
 --- reinitializing 'ModBreaks'.
 ---
 --- If the module stored in the breakpoint is the currently processed module, use
 --- the 'ModBreaks' from the state.
 --- If that is 'Nothing', consider breakpoints to be disabled and skip the
 --- instruction.
 ---
 --- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
 --- If the module doesn't exist there, or if the 'ModBreaks' value is
 --- uninitialized, skip the instruction (i.e. return Nothing).
 -break_info ::
 -  HscEnv ->
 -  Module ->
 -  Module ->
 -  Maybe ModBreaks ->
 -  BcM (Maybe ModBreaks)
 -break_info hsc_env mod current_mod current_mod_breaks
 -  | mod == current_mod
 -  = pure current_mod_breaks
 -  | otherwise
 -  = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
 -      Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp
 -      Nothing -> pure Nothing
+-
  getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
  getVarOffSets platform depth env = map getOffSet
    where
@@ -652,7 +619,7 @@ schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
  schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut
  schemeE d s p (StgCase scrut bndr _ alts)
 -   = doCase d s p scrut bndr alts
 +   = doCase d s p Nothing scrut bndr alts
  {-
@@ -1144,11 +1111,15 @@ doCase
      :: StackDepth
      -> Sequel
      -> BCEnv
 +    -> Maybe StgTickish
 +    -- ^ The breakpoint surrounding the full case expression, if any (only
 +    -- source-level cases get breakpoint ticks, and those are the only we care
 +    -- about). See Note [TODO]
      -> CgStgExpr
      -> Id
      -> [CgStgAlt]
      -> BcM BCInstrList
 -doCase d s p scrut bndr alts
 +doCase d s p m_bid scrut bndr alts
    = do
       profile <- getProfile
       hsc_env <- getHscEnv
@@ -1209,12 +1180,12 @@ doCase d s p scrut bndr alts
          -- depth of stack after the return value has been pushed
          d_bndr =
 -            d + ret_frame_size_b + bndr_size
 +            d + bndr_size
          -- depth of stack after the extra info table for an unlifted return
          -- has been pushed, if any.  This is the stack depth at the
          -- continuation.
 -        d_alts = d + ret_frame_size_b + bndr_size + unlifted_itbl_size_b
 +        d_alts = d + bndr_size + unlifted_itbl_size_b
          -- Env in which to compile the alts, not including
          -- any vars bound by the alts themselves
@@ -1365,11 +1336,28 @@ doCase d s p scrut bndr alts
       let alt_final1
             | ubx_tuple_frame    = SLIDE 0 2 `consOL` alt_final0
             | otherwise          = alt_final0
 -         alt_final
 -           | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
 -                                -- See Note [Debugger: BRK_ALTS]
 -                                = BRK_ALTS False `consOL` alt_final1
 -           | otherwise          = alt_final1
++
 +     alt_final <- case m_bid of
 +       Just (Breakpoint tick_ty tick_id fvs)
 +         | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
 +         -- Construct an internal breakpoint to put at the start of this case
 +         -- continuation BCO.
 +         -- See Note [TODO]
 +         -> do
 +          internal_tick_loc <- makeCaseInternalBreakLoc tick_id
++
 +          -- same fvs available in the case expression are available in the case continuation
 +          let idOffSets = getVarOffSets platform d p fvs
 +              ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
 +              toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
 +              toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
 +              breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Left internal_tick_loc)
++
 +          mibi <- newBreakInfo breakInfo
 +          return $ case mibi of
 +            Nothing  -> alt_final1
 +            Just ibi -> {- BRK_FUN ibi (d_alts - d) `consOL` -} alt_final1
 +       _ -> pure alt_final1
       add_bco_name <- shouldAddBcoName
       let
@@ -1389,6 +1377,24 @@ doCase d s p scrut bndr alts
                    _     -> panic "schemeE(StgCase).push_alts"
              in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
 +makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
 +makeCaseInternalBreakLoc bid = do
 +  hug         <- hsc_HUG <$> getHscEnv
 +  curr_mod    <- getCurrentModule
 +  mb_mod_brks <- getCurrentModBreaks
++
 +  -- TODO: Subtract the scrutinee loc from the case loc to get continuation loc
 +  InternalBreakLoc <$> case bid of
 +    BreakpointId{bi_tick_mod, bi_tick_index}
 +      | bi_tick_mod == curr_mod
 +      , Just these_mbs <- mb_mod_brks
 +      -> do
 +        return $ modBreaks_locs these_mbs ! bi_tick_index
 +      | otherwise
 +      -> do
 +        other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod
 +        return $ modBreaks_locs other_mbs ! bi_tick_index
++
  {-
  Note [Debugger: BRK_ALTS]
  ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1756,6 +1762,10 @@ tupleBCO platform args_info args =
        with using a fake name here. We will need to change this if we want
        to save some memory by sharing the BCO between places that have
        the same tuple shape
++
 +      ROMES:TODO: This seems like it would have a pretty good impact.
 +      Looking at examples like UnboxedTuple.hs shows many occurrences of the
 +      same tuple_BCO
      -}
      invented_name  = mkSystemVarName (mkPseudoUniqueE 0) (fsLit "tuple")
@@ -2705,14 +2715,19 @@ getLabelsBc n = BcM $ \_ st ->
    let ctr = nextlabel st
     in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
 -newBreakInfo :: CgBreakInfo -> BcM Int
 -newBreakInfo info = BcM $ \_ st ->
 -  let ix = breakInfoIdx st
 -      st' = st
 -        { breakInfo = IntMap.insert ix info (breakInfo st)
 -        , breakInfoIdx = ix + 1
 -        }
 -  in return (ix, st')
 +newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
 +newBreakInfo info = BcM $ \env st -> do
 +  -- if we're not generating ModBreaks for this module for some reason, we
 +  -- can't store breakpoint occurrence information.
 +  case modBreaks env of
 +    Nothing -> pure (Nothing, st)
 +    Just modBreaks -> do
 +      let ix = breakInfoIdx st
 +          st' = st
 +            { breakInfo = IntMap.insert ix info (breakInfo st)
 +            , breakInfoIdx = ix + 1
 +            }
 +      return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
  getCurrentModule :: BcM Module
  getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
@@ -2722,3 +2737,14 @@ getCurrentModBreaks = BcM $ \env st -> return (modBreaks env, st)
  tickFS :: FastString
  tickFS = fsLit "ticked"
++
 +-- Dehydrating CgBreakInfo
++
 +dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
 +dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
 +          CgBreakInfo
 +            { cgb_tyvars = map toIfaceTvBndr ty_vars
 +            , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
 +            , cgb_resty = toIfaceType tick_ty
 +            , cgb_tick_id = bid
 +            }

compiler/Setup.hs

  {-# LANGUAGE NamedFieldPuns #-}
 +{-# LANGUAGE CPP #-}
  module Main where
  import Distribution.Simple
@@ -12,6 +13,8 @@ import Distribution.Simple.Program
  import Distribution.Simple.Utils
  import Distribution.Simple.Setup
  import Distribution.Simple.PackageIndex
 +import qualified Distribution.Simple.LocalBuildInfo as LBI
++
  import System.IO
  import System.Process
@@ -59,8 +62,9 @@ primopIncls =
  ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
  ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap,installedPkgs}
    = do
 +  let i = LBI.interpretSymbolicPathLBI lbi
    -- Get compiler/ root directory from the cabal file
 -  let Just compilerRoot = takeDirectory <$> pkgDescrFile
 +  let Just compilerRoot = takeDirectory . i <$> pkgDescrFile
    -- Require the necessary programs
    (gcc   ,withPrograms) <- requireProgram normal gccProgram withPrograms
@@ -80,15 +84,19 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM
    -- Call genprimopcode to generate *.hs-incl
    forM_ primopIncls $ \(file,command) -> do
      contents <- readProcess "genprimopcode" [command] primopsStr
 -    rewriteFileEx verbosity (buildDir lbi </> file) contents
 +    rewriteFileEx verbosity (i (buildDir lbi) </> file) contents
    -- Write GHC.Platform.Constants
 -  let platformConstantsPath = autogenPackageModulesDir lbi </> "GHC/Platform/Constants.hs"
 +  let platformConstantsPath = i (autogenPackageModulesDir lbi) </> "GHC/Platform/Constants.hs"
        targetOS = case lookup "target os" settings of
          Nothing -> error "no target os in settings"
          Just os -> os
    createDirectoryIfMissingVerbose verbosity True (takeDirectory platformConstantsPath)
 +#if MIN_VERSION_Cabal(3,14,0)
 +  withTempFile "Constants_tmp.hs" $ \tmp h -> do
 +#else
    withTempFile (takeDirectory platformConstantsPath) "Constants_tmp.hs" $ \tmp h -> do
 +#endif
      hClose h
      callProcess "deriveConstants" ["--gen-haskell-type","-o",tmp,"--target-os",targetOS]
      renameFile tmp platformConstantsPath
@@ -103,7 +111,7 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM
          _ -> error "Couldn't find unique ghc-internal library when building ghc"
    -- Write GHC.Settings.Config
 -      configHsPath = autogenPackageModulesDir lbi </> "GHC/Settings/Config.hs"
 +      configHsPath = i (autogenPackageModulesDir lbi) </> "GHC/Settings/Config.hs"
        configHs = generateConfigHs cProjectUnitId cGhcInternalUnitId settings
    createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath)
    rewriteFileEx verbosity configHsPath configHs

compiler/ghc.cabal.in

@@ -50,7 +50,7 @@ extra-source-files:
  custom-setup
 -    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.14, directory, process, filepath, containers
 +    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.16, directory, process, filepath, containers
  Flag internal-interpreter
      Description: Build with internal interpreter support.

docs/users_guide/eventlog-formats.rst

@@ -779,9 +779,9 @@ the total time spent profiling.
  Cost-centre break-down
  ^^^^^^^^^^^^^^^^^^^^^^
 -A variable-length packet encoding a heap profile sample broken down by,
 - * cost-centre (:rts-flag:`-hc`)
+-
 +A variable-length packet encoding a heap profile sample.
 +This event is only emitted when the heap profile type is set to :rts-flag:`-hc` or :rts-flag:`-hb`.
 +Otherwise, a :event-type:`HEAP_PROF_SAMPLE_STRING` event is emitted instead.
  .. event-type:: HEAP_PROF_SAMPLE_COST_CENTRE
@@ -796,11 +796,19 @@ A variable-length packet encoding a heap profile sample broken down by,
  String break-down
  ^^^^^^^^^^^^^^^^^
 -A variable-length event encoding a heap sample broken down by,
 +A variable-length event encoding a heap sample.
 +The content of the sample label varies depending on the heap profile type:
++
 +   * :rts-flag:`-hT` The sample label contains a closure type, e.g., ``"ghc-bignum:GHC.Num.Integer.IS"``.
 +   * :rts-flag:`-hm` The sample label contains a module name, e.g., ``"GHC.Num.Integer"``.
 +   * :rts-flag:`-hd` The sample label contains a closure description, e.g., ``"IS"``.
 +   * :rts-flag:`-hy` The sample label contains a type description, e.g., ``"Integer"``.
 +   * :rts-flag:`-he` The sample label contains a stringified era, e.g., ``"1"``.
 +   * :rts-flag:`-hr` The sample label contains a retainer set description, e.g., ``"(184)$stoIntegralSized1"``.
 +   * :rts-flag:`-hi` The sample label contains a stringified pointer, e.g., ``"0x1008b7588"``,
 +     which can be matched to an info table description emitted by the :event-type:`IPE` event.
 - * type description (:rts-flag:`-hy`)
 - * closure description (:rts-flag:`-hd`)
 - * module (:rts-flag:`-hm`)
 +If the heap profile type is set to :rts-flag:`-hc` or :rts-flag:`-hb`, a :event-type:`HEAP_PROF_SAMPLE_COST_CENTRE` event is emitted instead.
  .. event-type:: HEAP_PROF_SAMPLE_STRING
@@ -808,7 +816,7 @@ A variable-length event encoding a heap sample broken down by,
     :length: variable
     :field Word8: profile ID
     :field Word64: heap residency in bytes
 -   :field String: type or closure description, or module name
 +   :field String: sample label
  .. _time-profiler-events:

ghc/GHCi/UI.hs

@@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
  import GHC.Runtime.Eval.Utils
  -- The GHC interface
 -import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks)
 +import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId, getBreakSourceMod)
  import GHC.Runtime.Interpreter
  import GHCi.RemoteTypes
  import GHCi.BreakArray( breakOn, breakOff )
@@ -68,7 +68,7 @@ import GHC ( LoadHowMuch(..), Target(..),  TargetId(..),
               Resume, SingleStep, Ghc,
               GetDocsFailure(..), pushLogHookM,
               getModuleGraph, handleSourceError,
 -             InternalBreakpointId(..) )
 +             BreakpointId(..) )
  import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
  import GHC.Hs.ImpExp
  import GHC.Hs
@@ -546,6 +546,7 @@ interactiveUI config srcs maybe_exprs = do
                     break_ctr          = 0,
                     breaks             = IntMap.empty,
                     tickarrays         = emptyModuleEnv,
 +                   internalBreaks     = emptyModuleEnv,
                     ghci_commands      = availableCommands config,
                     ghci_macros        = [],
                     last_command       = Nothing,
@@ -1616,13 +1617,15 @@ toBreakIdAndLocation :: GhciMonad m
  toBreakIdAndLocation Nothing = return Nothing
  toBreakIdAndLocation (Just inf) = do
    st <- getGHCiState
 +  hug <- hsc_HUG <$> GHC.getSession
 +  brks <- liftIO $ readIModBreaks hug inf
 +  let bi = getBreakSourceId inf brks
    return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
 -                                  breakModule loc == ibi_tick_mod inf,
 -                                  breakTick loc == ibi_tick_index inf ]
 +                                  Right (breakId loc) == bi ]
  printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
  printStoppedAtBreakInfo res names = do
 -  printForUser $ pprStopped res
 +  printForUser =<< pprStopped res
    --  printTypeOfNames session names
    let namesSorted = sortBy compareNames names
    tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
@@ -3804,22 +3807,32 @@ showBkptTable = do
  showContext :: GHC.GhcMonad m => m ()
  showContext = do
     resumes <- GHC.getResumeContext
 -   printForUser $ vcat (map pp_resume (reverse resumes))
 +   docs <- mapM pp_resume (reverse resumes)
 +   printForUser $ vcat docs
    where
 -   pp_resume res =
 -        text "--> " <> text (GHC.resumeStmt res)
 -        $$ nest 2 (pprStopped res)
+-
 -pprStopped :: GHC.Resume -> SDoc
 -pprStopped res =
 -  text "Stopped in"
 -    <+> ((case mb_mod_name of
 -           Nothing -> empty
 -           Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
 -         <> text (GHC.resumeDecl res))
 -    <> char ',' <+> ppr (GHC.resumeSpan res)
 - where
 -  mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
 +   pp_resume res = do
 +    stopped <- pprStopped res
 +    return $
 +      text "--> " <> text (GHC.resumeStmt res)
 +      $$ nest 2 stopped
++
 +pprStopped :: GHC.GhcMonad m => GHC.Resume -> m SDoc
 +pprStopped res = do
 +  let mibi = GHC.resumeBreakpointId res
 +  mb_mod_name <- case mibi of
 +    Nothing -> pure Nothing
 +    Just ibi -> do
 +      hug <- hsc_HUG <$> GHC.getSession
 +      brks <- liftIO $ readIModBreaks hug ibi
 +      return $ Just $ moduleName $
 +        getBreakSourceMod ibi brks
 +  return $
 +    text "Stopped in"
 +      <+> ((case mb_mod_name of
 +             Nothing -> empty
 +             Just mod_name -> ftext (moduleNameFS mod_name) <> char '.')
 +           <> text (GHC.resumeDecl res))
 +      <> char ',' <+> ppr (GHC.resumeSpan res)
  showUnits :: GHC.GhcMonad m => m ()
  showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
@@ -4373,12 +4386,8 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
      result <- ignoreSwitch (words argLine)
      case result of
        Left sdoc -> printForUser sdoc
 -      Right (loc, count)   -> do
 -        let bi = GHC.BreakpointId
 -                  { bi_tick_mod   = breakModule loc
 -                  , bi_tick_index = breakTick loc
 -                  }
 -        setupBreakpoint bi count
 +      Right (loc, count) -> do
 +        setupBreakpoint (breakId loc) count
  ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
  ignoreSwitch [break, count] = do
@@ -4395,10 +4404,13 @@ getIgnoreCount str =
      where
        sdocIgnore = text "Ignore count" <+> quotes (text str)
 -setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
 -setupBreakpoint loc count = do
 +setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m ()
 +setupBreakpoint bi count = do
      hsc_env <- GHC.getSession
 -    GHC.setupBreakpoint (hscInterp hsc_env) loc count
 +    -- Trigger all internal breaks that match this source break id
 +    internal_break_ids <- getInternalBreaksOf bi
 +    forM_ internal_break_ids $ \ibi -> do
 +      GHC.setupBreakpoint (hscInterp hsc_env) ibi count
  backCmd :: GhciMonad m => String -> m ()
  backCmd arg
@@ -4489,20 +4501,20 @@ findBreakAndSet md lookupTickTree = do
        some -> mapM_ breakAt some
   where
     breakAt (tick, pan) = do
 -         setBreakFlag md tick True
 -         (alreadySet, nm) <-
 -               recordBreak $ BreakLocation
 -                       { breakModule = md
 -                       , breakLoc = RealSrcSpan pan Strict.Nothing
 -                       , breakTick = tick
 -                       , onBreakCmd = ""
 -                       , breakEnabled = True
 -                       }
 -         printForUser $
 -            text "Breakpoint " <> ppr nm <>
 -            if alreadySet
 -               then text " was already set at " <> ppr pan
 -               else text " activated at " <> ppr pan
 +      let bi = BreakpointId md tick
 +      setBreakFlag bi True
 +      (alreadySet, nm) <-
 +            recordBreak $ BreakLocation
 +                    { breakLoc = RealSrcSpan pan Strict.Nothing
 +                    , breakId = bi
 +                    , onBreakCmd = ""
 +                    , breakEnabled = True
 +                    }
 +      printForUser $
 +         text "Breakpoint " <> ppr nm <>
 +         if alreadySet
 +            then text " was already set at " <> ppr pan
 +            else text " activated at " <> ppr pan
  -- For now, use ANSI bold on terminals that we know support it.
  -- Otherwise, we add a line of carets under the active expression instead.
@@ -4749,14 +4761,32 @@ turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
  turnBreakOnOff onOff loc
    | onOff == breakEnabled loc = return loc
    | otherwise = do
 -      setBreakFlag (breakModule loc) (breakTick loc)  onOff
 +      setBreakFlag (breakId loc) onOff
        return loc { breakEnabled = onOff }
 -setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
 -setBreakFlag  md ix enaDisa = do
 +setBreakFlag :: GhciMonad m => GHC.BreakpointId -> Bool -> m ()
 +setBreakFlag (BreakpointId md ix) enaDisa = do
    let enaDisaToCount True = breakOn
        enaDisaToCount False = breakOff
 -  setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
 +  setupBreakpoint (BreakpointId md ix) $ enaDisaToCount enaDisa
++
 +-- --------------------------------------------------------------------------
 +-- Find matching Internal Breakpoints
++
 +-- | Find all the internal breakpoints that use the given source-level breakpoint id
 +getInternalBreaksOf :: GhciMonad m => BreakpointId -> m [InternalBreakpointId]
 +getInternalBreaksOf bi = do
 +    st <- getGHCiState
 +    let ibrks = internalBreaks st
 +    case lookupBreakpointOccurrences ibrks bi of
 +      Just bs -> return bs
 +      Nothing -> do
 +        -- Refresh the internal breakpoints map
 +        bs <- mkBreakpointOccurrences
 +        setGHCiState st{internalBreaks = bs}
 +        return $
 +          fromMaybe [] {- still not found after refresh -} $
 +            lookupBreakpointOccurrences bs bi
  -- ---------------------------------------------------------------------------
  -- User code exception handling

ghc/GHCi/UI/Monad.hs

@@ -100,6 +100,14 @@ data GHCiState = GHCiState
              -- ^ 'tickarrays' caches the 'TickArray' for loaded modules,
              -- so that we don't rebuild it each time the user sets
              -- a breakpoint.
++
 +        internalBreaks :: BreakpointOccurrences,
 +            -- ^ Keep a mapping from the source-level 'BreakpointId' to the
 +            -- occurrences of that breakpoint across modules.
 +            -- When we want to stop at a source 'BreakpointId', we essentially
 +            -- trigger a breakpoint for all 'InternalBreakpointId's matching
 +            -- the same source-id.
++
          ghci_commands  :: [Command],
              -- ^ available ghci commands
          ghci_macros    :: [Command],
@@ -238,16 +246,15 @@ data LocalConfigBehaviour
  data BreakLocation
     = BreakLocation
 -   { breakModule :: !GHC.Module
 -   , breakLoc    :: !SrcSpan
 -   , breakTick   :: {-# UNPACK #-} !Int
 +   { breakLoc    :: !SrcSpan
 +   , breakId     :: !GHC.BreakpointId
 +     -- ^ The 'BreakpointId' uniquely identifies a source-level breakpoint
     , breakEnabled:: !Bool
     , onBreakCmd  :: String
+    }
  instance Eq BreakLocation where
 -  loc1 == loc2 = breakModule loc1 == breakModule loc2 &&
 -                 breakTick loc1   == breakTick loc2
 +  loc1 == loc2 = breakId loc1 == breakId loc2
  prettyLocations :: IntMap.IntMap BreakLocation -> SDoc
  prettyLocations  locs =
@@ -256,7 +263,7 @@ prettyLocations  locs =
        False -> vcat $ map (\(i, loc) -> brackets (int i) <+> ppr loc) $ IntMap.toAscList locs
  instance Outputable BreakLocation where
 -   ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
 +   ppr loc = (ppr $ GHC.bi_tick_mod $ breakId loc) <+> ppr (breakLoc loc) <+> pprEnaDisa <+>
                  if null (onBreakCmd loc)
                     then empty
                     else doubleQuotes (text (onBreakCmd loc))

libraries/ghc-boot/Setup.hs

@@ -10,6 +10,7 @@ import Distribution.Verbosity
  import Distribution.Simple.Program
  import Distribution.Simple.Utils
  import Distribution.Simple.Setup
 +import qualified Distribution.Simple.LocalBuildInfo as LBI
  import System.IO
  import System.Directory
@@ -32,12 +33,13 @@ main = defaultMainWithHooks ghcHooks
  ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
  ghcAutogen verbosity lbi@LocalBuildInfo{..} = do
    -- Get compiler/ root directory from the cabal file
 -  let Just compilerRoot = takeDirectory <$> pkgDescrFile
 +  let Just compilerRoot = takeDirectory . i <$> pkgDescrFile
 -  let platformHostFile = "GHC/Platform/Host.hs"
 -      platformHostPath = autogenPackageModulesDir lbi </> platformHostFile
 +      i = LBI.interpretSymbolicPathLBI lbi
 +      platformHostFile = "GHC/Platform/Host.hs"
 +      platformHostPath = i (autogenPackageModulesDir lbi) </> platformHostFile
        ghcVersionFile = "GHC/Version.hs"
 -      ghcVersionPath = autogenPackageModulesDir lbi </> ghcVersionFile
 +      ghcVersionPath = i (autogenPackageModulesDir lbi) </> ghcVersionFile
    -- Get compiler settings
    settings <- lookupEnv "HADRIAN_SETTINGS" >>= \case

libraries/ghc-boot/ghc-boot.cabal.in

@@ -28,7 +28,7 @@ build-type:     Custom
  extra-source-files: changelog.md
  custom-setup
 -    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.14, directory, filepath
 +    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.16, directory, filepath
  source-repository head
      type:     git

libraries/ghc-internal/src/GHC/Internal/Base.hs

@@ -1047,7 +1047,7 @@ class Functor f where
  -- * sequence computations and combine their results ('<*>' and 'liftA2').
  --
  -- A minimal complete definition must include implementations of 'pure'
 +-- and one of either '<*>' or 'liftA2'. If it defines both, then they must behave
  -- the same as their default definitions:
  --
  --      @('<*>') = 'liftA2' 'id'@

libraries/ghci/GHCi/Debugger.hs

@@ -65,10 +65,7 @@ foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
  --------------------------------------------------------------------------------
  type BreakpointCallback
 -     = Addr#   -- pointer to the breakpoint tick module name
 -    -> Addr#   -- pointer to the breakpoint tick module unit id
 -    -> Int#    -- breakpoint tick index
 -    -> Addr#   -- pointer to the breakpoint info module name
 +     = Addr#   -- pointer to the breakpoint info module name
      -> Addr#   -- pointer to the breakpoint info module unit id
      -> Int#    -- breakpoint info index
      -> Bool    -- exception?

libraries/ghci/GHCi/Message.hs

@@ -418,10 +418,7 @@ data EvalStatus_ a b
  instance Binary a => Binary (EvalStatus_ a b)
  data EvalBreakpoint = EvalBreakpoint
 -  { eb_tick_mod      :: String -- ^ Breakpoint tick module
 -  , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
 -  , eb_tick_index    :: Int    -- ^ Breakpoint tick index
 -  , eb_info_mod      :: String -- ^ Breakpoint info module
 +  { eb_info_mod      :: String -- ^ Breakpoint info module
    , eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
    , eb_info_index    :: Int    -- ^ Breakpoint info index
+   }

libraries/ghci/GHCi/Run.hs

@@ -345,7 +345,7 @@ withBreakAction opts breakMVar statusMVar mtid act
          -- as soon as it is hit, or in resetBreakAction below.
     onBreak :: BreakpointCallback
 -   onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
 +   onBreak info_mod# info_mod_uid# infox# is_exception apStack = do
       tid <- myThreadId
       let resume = ResumeContext
             { resumeBreakMVar = breakMVar
@@ -358,11 +358,9 @@ withBreakAction opts breakMVar statusMVar mtid act
         if is_exception
         then pure Nothing
         else do
 -         tick_mod <- peekCString (Ptr tick_mod#)
 -         tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
           info_mod <- peekCString (Ptr info_mod#)
           info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
 -         pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
 +         pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
       putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
       takeMVar breakMVar
@@ -409,8 +407,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
  noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
  noBreakAction :: BreakpointCallback
 -noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
 -noBreakAction _ _ _ _ _ _ True  _ = return () -- exception: just continue
 +noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
 +noBreakAction _ _ _ True  _ = return () -- exception: just continue
  -- Malloc and copy the bytes.  We don't have any way to monitor the
  -- lifetime of this memory, so it just leaks.

rts/Disassembler.c

@@ -84,16 +84,25 @@ disInstr ( StgBCO *bco, int pc )
     switch (instr & 0xff) {
 -      case bci_BRK_FUN:
 -         debugBelch ("BRK_FUN  " );  printPtr( ptrs[instrs[pc]] );
 -         debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
 -         CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
 +      case bci_BRK_FUN: {
 +         W_ p1, info_mod, info_unit_id, info_wix, byte_off, np;
 +         p1           = BCO_GET_LARGE_ARG;
 +         info_mod     = BCO_GET_LARGE_ARG;
 +         info_unit_id = BCO_GET_LARGE_ARG;
 +         info_wix     = BCO_NEXT;
 +         byte_off     = BCO_NEXT;
 +         np           = BCO_GET_LARGE_ARG;
 +         debugBelch ("BRK_FUN " );  printPtr( ptrs[p1] );
 +         debugBelch(" %" FMT_Word, literals[info_mod] );
 +         debugBelch(" %" FMT_Word, literals[info_unit_id] );
 +         debugBelch(" %" FMT_Word, info_wix );
 +         debugBelch(" %" FMT_Word, byte_off );
 +         CostCentre* cc = (CostCentre*)literals[np];
           if (cc) {
             debugBelch(" %s", cc->label);
+          }
           debugBelch("\n");
 -         pc += 6;
 -         break;
 +         break; }
        case bci_BRK_ALTS:
           debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
           break;

rts/Exception.cmm

@@ -535,23 +535,17 @@ retry_pop_stack:
              // be per-thread.
              CInt[rts_stop_on_exception] = 0;
              ("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
 -            Sp = Sp - WDS(17);
 -            Sp(16) = exception;
 -            Sp(15) = stg_raise_ret_info;
 -            Sp(14) = exception;
 -            Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
 -            Sp(12) = stg_ap_ppv_info;
 -            Sp(11) = 0;
 -            Sp(10) = stg_ap_n_info;
 -            Sp(9)  = 0;
 -            Sp(8)  = stg_ap_n_info;
 -            Sp(7)  = 0;
 -            Sp(6)  = stg_ap_n_info;
 -            Sp(5)  = 0;
 -            Sp(4)  = stg_ap_n_info;
 -            Sp(3)  = 0;
 -            Sp(2)  = stg_ap_n_info;
 -            Sp(1)  = 0;
 +            Sp = Sp - WDS(11);
 +            Sp(10) = exception;
 +            Sp(9) = stg_raise_ret_info;
 +            Sp(8) = exception;
 +            Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
 +            Sp(6) = stg_ap_ppv_info;
 +            Sp(5) = 0;
 +            Sp(4) = stg_ap_n_info;
 +            Sp(3) = 0;
 +            Sp(2) = stg_ap_n_info;
 +            Sp(1) = 0;
              R1 = ioAction;
              jump RET_LBL(stg_ap_n) [R1];
+         }

rts/Interpreter.c

@@ -207,6 +207,19 @@ See also Note [Width of parameters] for some more motivation.
  // Perhaps confusingly this still reads a full word, merely the offset is in bytes.
  #define ReadSpB(n)       (*((StgWord*)   SafeSpBP(n)))
 +/*
 + * SLIDE "n" words "by" words
 + * a_1 ... a_n, b_1 ... b_by, k
 + *           =>
 + * a_1 ... a_n, k
 + */
 +#define SpSlide(n, by)          \
 +    while(n-- > 0) {            \
 +        SpW(n+by) = ReadSpW(n); \
 +    }                           \
 +    Sp_addW(by);                \
++
++
  /* Note [PUSH_L underflow]
     ~~~~~~~~~~~~~~~~~~~~~~~
  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)
      return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
+ }
 +STATIC_INLINE int
 +is_ctoi_nontuple_frame(const StgClosure* frame) {
 +  const StgInfoTable* info = frame->header.info;
 +  return (
 +      (W_)info == (W_)&stg_ctoi_R1p_info ||
 +      (W_)info == (W_)&stg_ctoi_R1n_info ||
 +      (W_)info == (W_)&stg_ctoi_F1_info ||
 +      (W_)info == (W_)&stg_ctoi_D1_info ||
 +      (W_)info == (W_)&stg_ctoi_L1_info ||
 +      (W_)info == (W_)&stg_ctoi_V_info
 +    );
 +}
++
  int rts_stop_on_exception = 0;
  /* ---------------------------------------------------------------------------
@@ -473,6 +499,72 @@ void interp_shutdown( void ){
  #endif
 +const StgPtr ctoi_tuple_infos[] = {
 +    (StgPtr) &stg_ctoi_t0_info,
 +    (StgPtr) &stg_ctoi_t1_info,
 +    (StgPtr) &stg_ctoi_t2_info,
 +    (StgPtr) &stg_ctoi_t3_info,
 +    (StgPtr) &stg_ctoi_t4_info,
 +    (StgPtr) &stg_ctoi_t5_info,
 +    (StgPtr) &stg_ctoi_t6_info,
 +    (StgPtr) &stg_ctoi_t7_info,
 +    (StgPtr) &stg_ctoi_t8_info,
 +    (StgPtr) &stg_ctoi_t9_info,
 +    (StgPtr) &stg_ctoi_t10_info,
 +    (StgPtr) &stg_ctoi_t11_info,
 +    (StgPtr) &stg_ctoi_t12_info,
 +    (StgPtr) &stg_ctoi_t13_info,
 +    (StgPtr) &stg_ctoi_t14_info,
 +    (StgPtr) &stg_ctoi_t15_info,
 +    (StgPtr) &stg_ctoi_t16_info,
 +    (StgPtr) &stg_ctoi_t17_info,
 +    (StgPtr) &stg_ctoi_t18_info,
 +    (StgPtr) &stg_ctoi_t19_info,
 +    (StgPtr) &stg_ctoi_t20_info,
 +    (StgPtr) &stg_ctoi_t21_info,
 +    (StgPtr) &stg_ctoi_t22_info,
 +    (StgPtr) &stg_ctoi_t23_info,
 +    (StgPtr) &stg_ctoi_t24_info,
 +    (StgPtr) &stg_ctoi_t25_info,
 +    (StgPtr) &stg_ctoi_t26_info,
 +    (StgPtr) &stg_ctoi_t27_info,
 +    (StgPtr) &stg_ctoi_t28_info,
 +    (StgPtr) &stg_ctoi_t29_info,
 +    (StgPtr) &stg_ctoi_t30_info,
 +    (StgPtr) &stg_ctoi_t31_info,
 +    (StgPtr) &stg_ctoi_t32_info,
 +    (StgPtr) &stg_ctoi_t33_info,
 +    (StgPtr) &stg_ctoi_t34_info,
 +    (StgPtr) &stg_ctoi_t35_info,
 +    (StgPtr) &stg_ctoi_t36_info,
 +    (StgPtr) &stg_ctoi_t37_info,
 +    (StgPtr) &stg_ctoi_t38_info,
 +    (StgPtr) &stg_ctoi_t39_info,
 +    (StgPtr) &stg_ctoi_t40_info,
 +    (StgPtr) &stg_ctoi_t41_info,
 +    (StgPtr) &stg_ctoi_t42_info,
 +    (StgPtr) &stg_ctoi_t43_info,
 +    (StgPtr) &stg_ctoi_t44_info,
 +    (StgPtr) &stg_ctoi_t45_info,
 +    (StgPtr) &stg_ctoi_t46_info,
 +    (StgPtr) &stg_ctoi_t47_info,
 +    (StgPtr) &stg_ctoi_t48_info,
 +    (StgPtr) &stg_ctoi_t49_info,
 +    (StgPtr) &stg_ctoi_t50_info,
 +    (StgPtr) &stg_ctoi_t51_info,
 +    (StgPtr) &stg_ctoi_t52_info,
 +    (StgPtr) &stg_ctoi_t53_info,
 +    (StgPtr) &stg_ctoi_t54_info,
 +    (StgPtr) &stg_ctoi_t55_info,
 +    (StgPtr) &stg_ctoi_t56_info,
 +    (StgPtr) &stg_ctoi_t57_info,
 +    (StgPtr) &stg_ctoi_t58_info,
 +    (StgPtr) &stg_ctoi_t59_info,
 +    (StgPtr) &stg_ctoi_t60_info,
 +    (StgPtr) &stg_ctoi_t61_info,
 +    (StgPtr) &stg_ctoi_t62_info,
 +};
++
  #if defined(PROFILING)
  //
@@ -619,8 +711,6 @@ interpretBCO (Capability* cap)
       */
      if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
 -      StgBCO* bco;
 -      StgWord16* bco_instrs;
        StgHalfWord type;
        /* Store the entry Sp; traverse the stack modifying Sp (using Sp macros);
@@ -640,28 +730,34 @@ interpretBCO (Capability* cap)
        ASSERT(type == RET_BCO || type == STOP_FRAME);
        if (type == RET_BCO) {
 -        bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
 +        StgBCO* bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO
          ASSERT(get_itbl((StgClosure*)bco)->type == BCO);
 -        bco_instrs = (StgWord16*)(bco->instrs->payload);
++
 +        StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
 +        StgWord16 bci = instrs[0];
          /* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first
           * instruction in a BCO */
 -        if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) {
 -            int brk_array, tick_index;
 -            StgArrBytes *breakPoints;
 -            StgPtr* ptrs;
 +        if ((bci & 0xFF) == bci_BRK_FUN) {
 +            // Define rest of variables used by BCO_* Macros
 +            int bciPtr = 0;
 -            ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
 -            brk_array  = bco_instrs[1];
 -            tick_index = bco_instrs[6];
 +            W_ arg1_brk_array, arg4_info_index;
 +            arg1_brk_array      = BCO_GET_LARGE_ARG;
 +            /* info_mod_name = */ BCO_GET_LARGE_ARG;
 +            /* info_mod_id   = */ BCO_GET_LARGE_ARG;
 +            arg4_info_index     = BCO_NEXT;
 +            /* byte_off      = BCO_NEXT; */
++
 +            StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
 +            StgArrBytes* breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
 -            breakPoints = (StgArrBytes *) BCO_PTR(brk_array);
              // ACTIVATE the breakpoint by tick index
 -            ((StgInt*)breakPoints->payload)[tick_index] = 0;
 +            ((StgInt*)breakPoints->payload)[arg4_info_index] = 0;
+         }
 -        else if ((bco_instrs[0] & 0xFF) == bci_BRK_ALTS) {
 +        else if ((bci & 0xFF) == bci_BRK_ALTS) {
              // ACTIVATE BRK_ALTS by setting its only argument to ON
 -            bco_instrs[1] = 1;
 +            instrs[1] = 1;
+         }
          // else: if there is no BRK instruction perhaps we should keep
          // traversing; that said, the continuation should always have a BRK
@@ -776,7 +872,6 @@ eval_obj:
               debugBelch("\n\n");
              );
 -//    IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
      IF_DEBUG(sanity,checkStackFrame(Sp));
      switch ( get_itbl(obj)->type ) {
@@ -1018,11 +1113,36 @@ do_return_pointer:
          // Returning to an interpreted continuation: put the object on
          // the stack, and start executing the BCO.
          INTERP_TICK(it_retto_BCO);
 -        Sp_subW(1);
 -        SpW(0) = (W_)tagged_obj;
 -        obj = (StgClosure*)ReadSpW(2);
 +        obj = (StgClosure*)ReadSpW(1);
          ASSERT(get_itbl(obj)->type == BCO);
 -        goto run_BCO_return_pointer;
++
 +        // Heap check
 +        if (doYouWantToGC(cap)) {
 +            Sp_subW(2);
 +            SpW(1) = (W_)tagged_obj;
 +            SpW(0) = (W_)&stg_ret_p_info;
 +            RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
 +        }
 +        else {
++
 +          // Stack checks aren't necessary at return points, the stack use
 +          // is aggregated into the enclosing function entry point.
++
 +          // Make sure to drop the RET_BCO frame header,
 +          // but not its arguments (which are expected at the top when running the BCO).
 +          // NOTE: Always a return_pointer (ie not a tuple ctoi frame!)
++
 +          // Make sure stack is headed by a ctoi nontuple frame then drop it.
 +          // The arguments to the BCO continuation stay on top of the stack
 +          ASSERT(is_ctoi_nontuple_frame(Sp));
 +          Sp_addW(2);
++
 +          // Plus the return value on top of the args
 +          Sp_subW(1);
 +          SpW(0) = (W_)tagged_obj;
 +        }
++
 +        goto run_BCO;
      default:
      do_return_unrecognised:
@@ -1091,8 +1211,9 @@ do_return_nonpointer:
          // get the offset of the header of the next stack frame
          offset = stack_frame_sizeW((StgClosure *)Sp);
 +        StgClosure* next_frame = (StgClosure*)(SafeSpWP(offset));
 -        switch (get_itbl((StgClosure*)(SafeSpWP(offset)))->type) {
 +        switch (get_itbl(next_frame)->type) {
          case RET_BCO:
              // Returning to an interpreted continuation: pop the return frame
@@ -1100,8 +1221,72 @@ do_return_nonpointer:
              // executing the BCO.
              INTERP_TICK(it_retto_BCO);
              obj = (StgClosure*)ReadSpW(offset+1);
++
              ASSERT(get_itbl(obj)->type == BCO);
 -            goto run_BCO_return_nonpointer;
++
 +            // Heap check
 +            if (doYouWantToGC(cap)) {
 +                RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
 +            }
 +            else {
 +              // Stack checks aren't necessary at return points, the stack use
 +              // is aggregated into the enclosing function entry point.
++
 +#if defined(PROFILING)
 +              /*
 +                 Restore the current cost centre stack if a tuple is being returned.
++
 +                 When a "simple" unlifted value is returned, the cccs is restored with
 +                 an stg_restore_cccs frame on the stack, for example:
++
 +                     ...
 +                     stg_ctoi_D1
 +                     <CCCS>
 +                     stg_restore_cccs
++
 +                 But stg_restore_cccs cannot deal with tuples, which may have more
 +                 things on the stack. Therefore we store the CCCS inside the
 +                 stg_ctoi_t frame.
++
 +                 If we have a tuple being returned, the stack looks like this:
++
 +                     ...
 +                     <CCCS>           <- to restore, Sp offset <next frame + 4 words>
 +                     tuple_BCO
 +                     tuple_info
 +                     cont_BCO
 +                     stg_ctoi_t       <- next frame
 +                     tuple_data_1
 +                     ...
 +                     tuple_data_n
 +                     tuple_info
 +                     tuple_BCO
 +                     stg_ret_t        <- Sp
 +               */
++
 +              if(SpW(0) == (W_)&stg_ret_t_info) {
 +                  cap->r.rCCCS = (CostCentreStack*)ReadSpW(stack_frame_sizeW((StgClosure *)Sp) + 4);
 +              }
 +#endif
 +              /* Drop the RET_BCO header (next_frame),
 +               * but not its arguments (which are expected at the top when running the BCO)
 +               */
 +              W_ n  = offset;
 +              W_ by = is_ctoi_nontuple_frame(next_frame)
 +                          ? 2 // info+bco
 +#if defined(PROFILING)
 +                          : 5;  // or info+bco+tuple_info+tuple_BCO+CCS
 +#else
 +                          : 4;  // or info+bco+tuple_info+tuple_BCO
 +#endif
 +              SpSlide(n, by);
++
 +              if (SpW(0) != (W_)&stg_ret_t_info) {
 +                Sp_addW(1);
 +              }
++
 +              goto run_BCO;
 +            }
          default:
+         {
@@ -1268,8 +1453,8 @@ do_apply:
      // Ok, we now have a bco (obj), and its arguments are all on the
      // stack.  We can start executing the byte codes.
      //
 -    // The stack is in one of two states.  First, if this BCO is a
 -    // function:
 +    // The stack is in one of two states. First, if this BCO is a
 +    // function
      //
      //    |     ....      |
      //    +---------------+
@@ -1286,10 +1471,6 @@ do_apply:
      //    +---------------+
      //    |     fv1       |
      //    +---------------+
 -    //    |     BCO       |
 -    //    +---------------+
 -    //    | stg_ctoi_ret_ |
 -    //    +---------------+
      //    |    retval     |
      //    +---------------+
      //
@@ -1307,68 +1488,6 @@ do_apply:
      // Sadly we have three different kinds of stack/heap/cswitch check
      // to do:
+-
 -run_BCO_return_pointer:
 -    // Heap check
 -    if (doYouWantToGC(cap)) {
 -        Sp_subW(1); SpW(0) = (W_)&stg_ret_p_info;
 -        RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
 -    }
 -    // Stack checks aren't necessary at return points, the stack use
 -    // is aggregated into the enclosing function entry point.
+-
 -    goto run_BCO;
+-
 -run_BCO_return_nonpointer:
 -    // Heap check
 -    if (doYouWantToGC(cap)) {
 -        RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
 -    }
 -    // Stack checks aren't necessary at return points, the stack use
 -    // is aggregated into the enclosing function entry point.
+-
 -#if defined(PROFILING)
 -    /*
 -       Restore the current cost centre stack if a tuple is being returned.
+-
 -       When a "simple" unlifted value is returned, the cccs is restored with
 -       an stg_restore_cccs frame on the stack, for example:
+-
 -           ...
 -           stg_ctoi_D1
 -           <CCCS>
 -           stg_restore_cccs
+-
 -       But stg_restore_cccs cannot deal with tuples, which may have more
 -       things on the stack. Therefore we store the CCCS inside the
 -       stg_ctoi_t frame.
+-
 -       If we have a tuple being returned, the stack looks like this:
+-
 -           ...
 -           <CCCS>           <- to restore, Sp offset <next frame + 4 words>
 -           tuple_BCO
 -           tuple_info
 -           cont_BCO
 -           stg_ctoi_t       <- next frame
 -           tuple_data_1
 -           ...
 -           tuple_data_n
 -           tuple_info
 -           tuple_BCO
 -           stg_ret_t        <- Sp
 -     */
+-
 -    if(SpW(0) == (W_)&stg_ret_t_info) {
 -        cap->r.rCCCS = (CostCentreStack*)ReadSpW(stack_frame_sizeW((StgClosure *)Sp) + 4);
 -    }
 -#endif
+-
 -    if (SpW(0) != (W_)&stg_ret_t_info) {
 -      Sp_addW(1);
 -    }
 -    goto run_BCO;
+-
  run_BCO_fun:
      IF_DEBUG(sanity,
               Sp_subW(2);
@@ -1454,9 +1573,9 @@ run_BCO:
          /* check for a breakpoint on the beginning of a let binding */
          case bci_BRK_FUN:
+         {
 -            int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
 +            W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index, arg5_byte_off;
  #if defined(PROFILING)
 -            int arg8_cc;
 +            W_ arg6_cc;
  #endif
              StgArrBytes *breakPoints;
              int returning_from_break, stop_next_breakpoint;
@@ -1471,14 +1590,12 @@ run_BCO:
              int size_words;
              arg1_brk_array      = BCO_GET_LARGE_ARG;
 -            arg2_tick_mod       = BCO_GET_LARGE_ARG;
 -            arg3_info_mod       = BCO_GET_LARGE_ARG;
 -            arg4_tick_mod_id    = BCO_GET_LARGE_ARG;
 -            arg5_info_mod_id    = BCO_GET_LARGE_ARG;
 -            arg6_tick_index     = BCO_NEXT;
 -            arg7_info_index     = BCO_NEXT;
 +            arg2_info_mod_name  = BCO_GET_LARGE_ARG;
 +            arg3_info_mod_id    = BCO_GET_LARGE_ARG;
 +            arg4_info_index     = BCO_NEXT;
 +            arg5_byte_off       = BCO_NEXT;
  #if defined(PROFILING)
 -            arg8_cc             = BCO_GET_LARGE_ARG;
 +            arg6_cc             = BCO_GET_LARGE_ARG;
  #else
              BCO_GET_LARGE_ARG;
  #endif
@@ -1498,7 +1615,7 @@ run_BCO:
  #if defined(PROFILING)
              cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
 -                                          (CostCentre*)BCO_LIT(arg8_cc));
 +                                          (CostCentre*)BCO_LIT(arg6_cc));
  #endif
              // if we are returning from a break then skip this section
@@ -1509,11 +1626,11 @@ run_BCO:
                 // stop the current thread if either `stop_next_breakpoint` is
                 // true OR if the ignore count for this particular breakpoint is zero
 -               StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
 +               StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
                 if (stop_next_breakpoint == false && ignore_count > 0)
+                {
                    // decrement and write back ignore count
 -                  ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
 +                  ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
+                }
                 else if (stop_next_breakpoint == true || ignore_count == 0)
+                {
@@ -1538,7 +1655,12 @@ run_BCO:
                    // copy the contents of the top stack frame into the AP_STACK
                    for (i = 2; i < size_words; i++)
+                   {
 -                     new_aps->payload[i] = (StgClosure *)ReadSpW(i-2);
 +                     // BAD ASSUMPTION: BITMAP Vars are on top of the stack.
 +                     // THEY ARE NOT FOR PUSH_ALTS:
 +                     //   THE FIRST THING ON THE STACK IS GOING TO BE
 +                     //       ctoi_***
 +                     //TODO UPDATE DOCUMENTATION EXPLANING ARG5_BYTE_OFF
 +                     new_aps->payload[i] = (StgClosure *)ReadSpB(((ptrdiff_t)(i-2) * (ptrdiff_t)sizeof(W_)) + arg5_byte_off);
+                   }
                    // No write barrier is needed here as this is a new allocation
@@ -1547,10 +1669,7 @@ run_BCO:
                    // Arrange the stack to call the breakpoint IO action, and
                    // continue execution of this BCO when the IO action returns.
                    //
 -                  // ioAction :: Addr#       -- the breakpoint tick module
 -                  //          -> Addr#       -- the breakpoint tick module unit id
 -                  //          -> Int#        -- the breakpoint tick index
 -                  //          -> Addr#       -- the breakpoint info module
 +                  // ioAction :: Addr#       -- the breakpoint info module
                    //          -> Addr#       -- the breakpoint info module unit id
                    //          -> Int#        -- the breakpoint info index
                    //          -> Bool        -- exception?
@@ -1560,23 +1679,17 @@ run_BCO:
                    ioAction = (StgClosure *) deRefStablePtr (
                        rts_breakpoint_io_action);
 -                  Sp_subW(19);
 -                  SpW(18) = (W_)obj;
 -                  SpW(17) = (W_)&stg_apply_interp_info;
 -                  SpW(16) = (W_)new_aps;
 -                  SpW(15) = (W_)False_closure;         // True <=> an exception
 -                  SpW(14) = (W_)&stg_ap_ppv_info;
 -                  SpW(13)  = (W_)arg7_info_index;
 -                  SpW(12)  = (W_)&stg_ap_n_info;
 -                  SpW(11)  = (W_)BCO_LIT(arg5_info_mod_id);
 -                  SpW(10)  = (W_)&stg_ap_n_info;
 -                  SpW(9)  = (W_)BCO_LIT(arg3_info_mod);
 -                  SpW(8)  = (W_)&stg_ap_n_info;
 -                  SpW(7)  = (W_)arg6_tick_index;
 +                  Sp_subW(13);
 +                  SpW(12) = (W_)obj;
 +                  SpW(11) = (W_)&stg_apply_interp_info;
 +                  SpW(10) = (W_)new_aps;
 +                  SpW(9) = (W_)False_closure;         // True <=> an exception
 +                  SpW(8) = (W_)&stg_ap_ppv_info;
 +                  SpW(7)  = (W_)arg4_info_index;
                    SpW(6)  = (W_)&stg_ap_n_info;
 -                  SpW(5)  = (W_)BCO_LIT(arg4_tick_mod_id);
 +                  SpW(5)  = (W_)BCO_LIT(arg3_info_mod_id);
                    SpW(4)  = (W_)&stg_ap_n_info;
 -                  SpW(3)  = (W_)BCO_LIT(arg2_tick_mod);
 +                  SpW(3)  = (W_)BCO_LIT(arg2_info_mod_name);
                    SpW(2)  = (W_)&stg_ap_n_info;
                    SpW(1)  = (W_)ioAction;
                    SpW(0)  = (W_)&stg_enter_info;
@@ -1742,6 +1855,10 @@ run_BCO:
              Sp_subW(2);
              SpW(1) = BCO_PTR(o_bco);
              SpW(0) = (W_)&stg_ctoi_R1p_info;
++
 +            // The o_bco expects its arguments (as per the BCO_BITMAP_SIZE) to
 +            // be found on the stack before it.
 +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
  #if defined(PROFILING)
              Sp_subW(2);
              SpW(1) = (W_)cap->r.rCCCS;
@@ -1755,6 +1872,8 @@ run_BCO:
              SpW(-2) = (W_)&stg_ctoi_R1n_info;
              SpW(-1) = BCO_PTR(o_bco);
              Sp_subW(2);
++
 +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
  #if defined(PROFILING)
              Sp_subW(2);
              SpW(1) = (W_)cap->r.rCCCS;
@@ -1768,6 +1887,8 @@ run_BCO:
              SpW(-2) = (W_)&stg_ctoi_F1_info;
              SpW(-1) = BCO_PTR(o_bco);
              Sp_subW(2);
++
 +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
  #if defined(PROFILING)
              Sp_subW(2);
              SpW(1) = (W_)cap->r.rCCCS;
@@ -1781,6 +1902,8 @@ run_BCO:
              SpW(-2) = (W_)&stg_ctoi_D1_info;
              SpW(-1) = BCO_PTR(o_bco);
              Sp_subW(2);
++
 +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
  #if defined(PROFILING)
              Sp_subW(2);
              SpW(1) = (W_)cap->r.rCCCS;
@@ -1794,6 +1917,8 @@ run_BCO:
              SpW(-2) = (W_)&stg_ctoi_L1_info;
              SpW(-1) = BCO_PTR(o_bco);
              Sp_subW(2);
++
 +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
  #if defined(PROFILING)
              Sp_subW(2);
              SpW(1) = (W_)cap->r.rCCCS;
@@ -1807,6 +1932,8 @@ run_BCO:
              SpW(-2) = (W_)&stg_ctoi_V_info;
              SpW(-1) = BCO_PTR(o_bco);
              Sp_subW(2);
++
 +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
  #if defined(PROFILING)
              Sp_subW(2);
              SpW(1) = (W_)cap->r.rCCCS;
@@ -1820,6 +1947,7 @@ run_BCO:
              W_ tuple_info = (W_)BCO_LIT(BCO_GET_LARGE_ARG);
              W_ o_tuple_bco = BCO_GET_LARGE_ARG;
 +            IF_DEBUG(sanity, checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size););
  #if defined(PROFILING)
              SpW(-1) = (W_)cap->r.rCCCS;
              Sp_subW(1);
@@ -1828,82 +1956,11 @@ run_BCO:
              SpW(-1) = BCO_PTR(o_tuple_bco);
              SpW(-2) = tuple_info;
              SpW(-3) = BCO_PTR(o_bco);
 -            W_ ctoi_t_offset;
              int tuple_stack_words = (tuple_info >> 24) & 0xff;
 -            switch(tuple_stack_words) {
 -                case 0:  ctoi_t_offset = (W_)&stg_ctoi_t0_info;  break;
 -                case 1:  ctoi_t_offset = (W_)&stg_ctoi_t1_info;  break;
 -                case 2:  ctoi_t_offset = (W_)&stg_ctoi_t2_info;  break;
 -                case 3:  ctoi_t_offset = (W_)&stg_ctoi_t3_info;  break;
 -                case 4:  ctoi_t_offset = (W_)&stg_ctoi_t4_info;  break;
 -                case 5:  ctoi_t_offset = (W_)&stg_ctoi_t5_info;  break;
 -                case 6:  ctoi_t_offset = (W_)&stg_ctoi_t6_info;  break;
 -                case 7:  ctoi_t_offset = (W_)&stg_ctoi_t7_info;  break;
 -                case 8:  ctoi_t_offset = (W_)&stg_ctoi_t8_info;  break;
 -                case 9:  ctoi_t_offset = (W_)&stg_ctoi_t9_info;  break;
+-
 -                case 10: ctoi_t_offset = (W_)&stg_ctoi_t10_info; break;
 -                case 11: ctoi_t_offset = (W_)&stg_ctoi_t11_info; break;
 -                case 12: ctoi_t_offset = (W_)&stg_ctoi_t12_info; break;
 -                case 13: ctoi_t_offset = (W_)&stg_ctoi_t13_info; break;
 -                case 14: ctoi_t_offset = (W_)&stg_ctoi_t14_info; break;
 -                case 15: ctoi_t_offset = (W_)&stg_ctoi_t15_info; break;
 -                case 16: ctoi_t_offset = (W_)&stg_ctoi_t16_info; break;
 -                case 17: ctoi_t_offset = (W_)&stg_ctoi_t17_info; break;
 -                case 18: ctoi_t_offset = (W_)&stg_ctoi_t18_info; break;
 -                case 19: ctoi_t_offset = (W_)&stg_ctoi_t19_info; break;
+-
 -                case 20: ctoi_t_offset = (W_)&stg_ctoi_t20_info; break;
 -                case 21: ctoi_t_offset = (W_)&stg_ctoi_t21_info; break;
 -                case 22: ctoi_t_offset = (W_)&stg_ctoi_t22_info; break;
 -                case 23: ctoi_t_offset = (W_)&stg_ctoi_t23_info; break;
 -                case 24: ctoi_t_offset = (W_)&stg_ctoi_t24_info; break;
 -                case 25: ctoi_t_offset = (W_)&stg_ctoi_t25_info; break;
 -                case 26: ctoi_t_offset = (W_)&stg_ctoi_t26_info; break;
 -                case 27: ctoi_t_offset = (W_)&stg_ctoi_t27_info; break;
 -                case 28: ctoi_t_offset = (W_)&stg_ctoi_t28_info; break;
 -                case 29: ctoi_t_offset = (W_)&stg_ctoi_t29_info; break;
+-
 -                case 30: ctoi_t_offset = (W_)&stg_ctoi_t30_info; break;
 -                case 31: ctoi_t_offset = (W_)&stg_ctoi_t31_info; break;
 -                case 32: ctoi_t_offset = (W_)&stg_ctoi_t32_info; break;
 -                case 33: ctoi_t_offset = (W_)&stg_ctoi_t33_info; break;
 -                case 34: ctoi_t_offset = (W_)&stg_ctoi_t34_info; break;
 -                case 35: ctoi_t_offset = (W_)&stg_ctoi_t35_info; break;
 -                case 36: ctoi_t_offset = (W_)&stg_ctoi_t36_info; break;
 -                case 37: ctoi_t_offset = (W_)&stg_ctoi_t37_info; break;
 -                case 38: ctoi_t_offset = (W_)&stg_ctoi_t38_info; break;
 -                case 39: ctoi_t_offset = (W_)&stg_ctoi_t39_info; break;
+-
 -                case 40: ctoi_t_offset = (W_)&stg_ctoi_t40_info; break;
 -                case 41: ctoi_t_offset = (W_)&stg_ctoi_t41_info; break;
 -                case 42: ctoi_t_offset = (W_)&stg_ctoi_t42_info; break;
 -                case 43: ctoi_t_offset = (W_)&stg_ctoi_t43_info; break;
 -                case 44: ctoi_t_offset = (W_)&stg_ctoi_t44_info; break;
 -                case 45: ctoi_t_offset = (W_)&stg_ctoi_t45_info; break;
 -                case 46: ctoi_t_offset = (W_)&stg_ctoi_t46_info; break;
 -                case 47: ctoi_t_offset = (W_)&stg_ctoi_t47_info; break;
 -                case 48: ctoi_t_offset = (W_)&stg_ctoi_t48_info; break;
 -                case 49: ctoi_t_offset = (W_)&stg_ctoi_t49_info; break;
+-
 -                case 50: ctoi_t_offset = (W_)&stg_ctoi_t50_info; break;
 -                case 51: ctoi_t_offset = (W_)&stg_ctoi_t51_info; break;
 -                case 52: ctoi_t_offset = (W_)&stg_ctoi_t52_info; break;
 -                case 53: ctoi_t_offset = (W_)&stg_ctoi_t53_info; break;
 -                case 54: ctoi_t_offset = (W_)&stg_ctoi_t54_info; break;
 -                case 55: ctoi_t_offset = (W_)&stg_ctoi_t55_info; break;
 -                case 56: ctoi_t_offset = (W_)&stg_ctoi_t56_info; break;
 -                case 57: ctoi_t_offset = (W_)&stg_ctoi_t57_info; break;
 -                case 58: ctoi_t_offset = (W_)&stg_ctoi_t58_info; break;
 -                case 59: ctoi_t_offset = (W_)&stg_ctoi_t59_info; break;
+-
 -                case 60: ctoi_t_offset = (W_)&stg_ctoi_t60_info; break;
 -                case 61: ctoi_t_offset = (W_)&stg_ctoi_t61_info; break;
 -                case 62: ctoi_t_offset = (W_)&stg_ctoi_t62_info; break;
+-
 -                default: barf("unsupported tuple size %d", tuple_stack_words);
 +            if (tuple_stack_words > 62) {
 +                barf("unsupported tuple size %d", tuple_stack_words);
+             }
+-
 +            W_ ctoi_t_offset = (W_) ctoi_tuple_infos[tuple_stack_words];
              SpW(-4) = ctoi_t_offset;
              Sp_subW(4);
              goto nextInsn;
@@ -1996,15 +2053,7 @@ run_BCO:
          case bci_SLIDE: {
              W_ n  = BCO_GET_LARGE_ARG;
              W_ by = BCO_GET_LARGE_ARG;
 -            /*
 -             * a_1 ... a_n, b_1 ... b_by, k
 -             *           =>
 -             * a_1 ... a_n, k
 -             */
 -            while(n-- > 0) {
 -                SpW(n+by) = ReadSpW(n);
 -            }
 -            Sp_addW(by);
 +            SpSlide(n, by);
              INTERP_TICK(it_slides);
              goto nextInsn;
+         }

testsuite/tests/ghci.debugger/scripts/all.T

@@ -147,7 +147,7 @@ test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script'])
  # Step out tests
  test('T26042b', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042b.hs'])], ghci_script, ['T26042b.script'])
 -test('T26042c', [expect_broken(26042),extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
 +test('T26042c', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
  test('T26042d', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d.hs'])], ghci_script, ['T26042d.script'])
  test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
  test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop