Enable stack traces with ghci -fexternal-interpreter -prof

Summary:
The main goal here is enable stack traces in GHCi.  After this change,
if you start GHCi like this:

  ghci -fexternal-interpreter -prof

(which requires packages to be built for profiling, but not GHC
itself) then the interpreter manages cost-centre stacks during
execution and can produce a stack trace on request.  Call locations
are available for all interpreted code, and any compiled code that was
built with the `-fprof-auto` familiy of flags.

There are a couple of ways to get a stack trace:

* `error`/`undefined` automatically get one attached
* `Debug.Trace.traceStack` can be used anywhere, and prints the current
  stack

Because the interpreter is running in a separate process, only the
interpreted code is running in profiled mode and the compiler itself
isn't slowed down by profiling.

The GHCi debugger still doesn't work with -fexternal-interpreter,
although this patch gets it a step closer.  Most of the functionality
of breakpoints is implemented, but the runtime value introspection is
still not supported.

Along the way I also did some refactoring and added type arguments to
the various remote pointer types in `GHCi.RemotePtr`, so there's
better type safety and documentation in the bridge code between GHC
and ghc-iserv.

Test Plan: validate

Reviewers: bgamari, ezyang, austin, hvr, goldfire, erikd

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1747

GHC Trac Issues: #11047, #11100

22 files changed, 367 insertions, 453 deletions

diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index 08014229e9..b0543ed88e 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -10,6 +10,9 @@ module Coverage (addTicksToBinds, hpcInitCode) where
 #ifdef GHCI
 import qualified GHCi
 import GHCi.RemoteTypes
+import Data.Array
+import ByteCodeTypes
+import GHC.Stack.CCS
 #endif
 import Type
 import HsSyn
@@ -37,14 +40,14 @@ import Maybes
 import CLabel
 import Util
 
-import Data.Array
 import Data.Time
+import Foreign.C
 import System.Directory
 
 import Trace.Hpc.Mix
 import Trace.Hpc.Util
 
-import BreakArray
+import qualified Data.ByteString as B
 import Data.Map (Map)
 import qualified Data.Map as Map
 
@@ -65,7 +68,7 @@ addTicksToBinds
                                 -- hasn't set it), so we have to work from this set.
         -> [TyCon]              -- Type constructor in this module
         -> LHsBinds Id
-        -> IO (LHsBinds Id, HpcInfo, ModBreaks)
+        -> IO (LHsBinds Id, HpcInfo, Maybe ModBreaks)
 
 addTicksToBinds hsc_env mod mod_loc exports tyCons binds
   | let dflags = hsc_dflags hsc_env
@@ -73,7 +76,7 @@ addTicksToBinds hsc_env mod mod_loc exports tyCons binds
     Just orig_file <- ml_hs_file mod_loc = do
 
      if "boot" `isSuffixOf` orig_file
-         then return (binds, emptyHpcInfo False, emptyModBreaks)
+         then return (binds, emptyHpcInfo False, Nothing)
          else do
 
      us <- mkSplitUniqSupply 'C' -- for cost centres
@@ -93,7 +96,7 @@ addTicksToBinds hsc_env mod mod_loc exports tyCons binds
                       , density      = mkDensity tickish dflags
                       , this_mod     = mod
                       , tickishType  = tickish
-                      }
+}
                 (binds',_,st') = unTM (addTickLHsBinds binds) env st
             in (binds', st')
 
@@ -113,9 +116,9 @@ addTicksToBinds hsc_env mod mod_loc exports tyCons binds
          log_action dflags dflags SevDump noSrcSpan defaultDumpStyle
              (pprLHsBinds binds1)
 
-     return (binds1, HpcInfo tickCount hashNo, modBreaks)
+     return (binds1, HpcInfo tickCount hashNo, Just modBreaks)
 
-  | otherwise = return (binds, emptyHpcInfo False, emptyModBreaks)
+  | otherwise = return (binds, emptyHpcInfo False, Nothing)
 
 guessSourceFile :: LHsBinds Id -> FilePath -> FilePath
 guessSourceFile binds orig_file =
@@ -131,12 +134,13 @@ guessSourceFile binds orig_file =
 
 
 mkModBreaks :: HscEnv -> Module -> Int -> [MixEntry_] -> IO ModBreaks
+#ifndef GHCI
+mkModBreaks _hsc_env _mod _count _entries = return emptyModBreaks
+#else
 mkModBreaks hsc_env mod count entries
   | HscInterpreted <- hscTarget (hsc_dflags hsc_env) = do
-    breakArray <- newBreakArray (length entries)
-#ifdef GHCI
+    breakArray <- GHCi.newBreakArray hsc_env (length entries)
     ccs <- mkCCSArray hsc_env mod count entries
-#endif
     let
            locsTicks  = listArray (0,count-1) [ span  | (span,_,_,_)  <- entries ]
            varsTicks  = listArray (0,count-1) [ vars  | (_,_,vars,_)  <- entries ]
@@ -146,31 +150,30 @@ mkModBreaks hsc_env mod count entries
                        , modBreaks_locs  = locsTicks
                        , modBreaks_vars  = varsTicks
                        , modBreaks_decls = declsTicks
-#ifdef GHCI
                        , modBreaks_ccs   = ccs
-#endif
                        }
   | otherwise = return emptyModBreaks
 
-#ifdef GHCI
 mkCCSArray
   :: HscEnv -> Module -> Int -> [MixEntry_]
-  -> IO (Array BreakIndex RemotePtr {- CCostCentre -})
+  -> IO (Array BreakIndex (RemotePtr GHC.Stack.CCS.CostCentre))
 mkCCSArray hsc_env modul count entries = do
   if interpreterProfiled (hsc_dflags hsc_env)
     then do
       let module_bs = fastStringToByteString (moduleNameFS (moduleName modul))
-      c_module <- GHCi.mallocData hsc_env module_bs
-      costcentres <- mapM (mkCostCentre hsc_env (toRemotePtr c_module)) entries
+      c_module <- GHCi.mallocData hsc_env (module_bs `B.snoc` 0)
+        -- NB. null-terminate the string
+      costcentres <-
+        mapM (mkCostCentre hsc_env (castRemotePtr c_module)) entries
       return (listArray (0,count-1) costcentres)
     else do
       return (listArray (0,-1) [])
  where
     mkCostCentre
      :: HscEnv
-     -> RemotePtr {- CChar -}
+     -> RemotePtr CChar
      -> MixEntry_
-     -> IO (RemotePtr {- CCostCentre -})
+     -> IO (RemotePtr GHC.Stack.CCS.CostCentre)
     mkCostCentre hsc_env@HscEnv{..}  c_module (srcspan, decl_path, _, _) = do
       let name = concat (intersperse "." decl_path)
           src = showSDoc hsc_dflags (ppr srcspan)
@@ -1010,9 +1013,7 @@ data TickishType = ProfNotes | HpcTicks | Breakpoints | SourceNotes
 
 coveragePasses :: DynFlags -> [TickishType]
 coveragePasses dflags =
-    ifa (hscTarget dflags == HscInterpreted &&
-         not (gopt Opt_ExternalInterpreter dflags)) Breakpoints $
-         -- TODO: breakpoints don't work with -fexternal-interpreter yet
+    ifa (hscTarget dflags == HscInterpreted) Breakpoints $
     ifa (gopt Opt_Hpc dflags)                HpcTicks $
     ifa (gopt Opt_SccProfilingOn dflags &&
          profAuto dflags /= NoProfAuto)      ProfNotes $
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index d7fff69c86..da6085d2be 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -302,7 +302,7 @@ deSugar hsc_env
                          <- if not (isHsBootOrSig hsc_src)
                               then addTicksToBinds hsc_env mod mod_loc
                                        export_set (typeEnvTyCons type_env) binds
-                              else return (binds, hpcInfo, emptyModBreaks)
+                              else return (binds, hpcInfo, Nothing)
 
         ; (msgs, mb_res) <- initDs hsc_env mod rdr_env type_env fam_inst_env $
                        do { ds_ev_binds <- dsEvBinds ev_binds
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 4264b667e7..d0e74b0d08 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -306,7 +306,6 @@ Library
         TcIface
         FlagChecker
         Annotations
-        BreakArray
         CmdLineParser
         CodeOutput
         Config
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index e4d9ee4a3e..c11a36c7a3 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -454,7 +454,6 @@ compiler_stage2_dll0_MODULES = \
 	BasicTypes \
 	Binary \
 	BooleanFormula \
-	BreakArray \
 	BufWrite \
 	Class \
 	CmdLineParser \
diff --git a/compiler/ghci/ByteCodeAsm.hs b/compiler/ghci/ByteCodeAsm.hs
index 41450530fd..6974620dc5 100644
--- a/compiler/ghci/ByteCodeAsm.hs
+++ b/compiler/ghci/ByteCodeAsm.hs
@@ -32,6 +32,7 @@ import DynFlags
 import Outputable
 import Platform
 import Util
+import Unique
 
 -- From iserv
 import SizedSeq
@@ -86,11 +87,18 @@ bcoFreeNames bco
 -- bytecode address in this BCO.
 
 -- Top level assembler fn.
-assembleBCOs :: HscEnv -> [ProtoBCO Name] -> [TyCon] -> IO CompiledByteCode
-assembleBCOs hsc_env proto_bcos tycons = do
+assembleBCOs
+  :: HscEnv -> [ProtoBCO Name] -> [TyCon] -> Maybe ModBreaks
+  -> IO CompiledByteCode
+assembleBCOs hsc_env proto_bcos tycons modbreaks = do
   itblenv <- mkITbls hsc_env tycons
   bcos    <- mapM (assembleBCO (hsc_dflags hsc_env)) proto_bcos
-  return (ByteCode bcos itblenv (concat (map protoBCOFFIs proto_bcos)))
+  return CompiledByteCode
+    { bc_bcos = bcos
+    , bc_itbls =  itblenv
+    , bc_ffis = concat (map protoBCOFFIs proto_bcos)
+    , bc_breaks = modbreaks
+    }
 
 assembleBCO :: DynFlags -> ProtoBCO Name -> IO UnlinkedBCO
 assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = do
@@ -356,11 +364,11 @@ assembleI dflags i = case i of
   RETURN_UBX rep           -> emit (return_ubx rep) []
   CCALL off m_addr i       -> do np <- addr m_addr
                                  emit bci_CCALL [SmallOp off, Op np, SmallOp i]
-  BRK_FUN array index info cc -> do p1 <- ptr (BCOPtrArray array)
-                                    p2 <- ptr (BCOPtrBreakInfo info)
-                                    np <- addr cc
-                                    emit bci_BRK_FUN [Op p1, SmallOp index,
-                                                      Op p2, Op np]
+  BRK_FUN index uniq cc    -> do p1 <- ptr BCOPtrBreakArray
+                                 q <- int (getKey uniq)
+                                 np <- addr cc
+                                 emit bci_BRK_FUN [Op p1, SmallOp index,
+                                                   Op q, Op np]
 
   where
     literal (MachLabel fs (Just sz) _)
@@ -474,14 +482,7 @@ mkLitI64 dflags ii
    | otherwise
    = panic "mkLitI64: Bad wORD_SIZE"
 
-mkLitI i
-   = runST (do
-        arr <- newArray_ ((0::Int),0)
-        writeArray arr 0 i
-        i_arr <- castSTUArray arr
-        w0 <- readArray i_arr 0
-        return [w0 :: Word]
-     )
+mkLitI i = [fromIntegral i :: Word]
 
 iNTERP_STACK_CHECK_THRESH :: Int
 iNTERP_STACK_CHECK_THRESH = INTERP_STACK_CHECK_THRESH
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 4311fcddea..4c9e0b4ea9 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, MagicHash #-}
+{-# LANGUAGE CPP, MagicHash, RecordWildCards #-}
 --
 --  (c) The University of Glasgow 2002-2006
 --
@@ -44,6 +44,7 @@ import StgCmmLayout     ( ArgRep(..), toArgRep, argRepSizeW )
 import SMRep
 import Bitmap
 import OrdList
+import Maybes
 
 import Data.List
 import Foreign
@@ -51,16 +52,17 @@ import Control.Monad
 import Data.Char
 
 import UniqSupply
-import BreakArray
-import Data.Maybe
 import Module
 import Control.Arrow ( second )
 
 import Data.Array
 import Data.Map (Map)
+import Data.IntMap (IntMap)
 import qualified Data.Map as Map
+import qualified Data.IntMap as IntMap
 import qualified FiniteMap as Map
 import Data.Ord
+import GHC.Stack.CCS
 
 -- -----------------------------------------------------------------------------
 -- Generating byte code for a complete module
@@ -69,9 +71,9 @@ byteCodeGen :: HscEnv
             -> Module
             -> CoreProgram
             -> [TyCon]
-            -> ModBreaks
+            -> Maybe ModBreaks
             -> IO CompiledByteCode
-byteCodeGen hsc_env this_mod binds tycs modBreaks
+byteCodeGen hsc_env this_mod binds tycs mb_modBreaks
    = do let dflags = hsc_dflags hsc_env
         showPass dflags "ByteCodeGen"
 
@@ -79,8 +81,9 @@ byteCodeGen hsc_env this_mod binds tycs modBreaks
                         | (bndr, rhs) <- flattenBinds binds]
 
         us <- mkSplitUniqSupply 'y'
-        (BcM_State _hsc_env _us _this_mod _final_ctr ffis _, proto_bcos)
-           <- runBc hsc_env us this_mod modBreaks (mapM schemeTopBind flatBinds)
+        (BcM_State{..}, proto_bcos) <-
+           runBc hsc_env us this_mod mb_modBreaks $
+             mapM schemeTopBind flatBinds
 
         when (notNull ffis)
              (panic "ByteCodeGen.byteCodeGen: missing final emitBc?")
@@ -89,12 +92,14 @@ byteCodeGen hsc_env this_mod binds tycs modBreaks
            "Proto-BCOs" (vcat (intersperse (char ' ') (map ppr proto_bcos)))
 
         assembleBCOs hsc_env proto_bcos tycs
+          (case modBreaks of
+             Nothing -> Nothing
+             Just mb -> Just mb{ modBreaks_breakInfo = breakInfo })
 
 -- -----------------------------------------------------------------------------
 -- Generating byte code for an expression
 
--- Returns: (the root BCO for this expression,
---           a list of auxilary BCOs resulting from compiling closures)
+-- Returns: the root BCO for this expression
 coreExprToBCOs :: HscEnv
                -> Module
                -> CoreExpr
@@ -111,8 +116,8 @@ coreExprToBCOs hsc_env this_mod expr
       -- the uniques are needed to generate fresh variables when we introduce new
       -- let bindings for ticked expressions
       us <- mkSplitUniqSupply 'y'
-      (BcM_State _dflags _us _this_mod _final_ctr mallocd _ , proto_bco)
-         <- runBc hsc_env us this_mod emptyModBreaks $
+      (BcM_State _dflags _us _this_mod _final_ctr mallocd _ _ , proto_bco)
+         <- runBc hsc_env us this_mod Nothing $
               schemeTopBind (invented_id, simpleFreeVars expr)
 
       when (notNull mallocd)
@@ -331,22 +336,18 @@ schemeER_wrk :: Word -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList
 schemeER_wrk d p rhs
   | AnnTick (Breakpoint tick_no fvs) (_annot, newRhs) <- rhs
   = do  code <- schemeE (fromIntegral d) 0 p newRhs
-        flag_arr <- getBreakArray
         cc_arr <- getCCArray
-        this_mod <- getCurrentModule
+        this_mod <- moduleName <$> getCurrentModule
         let idOffSets = getVarOffSets d p fvs
-        let breakInfo = BreakInfo
-                        { breakInfo_module = this_mod
-                        , breakInfo_number = tick_no
-                        , breakInfo_vars = idOffSets
-                        , breakInfo_resty = exprType (deAnnotate' newRhs)
+        let breakInfo = CgBreakInfo
+                        { cgb_vars = idOffSets
+                        , cgb_resty = exprType (deAnnotate' newRhs)
                         }
+        newBreakInfo tick_no breakInfo
         dflags <- getDynFlags
         let cc | interpreterProfiled dflags = cc_arr ! tick_no
                | otherwise = toRemotePtr nullPtr
-        let breakInstr = case flag_arr of
-                         BA arr# ->
-                             BRK_FUN arr# (fromIntegral tick_no) breakInfo cc
+        let breakInstr = BRK_FUN (fromIntegral tick_no) (getUnique this_mod) cc
         return $ breakInstr `consOL` code
    | otherwise = schemeE (fromIntegral d) 0 p rhs
 
@@ -1642,7 +1643,8 @@ data BcM_State
         , nextlabel   :: Word16          -- for generating local labels
         , ffis        :: [FFIInfo]       -- ffi info blocks, to free later
                                          -- Should be free()d when it is GCd
-        , modBreaks :: ModBreaks         -- info about breakpoints
+        , modBreaks   :: Maybe ModBreaks -- info about breakpoints
+        , breakInfo   :: IntMap CgBreakInfo
         }
 
 newtype BcM r = BcM (BcM_State -> IO (BcM_State, r))
@@ -1652,10 +1654,10 @@ ioToBc io = BcM $ \st -> do
   x <- io
   return (st, x)
 
-runBc :: HscEnv -> UniqSupply -> Module -> ModBreaks -> BcM r
+runBc :: HscEnv -> UniqSupply -> Module -> Maybe ModBreaks -> BcM r
       -> IO (BcM_State, r)
 runBc hsc_env us this_mod modBreaks (BcM m)
-   = m (BcM_State hsc_env us this_mod 0 [] modBreaks)
+   = m (BcM_State hsc_env us this_mod 0 [] modBreaks IntMap.empty)
 
 thenBc :: BcM a -> (a -> BcM b) -> BcM b
 thenBc (BcM expr) cont = BcM $ \st0 -> do
@@ -1695,7 +1697,7 @@ emitBc :: ([FFIInfo] -> ProtoBCO Name) -> BcM (ProtoBCO Name)
 emitBc bco
   = BcM $ \st -> return (st{ffis=[]}, bco (ffis st))
 
-recordFFIBc :: RemotePtr -> BcM ()
+recordFFIBc :: RemotePtr C_ffi_cif -> BcM ()
 recordFFIBc a
   = BcM $ \st -> return (st{ffis = FFIInfo a : ffis st}, ())
 
@@ -1711,11 +1713,15 @@ getLabelsBc n
   = BcM $ \st -> let ctr = nextlabel st
                  in return (st{nextlabel = ctr+n}, [ctr .. ctr+n-1])
 
-getBreakArray :: BcM BreakArray
-getBreakArray = BcM $ \st -> return (st, modBreaks_flags (modBreaks st))
+getCCArray :: BcM (Array BreakIndex (RemotePtr CostCentre))
+getCCArray = BcM $ \st ->
+  let breaks = expectJust "ByteCodeGen.getCCArray" $ modBreaks st in
+  return (st, modBreaks_ccs breaks)
 
-getCCArray :: BcM (Array BreakIndex RemotePtr {- CCostCentre -})
-getCCArray = BcM $ \st -> return (st, modBreaks_ccs (modBreaks st))
+
+newBreakInfo :: BreakIndex -> CgBreakInfo -> BcM ()
+newBreakInfo ix info = BcM $ \st ->
+  return (st{breakInfo = IntMap.insert ix info (breakInfo st)}, ())
 
 newUnique :: BcM Unique
 newUnique = BcM $
diff --git a/compiler/ghci/ByteCodeInstr.hs b/compiler/ghci/ByteCodeInstr.hs
index 74c4f9692e..985bec4429 100644
--- a/compiler/ghci/ByteCodeInstr.hs
+++ b/compiler/ghci/ByteCodeInstr.hs
@@ -14,11 +14,13 @@ module ByteCodeInstr (
 
 import ByteCodeTypes
 import GHCi.RemoteTypes
+import GHCi.FFI (C_ffi_cif)
 import StgCmmLayout     ( ArgRep(..) )
 import PprCore
 import Outputable
 import FastString
 import Name
+import Unique
 import Id
 import CoreSyn
 import Literal
@@ -27,8 +29,8 @@ import VarSet
 import PrimOp
 import SMRep
 
-import GHC.Exts
 import Data.Word
+import GHC.Stack.CCS (CostCentre)
 
 -- ----------------------------------------------------------------------------
 -- Bytecode instructions
@@ -125,7 +127,7 @@ data BCInstr
 
    -- For doing calls to C (via glue code generated by libffi)
    | CCALL            Word16    -- stack frame size
-                      RemotePtr -- addr of the glue code
+                      (RemotePtr C_ffi_cif) -- addr of the glue code
                       Word16    -- whether or not the call is interruptible
                                 -- (XXX: inefficient, but I don't know
                                 -- what the alignment constraints are.)
@@ -140,7 +142,7 @@ data BCInstr
    | RETURN_UBX ArgRep -- return an unlifted value, here's its rep
 
    -- Breakpoints
-   | BRK_FUN          (MutableByteArray# RealWorld) Word16 BreakInfo RemotePtr
+   | BRK_FUN          Word16 Unique (RemotePtr CostCentre)
 
 -- -----------------------------------------------------------------------------
 -- Printing bytecode instructions
@@ -240,7 +242,7 @@ instance Outputable BCInstr where
    ppr ENTER                 = text "ENTER"
    ppr RETURN                = text "RETURN"
    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
-   ppr (BRK_FUN _breakArray index info _cc) = text "BRK_FUN" <+> text "<array>" <+> ppr index <+> ppr info <+> text "<cc>"
+   ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> ppr uniq <+> text "<cc>"
 
 -- -----------------------------------------------------------------------------
 -- The stack use, in words, of each bytecode insn.  These _must_ be
diff --git a/compiler/ghci/ByteCodeItbls.hs b/compiler/ghci/ByteCodeItbls.hs
index 5a3e6d3e1a..4e1c828a4d 100644
--- a/compiler/ghci/ByteCodeItbls.hs
+++ b/compiler/ghci/ByteCodeItbls.hs
@@ -11,7 +11,6 @@ module ByteCodeItbls ( mkITbls ) where
 
 import ByteCodeTypes
 import GHCi
-import GHCi.RemoteTypes
 import DynFlags
 import HscTypes
 import Name             ( Name, getName )
@@ -70,4 +69,4 @@ make_constr_itbls hsc_env cons =
          descr = dataConIdentity dcon
 
      r <- iservCmd hsc_env (MkConInfoTable  ptrs' nptrs_really conNo descr)
-     return (getName dcon, ItblPtr (fromRemotePtr r))
+     return (getName dcon, ItblPtr r)
diff --git a/compiler/ghci/ByteCodeLink.hs b/compiler/ghci/ByteCodeLink.hs
index aa92ecc610..74f490b8fd 100644
--- a/compiler/ghci/ByteCodeLink.hs
+++ b/compiler/ghci/ByteCodeLink.hs
@@ -22,6 +22,7 @@ module ByteCodeLink (
 import GHCi.RemoteTypes
 import GHCi.ResolvedBCO
 import GHCi.InfoTable
+import GHCi.BreakArray
 import SizedSeq
 
 import GHCi
@@ -60,15 +61,16 @@ extendClosureEnv cl_env pairs
 -}
 
 linkBCO
-  :: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> UnlinkedBCO
+  :: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> RemoteRef BreakArray
+  -> UnlinkedBCO
   -> IO ResolvedBCO
-linkBCO hsc_env ie ce bco_ix
+linkBCO hsc_env ie ce bco_ix breakarray
            (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do
   lits <- mapM (lookupLiteral hsc_env ie) (ssElts lits0)
-  ptrs <- mapM (resolvePtr hsc_env ie ce bco_ix) (ssElts ptrs0)
+  ptrs <- mapM (resolvePtr hsc_env ie ce bco_ix breakarray) (ssElts ptrs0)
   return (ResolvedBCO arity insns bitmap
-            (listArray (0, fromIntegral (sizeSS lits0)-1) lits)
-            (addListToSS emptySS ptrs))
+              (listArray (0, fromIntegral (sizeSS lits0)-1) lits)
+              (addListToSS emptySS ptrs))
 
 lookupLiteral :: HscEnv -> ItblEnv -> BCONPtr -> IO Word
 lookupLiteral _ _ (BCONPtrWord lit) = return lit
@@ -79,7 +81,7 @@ lookupLiteral hsc_env ie (BCONPtrItbl nm)  = do
   Ptr a# <- lookupIE hsc_env ie nm
   return (W# (int2Word# (addr2Int# a#)))
 lookupLiteral hsc_env _ (BCONPtrStr bs) = do
-  fromIntegral . ptrToWordPtr <$> mallocData hsc_env bs
+  fromIntegral . ptrToWordPtr . fromRemotePtr <$> mallocData hsc_env bs
 
 lookupStaticPtr :: HscEnv -> FastString -> IO (Ptr ())
 lookupStaticPtr hsc_env addr_of_label_string = do
@@ -89,26 +91,26 @@ lookupStaticPtr hsc_env addr_of_label_string = do
     Nothing  -> linkFail "ByteCodeLink: can't find label"
                   (unpackFS addr_of_label_string)
 
-lookupIE :: HscEnv -> ItblEnv -> Name -> IO (Ptr a)
+lookupIE :: HscEnv -> ItblEnv -> Name -> IO (Ptr ())
 lookupIE hsc_env ie con_nm =
   case lookupNameEnv ie con_nm of
-    Just (_, ItblPtr a) -> return (castPtr (conInfoPtr a))
+    Just (_, ItblPtr a) -> return (conInfoPtr (fromRemotePtr (castRemotePtr a)))
     Nothing -> do -- try looking up in the object files.
        let sym_to_find1 = nameToCLabel con_nm "con_info"
        m <- lookupSymbol hsc_env sym_to_find1
        case m of
-          Just addr -> return (castPtr addr)
+          Just addr -> return addr
           Nothing
              -> do -- perhaps a nullary constructor?
                    let sym_to_find2 = nameToCLabel con_nm "static_info"
                    n <- lookupSymbol hsc_env sym_to_find2
                    case n of
-                      Just addr -> return (castPtr addr)
+                      Just addr -> return addr
                       Nothing   -> linkFail "ByteCodeLink.lookupIE"
                                       (unpackFS sym_to_find1 ++ " or " ++
                                        unpackFS sym_to_find2)
 
-lookupPrimOp :: HscEnv -> PrimOp -> IO RemotePtr
+lookupPrimOp :: HscEnv -> PrimOp -> IO (RemotePtr ())
 lookupPrimOp hsc_env primop = do
   let sym_to_find = primopToCLabel primop "closure"
   m <- lookupSymbol hsc_env (mkFastString sym_to_find)
@@ -117,13 +119,14 @@ lookupPrimOp hsc_env primop = do
     Nothing -> linkFail "ByteCodeLink.lookupCE(primop)" sym_to_find
 
 resolvePtr
-  :: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> BCOPtr
+  :: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> RemoteRef BreakArray
+  -> BCOPtr
   -> IO ResolvedBCOPtr
-resolvePtr hsc_env _ie ce bco_ix (BCOPtrName nm)
+resolvePtr hsc_env _ie ce bco_ix _ (BCOPtrName nm)
   | Just ix <- lookupNameEnv bco_ix nm =
     return (ResolvedBCORef ix) -- ref to another BCO in this group
   | Just (_, rhv) <- lookupNameEnv ce nm =
-    return (ResolvedBCOPtr (unsafeForeignHValueToHValueRef rhv))
+    return (ResolvedBCOPtr (unsafeForeignRefToRemoteRef rhv))
   | otherwise =
     ASSERT2(isExternalName nm, ppr nm)
     do let sym_to_find = nameToCLabel nm "closure"
@@ -131,14 +134,12 @@ resolvePtr hsc_env _ie ce bco_ix (BCOPtrName nm)
        case m of
          Just p -> return (ResolvedBCOStaticPtr (toRemotePtr p))
          Nothing -> linkFail "ByteCodeLink.lookupCE" (unpackFS sym_to_find)
-resolvePtr hsc_env _ _ _ (BCOPtrPrimOp op) =
+resolvePtr hsc_env _ _ _ _ (BCOPtrPrimOp op) =
   ResolvedBCOStaticPtr <$> lookupPrimOp hsc_env op
-resolvePtr hsc_env ie ce bco_ix (BCOPtrBCO bco) =
-  ResolvedBCOPtrBCO <$> linkBCO hsc_env ie ce bco_ix bco
-resolvePtr _ _ _ _ (BCOPtrBreakInfo break_info) =
-  return (ResolvedBCOPtrLocal (unsafeCoerce# break_info))
-resolvePtr _ _ _ _ (BCOPtrArray break_array) =
-  return (ResolvedBCOPtrLocal (unsafeCoerce# break_array))
+resolvePtr hsc_env ie ce bco_ix breakarray (BCOPtrBCO bco) =
+  ResolvedBCOPtrBCO <$> linkBCO hsc_env ie ce bco_ix breakarray bco
+resolvePtr _ _ _ _ breakarray BCOPtrBreakArray =
+  return (ResolvedBCOPtrBreakArray breakarray)
 
 linkFail :: String -> String -> IO a
 linkFail who what
diff --git a/compiler/ghci/ByteCodeTypes.hs b/compiler/ghci/ByteCodeTypes.hs
index 500fd77c5b..944000a24b 100644
--- a/compiler/ghci/ByteCodeTypes.hs
+++ b/compiler/ghci/ByteCodeTypes.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MagicHash, RecordWildCards #-}
 --
 --  (c) The University of Glasgow 2002-2006
 --
@@ -8,43 +8,55 @@ module ByteCodeTypes
   ( CompiledByteCode(..), FFIInfo(..)
   , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
   , ItblEnv, ItblPtr(..)
-  , BreakInfo(..)
+  , CgBreakInfo(..)
+  , ModBreaks (..), BreakIndex, emptyModBreaks
+  , CCostCentre
   ) where
 
 import FastString
 import Id
-import Module
 import Name
 import NameEnv
 import Outputable
 import PrimOp
 import SizedSeq
 import Type
+import SrcLoc
+import GHCi.BreakArray
 import GHCi.RemoteTypes
+import GHCi.FFI
+import GHCi.InfoTable
 
 import Foreign
+import Data.Array
 import Data.Array.Base  ( UArray(..) )
 import Data.ByteString (ByteString)
-import GHC.Exts
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import GHC.Stack.CCS
 
+-- -----------------------------------------------------------------------------
+-- Compiled Byte Code
 
-data CompiledByteCode
-  = ByteCode [UnlinkedBCO] -- Bunch of interpretable bindings
-             ItblEnv       -- A mapping from DataCons to their itbls
-             [FFIInfo]     -- ffi blocks we allocated
+data CompiledByteCode = CompiledByteCode
+  { bc_bcos   :: [UnlinkedBCO]  -- Bunch of interpretable bindings
+  , bc_itbls  :: ItblEnv        -- A mapping from DataCons to their itbls
+  , bc_ffis   :: [FFIInfo]      -- ffi blocks we allocated
+  , bc_breaks :: Maybe ModBreaks -- breakpoint info (Nothing if we're not
+                                 -- creating breakpoints, for some reason)
+  }
                 -- ToDo: we're not tracking strings that we malloc'd
-
-newtype FFIInfo = FFIInfo RemotePtr
+newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif)
   deriving Show
 
 instance Outputable CompiledByteCode where
-  ppr (ByteCode bcos _ _) = ppr bcos
+  ppr CompiledByteCode{..} = ppr bc_bcos
 
 type ItblEnv = NameEnv (Name, ItblPtr)
         -- We need the Name in the range so we know which
         -- elements to filter out when unloading a module
 
-newtype ItblPtr = ItblPtr (Ptr ()) deriving Show
+newtype ItblPtr = ItblPtr (RemotePtr StgInfoTable) deriving Show
 
 data UnlinkedBCO
    = UnlinkedBCO {
@@ -60,8 +72,7 @@ data BCOPtr
   = BCOPtrName   Name
   | BCOPtrPrimOp PrimOp
   | BCOPtrBCO    UnlinkedBCO
-  | BCOPtrBreakInfo  BreakInfo
-  | BCOPtrArray (MutableByteArray# RealWorld)
+  | BCOPtrBreakArray  -- a pointer to this module's BreakArray
 
 data BCONPtr
   = BCONPtrWord  Word
@@ -69,12 +80,11 @@ data BCONPtr
   | BCONPtrItbl  Name
   | BCONPtrStr   ByteString
 
-data BreakInfo
-   = BreakInfo
-   { breakInfo_module :: Module
-   , breakInfo_number :: {-# UNPACK #-} !Int
-   , breakInfo_vars   :: [(Id,Word16)]
-   , breakInfo_resty  :: Type
+-- | Information about a breakpoint that we know at code-generation time
+data CgBreakInfo
+   = CgBreakInfo
+   { cgb_vars   :: [(Id,Word16)]
+   , cgb_resty  :: Type
    }
 
 instance Outputable UnlinkedBCO where
@@ -83,9 +93,46 @@ instance Outputable UnlinkedBCO where
              ppr (sizeSS lits), text "lits",
              ppr (sizeSS ptrs), text "ptrs" ]
 
-instance Outputable BreakInfo where
-   ppr info = text "BreakInfo" <+>
-              parens (ppr (breakInfo_module info) <+>
-                      ppr (breakInfo_number info) <+>
-                      ppr (breakInfo_vars info) <+>
-                      ppr (breakInfo_resty info))
+instance Outputable CgBreakInfo where
+   ppr info = text "CgBreakInfo" <+>
+              parens (ppr (cgb_vars info) <+>
+                      ppr (cgb_resty info))
+
+-- -----------------------------------------------------------------------------
+-- Breakpoints
+
+-- | Breakpoint index
+type BreakIndex = Int
+
+-- | C CostCentre type
+data CCostCentre
+
+-- | All the information about the breakpoints for a module
+data ModBreaks
+   = ModBreaks
+   { modBreaks_flags :: ForeignRef BreakArray
+        -- ^ The array of flags, one per breakpoint,
+        -- indicating which breakpoints are enabled.
+   , modBreaks_locs :: !(Array BreakIndex SrcSpan)
+        -- ^ An array giving the source span of each breakpoint.
+   , modBreaks_vars :: !(Array BreakIndex [OccName])
+        -- ^ An array giving the names of the free variables at each breakpoint.
+   , modBreaks_decls :: !(Array BreakIndex [String])
+        -- ^ An array giving the names of the declarations enclosing each breakpoint.
+   , modBreaks_ccs :: !(Array BreakIndex (RemotePtr CostCentre))
+        -- ^ Array pointing to cost centre for each breakpoint
+   , modBreaks_breakInfo :: IntMap CgBreakInfo
+        -- ^ info about each breakpoint from the bytecode generator
+   }
+
+-- | Construct an empty ModBreaks
+emptyModBreaks :: ModBreaks
+emptyModBreaks = ModBreaks
+   { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"
+         -- ToDo: can we avoid this?
+   , modBreaks_locs  = array (0,-1) []
+   , modBreaks_vars  = array (0,-1) []
+   , modBreaks_decls = array (0,-1) []
+   , modBreaks_ccs = array (0,-1) []
+   , modBreaks_breakInfo = IntMap.empty
+   }
diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 5c6a02d3ff..81aab36ea9 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -119,7 +119,7 @@ bindSuspensions t = do
       let ids = [ mkVanillaGlobal name ty
                 | (name,ty) <- zip names tys]
           new_ic = extendInteractiveContextWithIds ictxt ids
-      fhvs <- liftIO $ mapM (mkFinalizedHValue hsc_env <=< mkHValueRef) hvals
+      fhvs <- liftIO $ mapM (mkFinalizedHValue hsc_env <=< mkRemoteRef) hvals
       liftIO $ extendLinkEnv (zip names fhvs)
       modifySession $ \_ -> hsc_env {hsc_IC = new_ic }
       return t'
@@ -173,7 +173,7 @@ showTerm term = do
            let noop_log _ _ _ _ _ = return ()
                expr = "show " ++ showPpr dflags bname
            _ <- GHC.setSessionDynFlags dflags{log_action=noop_log}
-           fhv <- liftIO $ mkFinalizedHValue hsc_env =<< mkHValueRef val
+           fhv <- liftIO $ mkFinalizedHValue hsc_env =<< mkRemoteRef val
            txt_ <- withExtendedLinkEnv [(bname, fhv)]
                                        (GHC.compileExpr expr)
            let myprec = 10 -- application precedence. TODO Infix constructors
diff --git a/compiler/ghci/GHCi.hs b/compiler/ghci/GHCi.hs
index b7e0eb33f5..2b4abddc0f 100644
--- a/compiler/ghci/GHCi.hs
+++ b/compiler/ghci/GHCi.hs
@@ -6,7 +6,7 @@
 --
 module GHCi
   ( -- * High-level interface to the interpreter
-    evalStmt, EvalStatus(..), EvalResult(..), EvalExpr(..)
+    evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..)
   , resumeStmt
   , abandonStmt
   , evalIO
@@ -15,6 +15,9 @@ module GHCi
   , mallocData
   , mkCostCentre
   , costCentreStackInfo
+  , newBreakArray
+  , enableBreakpoint
+  , breakpointStatus
 
   -- * The object-code linker
   , initObjLinker
@@ -43,6 +46,7 @@ module GHCi
 import GHCi.Message
 import GHCi.Run
 import GHCi.RemoteTypes
+import GHCi.BreakArray (BreakArray)
 import HscTypes
 import UniqFM
 import Panic
@@ -62,6 +66,8 @@ import Data.Binary
 import Data.ByteString (ByteString)
 import Data.IORef
 import Foreign
+import Foreign.C
+import GHC.Stack.CCS (CostCentre,CostCentreStack)
 import System.Exit
 #ifndef mingw32_HOST_OS
 import Data.Maybe
@@ -178,7 +184,8 @@ withIServ HscEnv{..} action =
 -- | Execute an action of type @IO [a]@, returning 'ForeignHValue's for
 -- each of the results.
 evalStmt
-  :: HscEnv -> Bool -> EvalExpr ForeignHValue -> IO (EvalStatus [ForeignHValue])
+  :: HscEnv -> Bool -> EvalExpr ForeignHValue
+  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
 evalStmt hsc_env step foreign_expr = do
   let dflags = hsc_dflags hsc_env
   status <- withExpr foreign_expr $ \expr ->
@@ -187,29 +194,32 @@ evalStmt hsc_env step foreign_expr = do
  where
   withExpr :: EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
   withExpr (EvalThis fhv) cont =
-    withForeignHValue fhv $ \hvref -> cont (EvalThis hvref)
+    withForeignRef fhv $ \hvref -> cont (EvalThis hvref)
   withExpr (EvalApp fl fr) cont =
     withExpr fl $ \fl' ->
     withExpr fr $ \fr' ->
     cont (EvalApp fl' fr')
 
-resumeStmt :: HscEnv -> Bool -> ForeignHValue -> IO (EvalStatus [ForeignHValue])
+resumeStmt
+  :: HscEnv -> Bool -> ForeignRef (ResumeContext [HValueRef])
+  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
 resumeStmt hsc_env step resume_ctxt = do
   let dflags = hsc_dflags hsc_env
-  status <- withForeignHValue resume_ctxt $ \rhv ->
+  status <- withForeignRef resume_ctxt $ \rhv ->
     iservCmd hsc_env (ResumeStmt (mkEvalOpts dflags step) rhv)
   handleEvalStatus hsc_env status
 
-abandonStmt :: HscEnv -> ForeignHValue -> IO ()
+abandonStmt :: HscEnv -> ForeignRef (ResumeContext [HValueRef]) -> IO ()
 abandonStmt hsc_env resume_ctxt = do
-  withForeignHValue resume_ctxt $ \rhv ->
+  withForeignRef resume_ctxt $ \rhv ->
     iservCmd hsc_env (AbandonStmt rhv)
 
 handleEvalStatus
-  :: HscEnv -> EvalStatus [HValueRef] -> IO (EvalStatus [ForeignHValue])
+  :: HscEnv -> EvalStatus [HValueRef]
+  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
 handleEvalStatus hsc_env status =
   case status of
-    EvalBreak a b c d e -> return (EvalBreak a b c d e)
+    EvalBreak a b c d e f -> return (EvalBreak a b c d e f)
     EvalComplete alloc res ->
       EvalComplete alloc <$> addFinalizer res
  where
@@ -220,38 +230,53 @@ handleEvalStatus hsc_env status =
 -- | Execute an action of type @IO ()@
 evalIO :: HscEnv -> ForeignHValue -> IO ()
 evalIO hsc_env fhv = do
-  liftIO $ withForeignHValue fhv $ \fhv ->
+  liftIO $ withForeignRef fhv $ \fhv ->
     iservCmd hsc_env (EvalIO fhv) >>= fromEvalResult
 
 -- | Execute an action of type @IO String@
 evalString :: HscEnv -> ForeignHValue -> IO String
 evalString hsc_env fhv = do
-  liftIO $ withForeignHValue fhv $ \fhv ->
+  liftIO $ withForeignRef fhv $ \fhv ->
     iservCmd hsc_env (EvalString fhv) >>= fromEvalResult
 
 -- | Execute an action of type @String -> IO String@
 evalStringToIOString :: HscEnv -> ForeignHValue -> String -> IO String
 evalStringToIOString hsc_env fhv str = do
-  liftIO $ withForeignHValue fhv $ \fhv ->
+  liftIO $ withForeignRef fhv $ \fhv ->
     iservCmd hsc_env (EvalStringToString fhv str) >>= fromEvalResult
 
 
 -- | Allocate and store the given bytes in memory, returning a pointer
 -- to the memory in the remote process.
-mallocData :: HscEnv -> ByteString -> IO (Ptr ())
-mallocData hsc_env bs = fromRemotePtr <$> iservCmd hsc_env (MallocData bs)
+mallocData :: HscEnv -> ByteString -> IO (RemotePtr ())
+mallocData hsc_env bs = iservCmd hsc_env (MallocData bs)
 
 mkCostCentre
-  :: HscEnv -> RemotePtr {- CChar -} -> String -> String
-  -> IO RemotePtr {- CCostCentre -}
+  :: HscEnv -> RemotePtr CChar -> String -> String -> IO (RemotePtr CostCentre)
 mkCostCentre hsc_env c_module name src =
   iservCmd hsc_env (MkCostCentre c_module name src)
 
 
-costCentreStackInfo :: HscEnv -> RemotePtr {- CCostCentreStack -} -> IO [String]
+costCentreStackInfo :: HscEnv -> RemotePtr CostCentreStack -> IO [String]
 costCentreStackInfo hsc_env ccs =
   iservCmd hsc_env (CostCentreStackInfo ccs)
 
+newBreakArray :: HscEnv -> Int -> IO (ForeignRef BreakArray)
+newBreakArray hsc_env size = do
+  breakArray <- iservCmd hsc_env (NewBreakArray size)
+  mkFinalizedHValue hsc_env breakArray
+
+enableBreakpoint :: HscEnv -> ForeignRef BreakArray -> Int -> Bool -> IO ()
+enableBreakpoint hsc_env ref ix b = do
+  withForeignRef ref $ \breakarray ->
+    iservCmd hsc_env (EnableBreakpoint breakarray ix b)
+
+breakpointStatus :: HscEnv -> ForeignRef BreakArray -> Int -> IO Bool
+breakpointStatus hsc_env ref ix = do
+  withForeignRef ref $ \breakarray ->
+    iservCmd hsc_env (BreakpointStatus breakarray ix)
+
+
 -- -----------------------------------------------------------------------------
 -- Interface to the object-code linker
 
@@ -459,14 +484,15 @@ principle it would probably be ok, but it seems less hairy this way.
 
 -- | Creates a 'ForeignHValue' that will automatically release the
 -- 'HValueRef' when it is no longer referenced.
-mkFinalizedHValue :: HscEnv -> HValueRef -> IO ForeignHValue
-mkFinalizedHValue HscEnv{..} hvref = mkForeignHValue hvref free
+mkFinalizedHValue :: HscEnv -> RemoteRef a -> IO (ForeignRef a)
+mkFinalizedHValue HscEnv{..} rref = mkForeignRef rref free
  where
   !external = gopt Opt_ExternalInterpreter hsc_dflags
+  hvref = toHValueRef rref
 
   free :: IO ()
   free
-    | not external = freeHValueRef hvref
+    | not external = freeRemoteRef hvref
     | otherwise =
       modifyMVar_ hsc_iserv $ \mb_iserv ->
         case mb_iserv of
@@ -481,19 +507,19 @@ freeHValueRefs hsc_env refs = iservCmd hsc_env (FreeHValueRefs refs)
 -- | Convert a 'ForeignHValue' to an 'HValue' directly.  This only works
 -- when the interpreter is running in the same process as the compiler,
 -- so it fails when @-fexternal-interpreter@ is on.
-wormhole :: DynFlags -> ForeignHValue -> IO HValue
-wormhole dflags r = wormholeRef dflags (unsafeForeignHValueToHValueRef r)
+wormhole :: DynFlags -> ForeignRef a -> IO a
+wormhole dflags r = wormholeRef dflags (unsafeForeignRefToRemoteRef r)
 
 -- | Convert an 'HValueRef' to an 'HValue' directly.  This only works
 -- when the interpreter is running in the same process as the compiler,
 -- so it fails when @-fexternal-interpreter@ is on.
-wormholeRef :: DynFlags -> HValueRef -> IO HValue
+wormholeRef :: DynFlags -> RemoteRef a -> IO a
 wormholeRef dflags r
   | gopt Opt_ExternalInterpreter dflags
   = throwIO (InstallationError
       "this operation requires -fno-external-interpreter")
   | otherwise
-  = localHValueRef r
+  = localRef r
 
 -- -----------------------------------------------------------------------------
 -- Misc utils
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index 7e86e1135f..8f1107fc26 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, NondecreasingIndentation, TupleSections #-}
+{-# LANGUAGE CPP, NondecreasingIndentation, TupleSections, RecordWildCards #-}
 {-# OPTIONS_GHC -fno-cse #-}
 --
 --  (c) The University of Glasgow 2002-2006
@@ -496,7 +496,10 @@ linkExpr hsc_env span root_ul_bco
 
      -- Link the necessary packages and linkables
 
-   ; [(_,root_hvref)] <- linkSomeBCOs hsc_env ie ce [root_ul_bco]
+   ; let nobreakarray = error "no break array"
+         bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)]
+   ; resolved <- linkBCO hsc_env ie ce bco_ix nobreakarray root_ul_bco
+   ; [root_hvref] <- iservCmd hsc_env (CreateBCOs [resolved])
    ; fhv <- mkFinalizedHValue hsc_env root_hvref
    ; return (pls, fhv)
    }}}
@@ -703,7 +706,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
   ********************************************************************* -}
 
 linkDecls :: HscEnv -> SrcSpan -> CompiledByteCode -> IO ()
-linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv _) = do
+linkDecls hsc_env span cbc@CompiledByteCode{..} = do
     -- Initialise the linker (if it's not been done already)
     initDynLinker hsc_env
 
@@ -717,17 +720,17 @@ linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv _) = do
       else do
 
     -- Link the expression itself
-    let ie = plusNameEnv (itbl_env pls) itblEnv
+    let ie = plusNameEnv (itbl_env pls) bc_itbls
         ce = closure_env pls
 
     -- Link the necessary packages and linkables
-    new_bindings <- linkSomeBCOs hsc_env ie ce unlinkedBCOs
+    new_bindings <- linkSomeBCOs hsc_env ie ce [cbc]
     nms_fhvs <- makeForeignNamedHValueRefs hsc_env new_bindings
     let pls2 = pls { closure_env = extendClosureEnv ce nms_fhvs
                    , itbl_env    = ie }
     return (pls2, ())
   where
-    free_names =  concatMap (nameSetElems . bcoFreeNames) unlinkedBCOs
+    free_names =  concatMap (nameSetElems . bcoFreeNames) bc_bcos
 
     needed_mods :: [Module]
     needed_mods = [ nameModule n | n <- free_names,
@@ -914,12 +917,11 @@ dynLinkBCOs hsc_env pls bcos = do
             cbcs      = map byteCodeOfObject unlinkeds
 
 
-            ul_bcos    = [b | ByteCode bs _ _  <- cbcs, b <- bs]
-            ies        = [ie | ByteCode _ ie _ <- cbcs]
+            ies        = map bc_itbls cbcs
             gce       = closure_env pls
             final_ie  = foldr plusNameEnv (itbl_env pls) ies
 
-        names_and_refs <- linkSomeBCOs hsc_env final_ie gce ul_bcos
+        names_and_refs <- linkSomeBCOs hsc_env final_ie gce cbcs
 
         -- We only want to add the external ones to the ClosureEnv
         let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs
@@ -929,28 +931,36 @@ dynLinkBCOs hsc_env pls bcos = do
         -- Wrap finalizers on the ones we want to keep
         new_binds <- makeForeignNamedHValueRefs hsc_env to_add
 
-        let pls2 = pls1 { closure_env = extendClosureEnv gce new_binds,
-                          itbl_env    = final_ie }
-
-        return pls2
+        return pls1 { closure_env = extendClosureEnv gce new_binds,
+                      itbl_env    = final_ie }
 
 -- Link a bunch of BCOs and return references to their values
 linkSomeBCOs :: HscEnv
              -> ItblEnv
              -> ClosureEnv
-             -> [UnlinkedBCO]
+             -> [CompiledByteCode]
              -> IO [(Name,HValueRef)]
                         -- The returned HValueRefs are associated 1-1 with
                         -- the incoming unlinked BCOs.  Each gives the
                         -- value of the corresponding unlinked BCO
 
-linkSomeBCOs _ _ _ [] = return []
-linkSomeBCOs hsc_env ie ce ul_bcos = do
-  let names = map unlinkedBCOName ul_bcos
-      bco_ix = mkNameEnv (zip names [0..])
-  resolved <- mapM (linkBCO hsc_env ie ce bco_ix) ul_bcos
-  hvrefs <- iservCmd hsc_env (CreateBCOs resolved)
-  return (zip names hvrefs)
+linkSomeBCOs hsc_env ie ce mods = foldr fun do_link mods []
+ where
+  fun CompiledByteCode{..} inner accum =
+    case bc_breaks of
+      Nothing -> inner ((panic "linkSomeBCOs: no break array", bc_bcos) : accum)
+      Just mb -> withForeignRef (modBreaks_flags mb) $ \breakarray ->
+                   inner ((breakarray, bc_bcos) : accum)
+
+  do_link [] = return []
+  do_link mods = do
+    let flat = [ (breakarray, bco) | (breakarray, bcos) <- mods, bco <- bcos ]
+        names = map (unlinkedBCOName . snd) flat
+        bco_ix = mkNameEnv (zip names [0..])
+    resolved <- sequence [ linkBCO hsc_env ie ce bco_ix breakarray bco
+                         | (breakarray, bco) <- flat ]
+    hvrefs <- iservCmd hsc_env (CreateBCOs resolved)
+    return (zip names hvrefs)
 
 -- | Useful to apply to the result of 'linkSomeBCOs'
 makeForeignNamedHValueRefs
diff --git a/compiler/main/BreakArray.hs b/compiler/main/BreakArray.hs
deleted file mode 100644
index 447490266c..0000000000
--- a/compiler/main/BreakArray.hs
+++ /dev/null
@@ -1,132 +0,0 @@
-{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
-
--------------------------------------------------------------------------------
---
--- (c) The University of Glasgow 2007
---
--- | Break Arrays
---
--- An array of bytes, indexed by a breakpoint number (breakpointId in Tickish)
--- There is one of these arrays per module.
---
--- Each byte is
---   1 if the corresponding breakpoint is enabled
---   0 otherwise
---
--------------------------------------------------------------------------------
-
-module BreakArray
-    (
-      BreakArray
-#ifdef GHCI
-          (BA) -- constructor is exported only for ByteCodeGen
-#endif
-    , newBreakArray
-#ifdef GHCI
-    , getBreak
-    , setBreakOn
-    , setBreakOff
-    , showBreakArray
-#endif
-    ) where
-
-#ifdef GHCI
-import Control.Monad
-import Data.Word
-import GHC.Word
-
-import GHC.Exts
-import GHC.IO ( IO(..) )
-import System.IO.Unsafe ( unsafeDupablePerformIO )
-
-data BreakArray = BA (MutableByteArray# RealWorld)
-
-breakOff, breakOn :: Word8
-breakOn  = 1
-breakOff = 0
-
-showBreakArray :: BreakArray -> IO ()
-showBreakArray array = do
-    forM_ [0 .. (size array - 1)] $ \i -> do
-        val <- readBreakArray array i
-        putStr $ ' ' : show val
-    putStr "\n"
-
-setBreakOn :: BreakArray -> Int -> IO Bool
-setBreakOn array index
-    | safeIndex array index = do
-          writeBreakArray array index breakOn
-          return True
-    | otherwise = return False
-
-setBreakOff :: BreakArray -> Int -> IO Bool
-setBreakOff array index
-    | safeIndex array index = do
-          writeBreakArray array index breakOff
-          return True
-    | otherwise = return False
-
-getBreak :: BreakArray -> Int -> IO (Maybe Word8)
-getBreak array index
-    | safeIndex array index = do
-          val <- readBreakArray array index
-          return $ Just val
-    | otherwise = return Nothing
-
-safeIndex :: BreakArray -> Int -> Bool
-safeIndex array index = index < size array && index >= 0
-
-size :: BreakArray -> Int
-size (BA array) = size
-  where
-    -- We want to keep this operation pure. The mutable byte array
-    -- is never resized so this is safe.
-    size = unsafeDupablePerformIO $ sizeofMutableByteArray array
-
-    sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int
-    sizeofMutableByteArray arr =
-        IO $ \s -> case getSizeofMutableByteArray# arr s of
-                       (# s', n# #) -> (# s', I# n# #)
-
-allocBA :: Int -> IO BreakArray
-allocBA (I# sz) = IO $ \s1 ->
-    case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
-
--- create a new break array and initialise elements to zero
-newBreakArray :: Int -> IO BreakArray
-newBreakArray entries@(I# sz) = do
-    BA array <- allocBA entries
-    case breakOff of
-        W8# off -> do
-           let loop n | isTrue# (n ==# sz) = return ()
-                      | otherwise = do writeBA# array n off; loop (n +# 1#)
-           loop 0#
-    return $ BA array
-
-writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
-writeBA# array i word = IO $ \s ->
-    case writeWord8Array# array i word s of { s -> (# s, () #) }
-
-writeBreakArray :: BreakArray -> Int -> Word8 -> IO ()
-writeBreakArray (BA array) (I# i) (W8# word) = writeBA# array i word
-
-readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8
-readBA# array i = IO $ \s ->
-    case readWord8Array# array i s of { (# s, c #) -> (# s, W8# c #) }
-
-readBreakArray :: BreakArray -> Int -> IO Word8
-readBreakArray (BA array) (I# i) = readBA# array i
-
-#else /* !GHCI */
-
--- stub implementation to make main/, etc., code happier.
--- IOArray and IOUArray are increasingly non-portable,
--- still don't have quite the same interface, and (for GHCI)
--- presumably have a different representation.
-data BreakArray = Unspecified
-
-newBreakArray :: Int -> IO BreakArray
-newBreakArray _ = return Unspecified
-
-#endif /* GHCI */
-
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 17a72143b4..047e12e146 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -177,7 +177,7 @@ compileOne' m_tc_result mHscMessage
             let linkable = LM o_time this_mod [DotO object_filename]
             return hmi0 { hm_linkable = Just linkable }
         (HscRecomp cgguts summary, HscInterpreted) -> do
-            (hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env cgguts summary
+            (hasStub, comp_bc) <- hscInteractive hsc_env cgguts summary
 
             stub_o <- case hasStub of
                       Nothing -> return []
@@ -185,7 +185,7 @@ compileOne' m_tc_result mHscMessage
                           stub_o <- compileStub hsc_env stub_c
                           return [DotO stub_o]
 
-            let hs_unlinked = [BCOs comp_bc modBreaks]
+            let hs_unlinked = [BCOs comp_bc]
                 unlinked_time = ms_hs_date summary
               -- Why do we use the timestamp of the source file here,
               -- rather than the current time?  This works better in
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 957f48c6e1..31f809c716 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -145,7 +145,6 @@ module GHC (
         modInfoModBreaks,
         ModBreaks(..), BreakIndex,
         BreakInfo(breakInfo_number, breakInfo_module),
-        BreakArray, setBreakOn, setBreakOff, getBreak,
         InteractiveEval.back,
         InteractiveEval.forward,
 
@@ -290,8 +289,8 @@ module GHC (
 
 #ifdef GHCI
 import ByteCodeTypes
-import BreakArray
 import InteractiveEval
+import InteractiveEvalTypes
 import TcRnDriver       ( runTcInteractive )
 import GHCi
 import GHCi.RemoteTypes
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 558341aebc..7807f653e3 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1284,7 +1284,7 @@ hscGenHardCode hsc_env cgguts mod_summary output_filename = do
 hscInteractive :: HscEnv
                -> CgGuts
                -> ModSummary
-               -> IO (Maybe FilePath, CompiledByteCode, ModBreaks)
+               -> IO (Maybe FilePath, CompiledByteCode)
 #ifdef GHCI
 hscInteractive hsc_env cgguts mod_summary = do
     let dflags = hsc_dflags hsc_env
@@ -1311,7 +1311,7 @@ hscInteractive hsc_env cgguts mod_summary = do
     ------------------ Create f-x-dynamic C-side stuff ---
     (_istub_h_exists, istub_c_exists)
         <- outputForeignStubs dflags this_mod location foreign_stubs
-    return (istub_c_exists, comp_bc, mod_breaks)
+    return (istub_c_exists, comp_bc)
 #else
 hscInteractive _ _ = panic "GHC not compiled with interpreter"
 #endif
@@ -1705,7 +1705,7 @@ mkModGuts mod safe binds =
         mg_warns        = NoWarnings,
         mg_anns         = [],
         mg_hpc_info     = emptyHpcInfo False,
-        mg_modBreaks    = emptyModBreaks,
+        mg_modBreaks    = Nothing,
         mg_vect_info    = noVectInfo,
         mg_inst_env     = emptyInstEnv,
         mg_fam_inst_env = emptyFamInstEnv,
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 0a7682157e..9e049209f8 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -111,8 +111,7 @@ module HscTypes (
         HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
 
         -- * Breakpoints
-        ModBreaks (..), BreakIndex, emptyModBreaks,
-        CCostCentre,
+        ModBreaks (..), emptyModBreaks,
 
         -- * Vectorisation information
         VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
@@ -134,7 +133,7 @@ module HscTypes (
 #include "HsVersions.h"
 
 #ifdef GHCI
-import ByteCodeTypes        ( CompiledByteCode )
+import ByteCodeTypes
 import InteractiveEvalTypes ( Resume )
 import GHCi.Message         ( Pipe )
 import GHCi.RemoteTypes
@@ -176,7 +175,6 @@ import IfaceSyn
 import CoreSyn          ( CoreRule, CoreVect )
 import Maybes
 import Outputable
-import BreakArray
 import SrcLoc
 -- import Unique
 import UniqFM
@@ -195,7 +193,6 @@ import GHC.Serialized   ( Serialized )
 import Foreign
 import Control.Monad    ( guard, liftM, when, ap )
 import Control.Concurrent
-import Data.Array       ( Array, array )
 import Data.IORef
 import Data.Time
 import Data.Typeable    ( Typeable )
@@ -1099,7 +1096,7 @@ data ModGuts
         mg_warns     :: !Warnings,       -- ^ Warnings declared in the module
         mg_anns      :: [Annotation],    -- ^ Annotations declared in this module
         mg_hpc_info  :: !HpcInfo,        -- ^ Coverage tick boxes in the module
-        mg_modBreaks :: !ModBreaks,      -- ^ Breakpoints for the module
+        mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module
         mg_vect_decls:: ![CoreVect],     -- ^ Vectorisation declarations in this module
                                          --   (produced by desugarer & consumed by vectoriser)
         mg_vect_info :: !VectInfo,       -- ^ Pool of vectorised declarations in the module
@@ -1157,7 +1154,7 @@ data CgGuts
         cg_dep_pkgs  :: ![UnitId],    -- ^ Dependent packages, used to
                                          -- generate #includes for C code gen
         cg_hpc_info  :: !HpcInfo,        -- ^ Program coverage tick box information
-        cg_modBreaks :: !ModBreaks       -- ^ Module breakpoints
+        cg_modBreaks :: !(Maybe ModBreaks) -- ^ Module breakpoints
     }
 
 -----------------------------------
@@ -2819,12 +2816,16 @@ data Unlinked
    = DotO FilePath      -- ^ An object file (.o)
    | DotA FilePath      -- ^ Static archive file (.a)
    | DotDLL FilePath    -- ^ Dynamically linked library file (.so, .dll, .dylib)
-   | BCOs CompiledByteCode ModBreaks    -- ^ A byte-code object, lives only in memory
+   | BCOs CompiledByteCode    -- ^ A byte-code object, lives only in memory
 
 #ifndef GHCI
 data CompiledByteCode = CompiledByteCodeUndefined
-_unused :: CompiledByteCode
-_unused = CompiledByteCodeUndefined
+_unusedCompiledByteCode :: CompiledByteCode
+_unusedCompiledByteCode = CompiledByteCodeUndefined
+
+data ModBreaks = ModBreaksUndefined
+emptyModBreaks :: ModBreaks
+emptyModBreaks = ModBreaksUndefined
 #endif
 
 instance Outputable Unlinked where
@@ -2832,9 +2833,9 @@ instance Outputable Unlinked where
    ppr (DotA path)   = text "DotA" <+> text path
    ppr (DotDLL path) = text "DotDLL" <+> text path
 #ifdef GHCI
-   ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos
+   ppr (BCOs bcos) = text "BCOs" <+> ppr bcos
 #else
-   ppr (BCOs _ _)    = text "No byte code"
+   ppr (BCOs _)    = text "No byte code"
 #endif
 
 -- | Is this an actual file on disk we can link in somehow?
@@ -2857,50 +2858,6 @@ nameOfObject other       = pprPanic "nameOfObject" (ppr other)
 
 -- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable
 byteCodeOfObject :: Unlinked -> CompiledByteCode
-byteCodeOfObject (BCOs bc _) = bc
-byteCodeOfObject other       = pprPanic "byteCodeOfObject" (ppr other)
-
-{-
-************************************************************************
-*                                                                      *
-\subsection{Breakpoint Support}
-*                                                                      *
-************************************************************************
--}
+byteCodeOfObject (BCOs bc) = bc
+byteCodeOfObject other     = pprPanic "byteCodeOfObject" (ppr other)
 
--- | Breakpoint index
-type BreakIndex = Int
-
--- | C CostCentre type
-data CCostCentre
-
--- | All the information about the breakpoints for a given module
-data ModBreaks
-   = ModBreaks
-   { modBreaks_flags :: BreakArray
-        -- ^ The array of flags, one per breakpoint,
-        -- indicating which breakpoints are enabled.
-   , modBreaks_locs :: !(Array BreakIndex SrcSpan)
-        -- ^ An array giving the source span of each breakpoint.
-   , modBreaks_vars :: !(Array BreakIndex [OccName])
-        -- ^ An array giving the names of the free variables at each breakpoint.
-   , modBreaks_decls :: !(Array BreakIndex [String])
-        -- ^ An array giving the names of the declarations enclosing each breakpoint.
-#ifdef GHCI
-   , modBreaks_ccs :: !(Array BreakIndex (RemotePtr {- CCostCentre -}))
-        -- ^ Array pointing to cost centre for each breakpoint
-#endif
-   }
-
--- | Construct an empty ModBreaks
-emptyModBreaks :: ModBreaks
-emptyModBreaks = ModBreaks
-   { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"
-         -- ToDo: can we avoid this?
-   , modBreaks_locs  = array (0,-1) []
-   , modBreaks_vars  = array (0,-1) []
-   , modBreaks_decls = array (0,-1) []
-#ifdef GHCI
-   , modBreaks_ccs = array (0,-1) []
-#endif
-   }
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 7839f1b9ed..e1f2cfcbd0 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, UnboxedTuples,
-    RecordWildCards #-}
+    RecordWildCards, BangPatterns #-}
 
 -- -----------------------------------------------------------------------------
 --
@@ -84,7 +84,6 @@ import UniqFM
 import Maybes
 import ErrUtils
 import SrcLoc
-import BreakArray
 import RtClosureInspect
 import Outputable
 import FastString
@@ -95,6 +94,7 @@ import qualified Parser (parseStmt, parseModule, parseDeclaration)
 import System.Directory
 import Data.Dynamic
 import Data.Either
+import qualified Data.IntMap as IntMap
 import Data.List (find,intercalate)
 import StringBuffer (stringToStringBuffer)
 import Control.Monad
@@ -110,27 +110,23 @@ getResumeContext :: GhcMonad m => m [Resume]
 getResumeContext = withSession (return . ic_resume . hsc_IC)
 
 mkHistory :: HscEnv -> ForeignHValue -> BreakInfo -> History
-mkHistory hsc_env hval bi = let
-    decls = findEnclosingDecls hsc_env bi
-    in History hval bi decls
-
+mkHistory hsc_env hval bi = History hval bi (findEnclosingDecls hsc_env bi)
 
 getHistoryModule :: History -> Module
 getHistoryModule = breakInfo_module . historyBreakInfo
 
 getHistorySpan :: HscEnv -> History -> SrcSpan
-getHistorySpan hsc_env hist =
-   let inf = historyBreakInfo hist
-       num = breakInfo_number inf
-   in case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
-       Just hmi -> modBreaks_locs (getModBreaks hmi) ! num
-       _ -> panic "getHistorySpan"
+getHistorySpan hsc_env History{..} =
+  let BreakInfo{..} = historyBreakInfo in
+  case lookupUFM (hsc_HPT hsc_env) (moduleName breakInfo_module) of
+    Just hmi -> modBreaks_locs (getModBreaks hmi) ! breakInfo_number
+    _ -> panic "getHistorySpan"
 
 getModBreaks :: HomeModInfo -> ModBreaks
 getModBreaks hmi
   | Just linkable <- hm_linkable hmi,
-    [BCOs _ modBreaks] <- linkableUnlinked linkable
-  = modBreaks
+    [BCOs cbc] <- linkableUnlinked linkable
+  = fromMaybe emptyModBreaks (bc_breaks cbc)
   | otherwise
   = emptyModBreaks -- probably object code
 
@@ -139,11 +135,11 @@ getModBreaks hmi
 -- by the coverage pass, which gives the list of lexically-enclosing bindings
 -- for each tick.
 findEnclosingDecls :: HscEnv -> BreakInfo -> [String]
-findEnclosingDecls hsc_env inf =
+findEnclosingDecls hsc_env (BreakInfo modl ix) =
    let hmi = expectJust "findEnclosingDecls" $
-             lookupUFM (hsc_HPT hsc_env) (moduleName $ breakInfo_module inf)
+             lookupUFM (hsc_HPT hsc_env) (moduleName modl)
        mb = getModBreaks hmi
-   in modBreaks_decls mb ! breakInfo_number inf
+   in modBreaks_decls mb ! ix
 
 -- | Update fixity environment in the current interactive context.
 updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
@@ -286,7 +282,8 @@ emptyHistory size = nilBL size
 
 handleRunStatus :: GhcMonad m
                 => SingleStep -> String-> ([TyThing],GlobalRdrEnv) -> [Id]
-                -> EvalStatus [ForeignHValue] -> BoundedList History
+                -> EvalStatus_ [ForeignHValue] [HValueRef]
+                -> BoundedList History
                 -> m ExecResult
 
 handleRunStatus step expr bindings final_ids status history
@@ -294,24 +291,26 @@ handleRunStatus step expr bindings final_ids status history
   | otherwise              = not_tracing
  where
   tracing
-    | EvalBreak is_exception apStack_ref info_ref resume_ctxt _ccs <- status
+    | EvalBreak is_exception apStack_ref ix mod_uniq resume_ctxt _ccs <- status
     , not is_exception
     = do
        hsc_env <- getSession
-       let dflags = hsc_dflags hsc_env
-       info_hv <- liftIO $ wormholeRef dflags info_ref
-       let info = unsafeCoerce# info_hv :: BreakInfo
-       b <- liftIO $ isBreakEnabled hsc_env info
+       let hmi = expectJust "handleRunStatus" $
+                   lookupUFM (hsc_HPT hsc_env) (mkUniqueGrimily mod_uniq)
+           modl = mi_module (hm_iface hmi)
+           breaks = getModBreaks hmi
+
+       b <- liftIO $
+              breakpointStatus hsc_env (modBreaks_flags breaks) ix
        if b
          then not_tracing
            -- This breakpoint is explicitly enabled; we want to stop
            -- instead of just logging it.
          else do
            apStack_fhv <- liftIO $ mkFinalizedHValue hsc_env apStack_ref
-           let history' = mkHistory hsc_env apStack_fhv info `consBL` history
-                 -- probably better make history strict here, otherwise
-                 -- our BoundedList will be pointless.
-           _ <- liftIO $ evaluate history'
+           let bi = BreakInfo modl ix
+               !history' = mkHistory hsc_env apStack_fhv bi `consBL` history
+                 -- history is strict, otherwise our BoundedList is pointless.
            fhv <- liftIO $ mkFinalizedHValue hsc_env resume_ctxt
            status <- liftIO $ GHCi.resumeStmt hsc_env True fhv
            handleRunStatus RunAndLogSteps expr bindings final_ids
@@ -321,23 +320,24 @@ handleRunStatus step expr bindings final_ids status history
 
   not_tracing
     -- Hit a breakpoint
-    | EvalBreak is_exception apStack_ref info_ref resume_ctxt ccs <- status
+    | EvalBreak is_exception apStack_ref ix mod_uniq resume_ctxt ccs <- status
     = do
          hsc_env <- getSession
-         let dflags = hsc_dflags hsc_env
-         info_hv <- liftIO $ wormholeRef dflags info_ref
-         let info = unsafeCoerce# info_hv :: BreakInfo
          resume_ctxt_fhv <- liftIO $ mkFinalizedHValue hsc_env resume_ctxt
          apStack_fhv <- liftIO $ mkFinalizedHValue hsc_env apStack_ref
-         let mb_info | is_exception = Nothing
-                     | otherwise    = Just info
+         let hmi = expectJust "handleRunStatus" $
+                     lookupUFM (hsc_HPT hsc_env) (mkUniqueGrimily mod_uniq)
+             modl = mi_module (hm_iface hmi)
+             bp | is_exception = Nothing
+                | otherwise = Just (BreakInfo modl ix)
          (hsc_env1, names, span, decl) <- liftIO $
-           bindLocalsAtBreakpoint hsc_env apStack_fhv mb_info
+           bindLocalsAtBreakpoint hsc_env apStack_fhv bp
          let
            resume = Resume
              { resumeStmt = expr, resumeContext = resume_ctxt_fhv
              , resumeBindings = bindings, resumeFinalIds = final_ids
-             , resumeApStack = apStack_fhv, resumeBreakInfo = mb_info
+             , resumeApStack = apStack_fhv
+             , resumeBreakInfo = bp
              , resumeSpan = span, resumeHistory = toListBL history
              , resumeDecl = decl
              , resumeCCS = ccs
@@ -345,7 +345,7 @@ handleRunStatus step expr bindings final_ids status history
            hsc_env2 = pushResume hsc_env1 resume
 
          modifySession (\_ -> hsc_env2)
-         return (ExecBreak names mb_info)
+         return (ExecBreak names bp)
 
     -- Completed successfully
     | EvalComplete allocs (EvalSuccess hvals) <- status
@@ -364,16 +364,6 @@ handleRunStatus step expr bindings final_ids status history
     | otherwise
     = panic "not_tracing" -- actually exhaustive, but GHC can't tell
 
-isBreakEnabled :: HscEnv -> BreakInfo -> IO Bool
-isBreakEnabled hsc_env inf =
-   case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
-       Just hmi -> do
-         w <- getBreak (modBreaks_flags (getModBreaks hmi))
-                       (breakInfo_number inf)
-         case w of Just n -> return (n /= 0); _other -> return False
-       _ ->
-         return False
-
 
 resume :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m RunResult
 resume canLogSpan step = execResultToRunResult <$> resumeExec canLogSpan step
@@ -407,17 +397,17 @@ resumeExec canLogSpan step
         case r of
           Resume { resumeStmt = expr, resumeContext = fhv
                  , resumeBindings = bindings, resumeFinalIds = final_ids
-                 , resumeApStack = apStack, resumeBreakInfo = info
+                 , resumeApStack = apStack, resumeBreakInfo = mb_brkpt
                  , resumeSpan = span
                  , resumeHistory = hist } -> do
                withVirtualCWD $ do
                 status <- liftIO $ GHCi.resumeStmt hsc_env (isStep step) fhv
                 let prevHistoryLst = fromListBL 50 hist
-                    hist' = case info of
+                    hist' = case mb_brkpt of
                        Nothing -> prevHistoryLst
-                       Just i
+                       Just bi
                          | not $canLogSpan span -> prevHistoryLst
-                         | otherwise -> mkHistory hsc_env apStack i `consBL`
+                         | otherwise -> mkHistory hsc_env apStack bi `consBL`
                                                         fromListBL 50 hist
                 handleRunStatus step expr bindings final_ids status hist'
 
@@ -461,14 +451,16 @@ moveHist fn = do
         if new_ix == 0
            then case r of
                    Resume { resumeApStack = apStack,
-                            resumeBreakInfo = mb_info } ->
-                          update_ic apStack mb_info
+                            resumeBreakInfo = mb_brkpt } ->
+                          update_ic apStack mb_brkpt
            else case history !! (new_ix - 1) of
-                   History apStack info _ ->
-                          update_ic apStack (Just info)
+                   History{..} ->
+                     update_ic historyApStack (Just historyBreakInfo)
+
 
 -- -----------------------------------------------------------------------------
 -- After stopping at a breakpoint, add free variables to the environment
+
 result_fs :: FastString
 result_fs = fsLit "_result"
 
@@ -494,25 +486,24 @@ bindLocalsAtBreakpoint hsc_env apStack Nothing = do
 
        ictxt0 = hsc_IC hsc_env
        ictxt1 = extendInteractiveContextWithIds ictxt0 [exn_id]
-
    --
    Linker.extendLinkEnv [(exn_name, apStack)]
    return (hsc_env{ hsc_IC = ictxt1 }, [exn_name], span, "<exception thrown>")
 
 -- Just case: we stopped at a breakpoint, we have information about the location
 -- of the breakpoint and the free variables of the expression.
-bindLocalsAtBreakpoint hsc_env apStack_fhv (Just info) = do
+bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
    let
-       mod_name  = moduleName (breakInfo_module info)
        hmi       = expectJust "bindLocalsAtBreakpoint" $
-                        lookupUFM (hsc_HPT hsc_env) mod_name
+                     lookupUFM (hsc_HPT hsc_env) (moduleName breakInfo_module)
        breaks    = getModBreaks hmi
-       index     = breakInfo_number info
-       vars      = breakInfo_vars info
-       result_ty = breakInfo_resty info
-       occs      = modBreaks_vars breaks ! index
-       span      = modBreaks_locs breaks ! index
-       decl      = intercalate "." $ modBreaks_decls breaks ! index
+       info      = expectJust "bindLocalsAtBreakpoint2" $
+                     IntMap.lookup breakInfo_number (modBreaks_breakInfo breaks)
+       vars      = cgb_vars info
+       result_ty = cgb_resty info
+       occs      = modBreaks_vars breaks ! breakInfo_number
+       span      = modBreaks_locs breaks ! breakInfo_number
+       decl      = intercalate "." $ modBreaks_decls breaks ! breakInfo_number
 
            -- Filter out any unboxed ids;
            -- we can't bind these at the prompt
@@ -554,7 +545,7 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just info) = do
        ictxt1 = extendInteractiveContextWithIds ictxt0 final_ids
        names  = map idName new_ids
 
-   fhvs <- mapM (mkFinalizedHValue hsc_env <=< mkHValueRef)
+   fhvs <- mapM (mkFinalizedHValue hsc_env <=< mkRemoteRef)
              (catMaybes mb_hValues)
    Linker.extendLinkEnv (zip names fhvs)
    when result_ok $ Linker.extendLinkEnv [(result_name, apStack_fhv)]
diff --git a/compiler/main/InteractiveEvalTypes.hs b/compiler/main/InteractiveEvalTypes.hs
index 4372891bd8..34ae2ccaa0 100644
--- a/compiler/main/InteractiveEvalTypes.hs
+++ b/compiler/main/InteractiveEvalTypes.hs
@@ -11,23 +11,25 @@
 module InteractiveEvalTypes (
 #ifdef GHCI
         Resume(..), History(..), ExecResult(..),
-        SingleStep(..), isStep, ExecOptions(..)
+        SingleStep(..), isStep, ExecOptions(..),
+        BreakInfo(..)
 #endif
         ) where
 
 #ifdef GHCI
 
 import GHCi.RemoteTypes
-import GHCi.Message (EvalExpr)
+import GHCi.Message (EvalExpr, ResumeContext)
 import Id
 import Name
+import Module
 import RdrName
 import Type
-import ByteCodeTypes
 import SrcLoc
 import Exception
 
 import Data.Word
+import GHC.Stack.CCS
 
 data ExecOptions
  = ExecOptions
@@ -56,27 +58,32 @@ data ExecResult
        , breakInfo :: Maybe BreakInfo
        }
 
-data Resume
-   = Resume {
-       resumeStmt      :: String,       -- the original statement
-       resumeContext   :: ForeignHValue, -- thread running the computation
-       resumeBindings  :: ([TyThing], GlobalRdrEnv),
-       resumeFinalIds  :: [Id],         -- [Id] to bind on completion
-       resumeApStack   :: ForeignHValue, -- The object from which we can get
+data BreakInfo = BreakInfo
+  { breakInfo_module :: Module
+  , breakInfo_number :: Int
+  }
+
+data Resume = Resume
+       { resumeStmt      :: String       -- the original statement
+       , resumeContext   :: ForeignRef (ResumeContext [HValueRef])
+       , resumeBindings  :: ([TyThing], GlobalRdrEnv)
+       , resumeFinalIds  :: [Id]         -- [Id] to bind on completion
+       , resumeApStack   :: ForeignHValue -- The object from which we can get
                                         -- value of the free variables.
-       resumeBreakInfo :: Maybe BreakInfo,
+       , resumeBreakInfo :: Maybe BreakInfo
                                         -- the breakpoint we stopped at
+                                        -- (module, index)
                                         -- (Nothing <=> exception)
-       resumeSpan      :: SrcSpan,      -- just a copy of the SrcSpan
+       , resumeSpan      :: SrcSpan      -- just a copy of the SrcSpan
                                         -- from the ModBreaks,
                                         -- otherwise it's a pain to
                                         -- fetch the ModDetails &
                                         -- ModBreaks to get this.
-       resumeDecl      :: String,       -- ditto
-       resumeCCS       :: RemotePtr {- CostCentreStack -},
-       resumeHistory   :: [History],
-       resumeHistoryIx :: Int           -- 0 <==> at the top of the history
-   }
+       , resumeDecl      :: String       -- ditto
+       , resumeCCS       :: RemotePtr CostCentreStack
+       , resumeHistory   :: [History]
+       , resumeHistoryIx :: Int           -- 0 <==> at the top of the history
+       }
 
 data History
    = History {
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index bc2870ba10..6beff7f0db 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -177,6 +177,7 @@ import qualified Control.Monad.Fail as MonadFail
 import Data.Map      ( Map )
 import Data.Dynamic  ( Dynamic )
 import Data.Typeable ( TypeRep )
+import GHCi.Message
 import GHCi.RemoteTypes
 
 import qualified Language.Haskell.TH as TH
@@ -496,7 +497,7 @@ data TcGblEnv
         -- ^ Template Haskell module finalizers
 
         tcg_th_state :: TcRef (Map TypeRep Dynamic),
-        tcg_th_remote_state :: TcRef (Maybe ForeignHValue),
+        tcg_th_remote_state :: TcRef (Maybe (ForeignRef (IORef QState))),
         -- ^ Template Haskell state
 #endif /* GHCI */
 
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 63a3371dd1..cdb47901c0 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -913,7 +913,7 @@ finishTH = do
       case th_state of
         Nothing -> return () -- TH was not started, nothing to do
         Just fhv -> do
-          liftIO $ withForeignHValue fhv $ \rhv ->
+          liftIO $ withForeignRef fhv $ \rhv ->
             writeIServ i (putMessage (FinishTH rhv))
           () <- runRemoteTH i
           writeTcRef (tcg_th_remote_state tcg) Nothing
@@ -946,8 +946,8 @@ runTH ty fhv = do
         rstate <- getTHState i
         loc <- TH.qLocation
         liftIO $
-          withForeignHValue rstate $ \state_hv ->
-          withForeignHValue fhv $ \q_hv ->
+          withForeignRef rstate $ \state_hv ->
+          withForeignRef fhv $ \q_hv ->
             writeIServ i (putMessage (RunTH state_hv q_hv ty (Just loc)))
         bs <- runRemoteTH i
         return $! runGet get (LB.fromStrict bs)
@@ -966,7 +966,7 @@ runRemoteTH iserv = do
       liftIO $ writeIServ iserv (put r)
       runRemoteTH iserv
 
-getTHState :: IServ -> TcM ForeignHValue
+getTHState :: IServ -> TcM (ForeignRef (IORef QState))
 getTHState i = do
   tcg <- getGblEnv
   th_state <- readTcRef (tcg_th_remote_state tcg)