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

11 files changed, 354 insertions, 185 deletions

diff --git a/libraries/ghci/GHCi/BreakArray.hs b/libraries/ghci/GHCi/BreakArray.hs
new file mode 100644
index 0000000000..311bbd6c5e
--- /dev/null
+++ b/libraries/ghci/GHCi/BreakArray.hs
@@ -0,0 +1,114 @@
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# 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 GHCi.BreakArray
+    (
+      BreakArray
+          (BA) -- constructor is exported only for ByteCodeGen
+    , newBreakArray
+    , getBreak
+    , setBreakOn
+    , setBreakOff
+    , showBreakArray
+    ) where
+
+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
diff --git a/libraries/ghci/GHCi/CreateBCO.hs b/libraries/ghci/GHCi/CreateBCO.hs
index 6a9b79ae62..9501b5f0a7 100644
--- a/libraries/ghci/GHCi/CreateBCO.hs
+++ b/libraries/ghci/GHCi/CreateBCO.hs
@@ -14,6 +14,7 @@ module GHCi.CreateBCO (createBCOs) where
 
 import GHCi.ResolvedBCO
 import GHCi.RemoteTypes
+import GHCi.BreakArray
 import SizedSeq
 
 import System.IO (fixIO)
@@ -31,7 +32,7 @@ createBCOs bcos = do
   hvals <- fixIO $ \hvs -> do
      let arr = listArray (0, n_bcos-1) hvs
      mapM (createBCO arr) bcos
-  mapM mkHValueRef hvals
+  mapM mkRemoteRef hvals
 
 createBCO :: Array Int HValue -> ResolvedBCO -> IO HValue
 createBCO arr bco
@@ -85,15 +86,16 @@ mkPtrsArray arr n_ptrs ptrs = do
     fill (ResolvedBCORef n) i =
       writePtrsArrayHValue i (arr ! n) marr  -- must be lazy!
     fill (ResolvedBCOPtr r) i = do
-      hv <- localHValueRef r
+      hv <- localRef r
       writePtrsArrayHValue i hv marr
     fill (ResolvedBCOStaticPtr r) i = do
       writePtrsArrayPtr i (fromRemotePtr r)  marr
     fill (ResolvedBCOPtrBCO bco) i = do
       BCO bco# <- linkBCO' arr bco
       writePtrsArrayBCO i bco# marr
-    fill (ResolvedBCOPtrLocal hv) i = do
-      writePtrsArrayHValue i hv marr
+    fill (ResolvedBCOPtrBreakArray r) i = do
+      BA mba <- localRef r
+      writePtrsArrayMBA i mba marr
   zipWithM_ fill ptrs [0..]
   return marr
 
@@ -123,6 +125,10 @@ writePtrsArrayBCO (I# i) bco (PtrsArr arr) = IO $ \s ->
 
 data BCO = BCO BCO#
 
+writePtrsArrayMBA :: Int -> MutableByteArray# s -> PtrsArr -> IO ()
+writePtrsArrayMBA (I# i) mba (PtrsArr arr) = IO $ \s ->
+  case (unsafeCoerce# writeArray#) arr i mba s of s' -> (# s', () #)
+
 newBCO :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> IO BCO
 newBCO instrs lits ptrs arity bitmap = IO $ \s ->
   case newBCO# instrs lits ptrs arity bitmap s of
diff --git a/libraries/ghci/GHCi/FFI.hsc b/libraries/ghci/GHCi/FFI.hsc
index 36619aeb5d..7fd75bb8e4 100644
--- a/libraries/ghci/GHCi/FFI.hsc
+++ b/libraries/ghci/GHCi/FFI.hsc
@@ -12,6 +12,7 @@
 module GHCi.FFI
   ( FFIType(..)
   , FFIConv(..)
+  , C_ffi_cif
   , prepForeignCall
   , freeForeignCallInfo
   ) where
@@ -47,7 +48,7 @@ prepForeignCall
     :: FFIConv
     -> [FFIType]          -- arg types
     -> FFIType            -- result type
-    -> IO (Ptr ())        -- token for making calls (must be freed by caller)
+    -> IO (Ptr C_ffi_cif) -- token for making calls (must be freed by caller)
 
 prepForeignCall cconv arg_types result_type = do
   let n_args = length arg_types
@@ -60,7 +61,7 @@ prepForeignCall cconv arg_types result_type = do
      then throwIO (ErrorCall ("prepForeignCallFailed: " ++ show r))
      else return (castPtr cif)
 
-freeForeignCallInfo :: Ptr () -> IO ()
+freeForeignCallInfo :: Ptr C_ffi_cif -> IO ()
 freeForeignCallInfo p = do
   free ((#ptr ffi_cif, arg_types) p)
   free p
diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc
index 0244990ae0..cc57aff9f7 100644
--- a/libraries/ghci/GHCi/InfoTable.hsc
+++ b/libraries/ghci/GHCi/InfoTable.hsc
@@ -25,7 +25,7 @@ mkConInfoTable
    -> Int     -- non-ptr words
    -> Int     -- constr tag
    -> [Word8]  -- con desc
-   -> IO (Ptr ())
+   -> IO (Ptr StgInfoTable)
       -- resulting info table is allocated with allocateExec(), and
       -- should be freed with freeExec().
 
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index 37c9f0c209..59d6483089 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -4,19 +4,24 @@
 
 module GHCi.Message
   ( Message(..), Msg(..)
-  , EvalStatus(..), EvalResult(..), EvalOpts(..), EvalExpr(..)
+  , EvalStatus_(..), EvalStatus, EvalResult(..), EvalOpts(..), EvalExpr(..)
   , SerializableException(..)
   , THResult(..), THResultType(..)
+  , ResumeContext(..)
+  , QState(..)
   , getMessage, putMessage
   , Pipe(..), remoteCall, readPipe, writePipe
   ) where
 
 import GHCi.RemoteTypes
 import GHCi.ResolvedBCO
+import GHCi.InfoTable (StgInfoTable)
 import GHCi.FFI
 import GHCi.TH.Binary ()
+import GHCi.BreakArray
 
 import GHC.LanguageExtensions
+import Control.Concurrent
 import Control.Exception
 import Data.Binary
 import Data.Binary.Get
@@ -24,9 +29,12 @@ import Data.Binary.Put
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
+import Data.Dynamic
 import Data.IORef
-import Data.Typeable
+import Data.Map (Map)
+import Foreign.C
 import GHC.Generics
+import GHC.Stack.CCS
 import qualified Language.Haskell.TH        as TH
 import qualified Language.Haskell.TH.Syntax as TH
 import System.Exit
@@ -45,14 +53,14 @@ data Message a where
 
   -- These all invoke the corresponding functions in the RTS Linker API.
   InitLinker :: Message ()
-  LookupSymbol :: String -> Message (Maybe RemotePtr)
+  LookupSymbol :: String -> Message (Maybe (RemotePtr ()))
   LookupClosure :: String -> Message (Maybe HValueRef)
   LoadDLL :: String -> Message (Maybe String)
   LoadArchive :: String -> Message () -- error?
   LoadObj :: String -> Message () -- error?
   UnloadObj :: String -> Message () -- error?
-  AddLibrarySearchPath :: String -> Message RemotePtr
-  RemoveLibrarySearchPath :: RemotePtr -> Message Bool
+  AddLibrarySearchPath :: String -> Message (RemotePtr ())
+  RemoveLibrarySearchPath :: RemotePtr () -> Message Bool
   ResolveObjs :: Message Bool
   FindSystemLibrary :: String -> Message (Maybe String)
 
@@ -65,13 +73,13 @@ data Message a where
   FreeHValueRefs :: [HValueRef] -> Message ()
 
   -- | Malloc some data and return a 'RemotePtr' to it
-  MallocData :: ByteString -> Message RemotePtr
+  MallocData :: ByteString -> Message (RemotePtr ())
 
   -- | Calls 'GHCi.FFI.prepareForeignCall'
-  PrepFFI :: FFIConv -> [FFIType] -> FFIType -> Message RemotePtr
+  PrepFFI :: FFIConv -> [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif)
 
   -- | Free data previously created by 'PrepFFI'
-  FreeFFI :: RemotePtr -> Message ()
+  FreeFFI :: RemotePtr C_ffi_cif -> Message ()
 
   -- | Create an info table for a constructor
   MkConInfoTable
@@ -79,7 +87,7 @@ data Message a where
    -> Int     -- non-ptr words
    -> Int     -- constr tag
    -> [Word8] -- constructor desccription
-   -> Message RemotePtr
+   -> Message (RemotePtr StgInfoTable)
 
   -- | Evaluate a statement
   EvalStmt
@@ -90,12 +98,12 @@ data Message a where
   -- | Resume evaluation of a statement after a breakpoint
   ResumeStmt
    :: EvalOpts
-   -> HValueRef {- ResumeContext -}
+   -> RemoteRef (ResumeContext [HValueRef])
    -> Message (EvalStatus [HValueRef])
 
   -- | Abandon evaluation of a statement after a breakpoint
   AbandonStmt
-   :: HValueRef {- ResumeContext -}
+   :: RemoteRef (ResumeContext [HValueRef])
    -> Message ()
 
   -- | Evaluate something of type @IO String@
@@ -116,23 +124,41 @@ data Message a where
 
   -- | Create a CostCentre
   MkCostCentre
-   :: RemotePtr    -- module, RemotePtr so it can be shared
+   :: RemotePtr CChar    -- module, RemotePtr so it can be shared
    -> String       -- name
    -> String       -- SrcSpan
-   -> Message RemotePtr
+   -> Message (RemotePtr CostCentre)
 
   -- | Show a 'CostCentreStack' as a @[String]@
   CostCentreStackInfo
-   :: RemotePtr {- from EvalBreak -}
+   :: RemotePtr CostCentreStack
    -> Message [String]
 
+  -- | Create a new array of breakpoint flags
+  NewBreakArray
+   :: Int                               -- size
+   -> Message (RemoteRef BreakArray)
+
+  -- | Enable a breakpoint
+  EnableBreakpoint
+   :: RemoteRef BreakArray
+   -> Int                               -- index
+   -> Bool                              -- on or off
+   -> Message ()
+
+  -- | Query the status of a breakpoint (True <=> enabled)
+  BreakpointStatus
+   :: RemoteRef BreakArray
+   -> Int                               -- index
+   -> Message Bool                      -- True <=> enabled
+
   -- Template Haskell -------------------------------------------
 
   -- | Start a new TH module, return a state token that should be
-  StartTH :: Message HValueRef {- GHCiQState -}
+  StartTH :: Message (RemoteRef (IORef QState))
 
   -- | Run TH module finalizers, and free the HValueRef
-  FinishTH :: HValueRef {- GHCiQState -} -> Message ()
+  FinishTH :: RemoteRef (IORef QState) -> Message ()
 
   -- | Evaluate a TH computation.
   --
@@ -142,7 +168,7 @@ data Message a where
   -- they did, we have to serialize the value anyway, so we might
   -- as well serialize it to force it.
   RunTH
-   :: HValueRef {- GHCiQState -}
+   :: RemoteRef (IORef QState)
    -> HValueRef {- e.g. TH.Q TH.Exp -}
    -> THResultType
    -> Maybe TH.Loc
@@ -186,6 +212,12 @@ data EvalOpts = EvalOpts
 
 instance Binary EvalOpts
 
+data ResumeContext a = ResumeContext
+  { resumeBreakMVar :: MVar ()
+  , resumeStatusMVar :: MVar (EvalStatus a)
+  , resumeThreadId :: ThreadId
+  }
+
 -- | We can pass simple expressions to EvalStmt, consisting of values
 -- and application.  This allows us to wrap the statement to be
 -- executed in another function, which is used by GHCi to implement
@@ -198,16 +230,19 @@ data EvalExpr a
 
 instance Binary a => Binary (EvalExpr a)
 
-data EvalStatus a
+type EvalStatus a = EvalStatus_ a a
+
+data EvalStatus_ a b
   = EvalComplete Word64 (EvalResult a)
   | EvalBreak Bool
        HValueRef{- AP_STACK -}
-       HValueRef{- BreakInfo -}
-       HValueRef{- ResumeContext -}
-       RemotePtr -- Cost centre stack
+       Int {- break index -}
+       Int {- uniq of ModuleName -}
+       (RemoteRef (ResumeContext b))
+       (RemotePtr CostCentreStack) -- Cost centre stack
   deriving (Generic, Show)
 
-instance Binary a => Binary (EvalStatus a)
+instance Binary a => Binary (EvalStatus_ a b)
 
 data EvalResult a
   = EvalException SerializableException
@@ -248,6 +283,18 @@ data THResultType = THExp | THPat | THType | THDec | THAnnWrapper
 
 instance Binary THResultType
 
+data QState = QState
+  { qsMap        :: Map TypeRep Dynamic
+       -- ^ persistent data between splices in a module
+  , qsFinalizers :: [TH.Q ()]
+       -- ^ registered finalizers (in reverse order)
+  , qsLocation   :: Maybe TH.Loc
+       -- ^ location for current splice, if any
+  , qsPipe :: Pipe
+       -- ^ pipe to communicate with GHC
+  }
+instance Show QState where show _ = "<QState>"
+
 data Msg = forall a . (Binary a, Show a) => Msg (Message a)
 
 getMessage :: Get Msg
@@ -280,25 +327,28 @@ getMessage = do
       23 -> Msg <$> (EvalIO <$> get)
       24 -> Msg <$> (MkCostCentre <$> get <*> get <*> get)
       25 -> Msg <$> (CostCentreStackInfo <$> get)
-      26 -> Msg <$> return StartTH
-      27 -> Msg <$> FinishTH <$> get
-      28 -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)
-      29 -> Msg <$> NewName <$> get
-      30 -> Msg <$> (Report <$> get <*> get)
-      31 -> Msg <$> (LookupName <$> get <*> get)
-      32 -> Msg <$> Reify <$> get
-      33 -> Msg <$> ReifyFixity <$> get
-      34 -> Msg <$> (ReifyInstances <$> get <*> get)
-      35 -> Msg <$> ReifyRoles <$> get
-      36 -> Msg <$> (ReifyAnnotations <$> get <*> get)
-      37 -> Msg <$> ReifyModule <$> get
-      38 -> Msg <$> ReifyConStrictness <$> get
-      39 -> Msg <$> AddDependentFile <$> get
-      40 -> Msg <$> AddTopDecls <$> get
-      41 -> Msg <$> (IsExtEnabled <$> get)
-      42 -> Msg <$> return ExtsEnabled
-      43 -> Msg <$> return QDone
-      44 -> Msg <$> QException <$> get
+      26 -> Msg <$> (NewBreakArray <$> get)
+      27 -> Msg <$> (EnableBreakpoint <$> get <*> get <*> get)
+      28 -> Msg <$> (BreakpointStatus <$> get <*> get)
+      29 -> Msg <$> return StartTH
+      30 -> Msg <$> FinishTH <$> get
+      31 -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)
+      32 -> Msg <$> NewName <$> get
+      33 -> Msg <$> (Report <$> get <*> get)
+      34 -> Msg <$> (LookupName <$> get <*> get)
+      35 -> Msg <$> Reify <$> get
+      36 -> Msg <$> ReifyFixity <$> get
+      37 -> Msg <$> (ReifyInstances <$> get <*> get)
+      38 -> Msg <$> ReifyRoles <$> get
+      39 -> Msg <$> (ReifyAnnotations <$> get <*> get)
+      40 -> Msg <$> ReifyModule <$> get
+      41 -> Msg <$> ReifyConStrictness <$> get
+      42 -> Msg <$> AddDependentFile <$> get
+      43 -> Msg <$> AddTopDecls <$> get
+      44 -> Msg <$> (IsExtEnabled <$> get)
+      45 -> Msg <$> return ExtsEnabled
+      46 -> Msg <$> return QDone
+      47 -> Msg <$> QException <$> get
       _  -> Msg <$> QFail <$> get
 
 putMessage :: Message a -> Put
@@ -327,28 +377,31 @@ putMessage m = case m of
   EvalString val              -> putWord8 21 >> put val
   EvalStringToString str val  -> putWord8 22 >> put str >> put val
   EvalIO val                  -> putWord8 23 >> put val
-  MkCostCentre name mod src   -> putWord8 24 >> put name >> put mod >> put src
+  MkCostCentre mod name src   -> putWord8 24 >> put mod >> put name >> put src
   CostCentreStackInfo ptr     -> putWord8 25 >> put ptr
-  StartTH                     -> putWord8 26
-  FinishTH val                -> putWord8 27 >> put val
-  RunTH st q loc ty           -> putWord8 28 >> put st >> put q >> put loc >> put ty
-  NewName a                   -> putWord8 29 >> put a
-  Report a b                  -> putWord8 30 >> put a >> put b
-  LookupName a b              -> putWord8 31 >> put a >> put b
-  Reify a                     -> putWord8 32 >> put a
-  ReifyFixity a               -> putWord8 33 >> put a
-  ReifyInstances a b          -> putWord8 34 >> put a >> put b
-  ReifyRoles a                -> putWord8 35 >> put a
-  ReifyAnnotations a b        -> putWord8 36 >> put a >> put b
-  ReifyModule a               -> putWord8 37 >> put a
-  ReifyConStrictness a        -> putWord8 38 >> put a
-  AddDependentFile a          -> putWord8 39 >> put a
-  AddTopDecls a               -> putWord8 40 >> put a
-  IsExtEnabled a              -> putWord8 41 >> put a
-  ExtsEnabled                 -> putWord8 42
-  QDone                       -> putWord8 43
-  QException a                -> putWord8 44 >> put a
-  QFail a                     -> putWord8 45 >> put a
+  NewBreakArray sz            -> putWord8 26 >> put sz
+  EnableBreakpoint arr ix b   -> putWord8 27 >> put arr >> put ix >> put b
+  BreakpointStatus arr ix     -> putWord8 28 >> put arr >> put ix
+  StartTH                     -> putWord8 29
+  FinishTH val                -> putWord8 30 >> put val
+  RunTH st q loc ty           -> putWord8 31 >> put st >> put q >> put loc >> put ty
+  NewName a                   -> putWord8 32 >> put a
+  Report a b                  -> putWord8 33 >> put a >> put b
+  LookupName a b              -> putWord8 34 >> put a >> put b
+  Reify a                     -> putWord8 35 >> put a
+  ReifyFixity a               -> putWord8 36 >> put a
+  ReifyInstances a b          -> putWord8 37 >> put a >> put b
+  ReifyRoles a                -> putWord8 38 >> put a
+  ReifyAnnotations a b        -> putWord8 39 >> put a >> put b
+  ReifyModule a               -> putWord8 40 >> put a
+  ReifyConStrictness a        -> putWord8 41 >> put a
+  AddDependentFile a          -> putWord8 42 >> put a
+  AddTopDecls a               -> putWord8 43 >> put a
+  IsExtEnabled a              -> putWord8 44 >> put a
+  ExtsEnabled                 -> putWord8 45
+  QDone                       -> putWord8 46
+  QException a                -> putWord8 47 >> put a
+  QFail a                     -> putWord8 48 >> put a
 
 -- -----------------------------------------------------------------------------
 -- Reading/writing messages
diff --git a/libraries/ghci/GHCi/ObjLink.hs b/libraries/ghci/GHCi/ObjLink.hs
index 710cffd1a6..d422813fa9 100644
--- a/libraries/ghci/GHCi/ObjLink.hs
+++ b/libraries/ghci/GHCi/ObjLink.hs
@@ -52,7 +52,7 @@ lookupClosure str = do
   case m of
     Nothing -> return Nothing
     Just (Ptr addr) -> case addrToAny# addr of
-      (# a #) -> Just <$> mkHValueRef (HValue a)
+      (# a #) -> Just <$> mkRemoteRef (HValue a)
 
 prefixUnderscore :: String -> String
 prefixUnderscore
diff --git a/libraries/ghci/GHCi/RemoteTypes.hs b/libraries/ghci/GHCi/RemoteTypes.hs
index 920ce93fe6..ea91f19a2b 100644
--- a/libraries/ghci/GHCi/RemoteTypes.hs
+++ b/libraries/ghci/GHCi/RemoteTypes.hs
@@ -1,16 +1,19 @@
 {-# LANGUAGE CPP, StandaloneDeriving, GeneralizedNewtypeDeriving #-}
 module GHCi.RemoteTypes
-  ( RemotePtr(..), toRemotePtr, fromRemotePtr
+  ( RemotePtr(..), toRemotePtr, fromRemotePtr, castRemotePtr
   , HValue(..)
-  , HValueRef, mkHValueRef, localHValueRef, freeHValueRef
-  , ForeignHValue, mkForeignHValue, withForeignHValue
-  , unsafeForeignHValueToHValueRef, finalizeForeignHValue
+  , RemoteRef, mkRemoteRef, localRef, freeRemoteRef
+  , HValueRef, toHValueRef
+  , ForeignRef, mkForeignRef, withForeignRef
+  , ForeignHValue
+  , unsafeForeignRefToRemoteRef, finalizeForeignRef
   ) where
 
 import Data.Word
 import Foreign hiding (newForeignPtr)
 import Foreign.Concurrent
 import Data.Binary
+import Unsafe.Coerce
 import GHC.Exts
 import GHC.ForeignPtr
 
@@ -22,19 +25,22 @@ import GHC.ForeignPtr
 
 #include "MachDeps.h"
 #if SIZEOF_HSINT == 4
-newtype RemotePtr = RemotePtr Word32
+newtype RemotePtr a = RemotePtr Word32
 #elif SIZEOF_HSINT == 8
-newtype RemotePtr = RemotePtr Word64
+newtype RemotePtr a = RemotePtr Word64
 #endif
 
-toRemotePtr :: Ptr a -> RemotePtr
+toRemotePtr :: Ptr a -> RemotePtr a
 toRemotePtr p = RemotePtr (fromIntegral (ptrToWordPtr p))
 
-fromRemotePtr :: RemotePtr -> Ptr a
+fromRemotePtr :: RemotePtr a -> Ptr a
 fromRemotePtr (RemotePtr p) = wordPtrToPtr (fromIntegral p)
 
-deriving instance Show RemotePtr
-deriving instance Binary RemotePtr
+castRemotePtr :: RemotePtr a -> RemotePtr b
+castRemotePtr (RemotePtr a) = RemotePtr a
+
+deriving instance Show (RemotePtr a)
+deriving instance Binary (RemotePtr a)
 
 -- -----------------------------------------------------------------------------
 -- HValueRef
@@ -44,48 +50,57 @@ newtype HValue = HValue Any
 instance Show HValue where
   show _ = "<HValue>"
 
-newtype HValueRef = HValueRef RemotePtr
+-- | A reference to a remote value.  These are allocated and freed explicitly.
+newtype RemoteRef a = RemoteRef (RemotePtr ())
   deriving (Show, Binary)
 
--- | Make a reference to a local HValue that we can send remotely.
+-- We can discard type information if we want
+toHValueRef :: RemoteRef a -> RemoteRef HValue
+toHValueRef = unsafeCoerce
+
+-- For convenience
+type HValueRef = RemoteRef HValue
+
+-- | Make a reference to a local value that we can send remotely.
 -- This reference will keep the value that it refers to alive until
--- 'freeHValueRef' is called.
-mkHValueRef :: HValue -> IO HValueRef
-mkHValueRef (HValue hv) = do
-  sp <- newStablePtr hv
-  return $! HValueRef (toRemotePtr (castStablePtrToPtr sp))
+-- 'freeRemoteRef' is called.
+mkRemoteRef :: a -> IO (RemoteRef a)
+mkRemoteRef a = do
+  sp <- newStablePtr a
+  return $! RemoteRef (toRemotePtr (castStablePtrToPtr sp))
 
 -- | Convert an HValueRef to an HValue.  Should only be used if the HValue
 -- originated in this process.
-localHValueRef :: HValueRef -> IO HValue
-localHValueRef (HValueRef w) = do
-  p <- deRefStablePtr (castPtrToStablePtr (fromRemotePtr w))
-  return (HValue p)
+localRef :: RemoteRef a -> IO a
+localRef (RemoteRef w) =
+  deRefStablePtr (castPtrToStablePtr (fromRemotePtr w))
 
 -- | Release an HValueRef that originated in this process
-freeHValueRef :: HValueRef -> IO ()
-freeHValueRef (HValueRef w) =
+freeRemoteRef :: RemoteRef a -> IO ()
+freeRemoteRef (RemoteRef w) =
   freeStablePtr (castPtrToStablePtr (fromRemotePtr w))
 
 -- | An HValueRef with a finalizer
-newtype ForeignHValue = ForeignHValue (ForeignPtr ())
+newtype ForeignRef a = ForeignRef (ForeignPtr ())
+
+type ForeignHValue = ForeignRef HValue
 
--- | Create a 'ForeignHValue' from an 'HValueRef'.  The finalizer
+-- | Create a 'ForeignRef' from a 'RemoteRef'.  The finalizer
 -- should arrange to call 'freeHValueRef' on the 'HValueRef'.  (since
 -- this function needs to be called in the process that created the
 -- 'HValueRef', it cannot be called directly from the finalizer).
-mkForeignHValue :: HValueRef -> IO () -> IO ForeignHValue
-mkForeignHValue (HValueRef hvref) finalizer =
-  ForeignHValue <$> newForeignPtr (fromRemotePtr hvref) finalizer
+mkForeignRef :: RemoteRef a -> IO () -> IO (ForeignRef a)
+mkForeignRef (RemoteRef hvref) finalizer =
+  ForeignRef <$> newForeignPtr (fromRemotePtr hvref) finalizer
 
 -- | Use a 'ForeignHValue'
-withForeignHValue :: ForeignHValue -> (HValueRef -> IO a) -> IO a
-withForeignHValue (ForeignHValue fp) f =
-   withForeignPtr fp (f . HValueRef . toRemotePtr)
+withForeignRef :: ForeignRef a -> (RemoteRef a -> IO b) -> IO b
+withForeignRef (ForeignRef fp) f =
+   withForeignPtr fp (f . RemoteRef . toRemotePtr)
 
-unsafeForeignHValueToHValueRef :: ForeignHValue -> HValueRef
-unsafeForeignHValueToHValueRef (ForeignHValue fp) =
-  HValueRef (toRemotePtr (unsafeForeignPtrToPtr fp))
+unsafeForeignRefToRemoteRef :: ForeignRef a -> RemoteRef a
+unsafeForeignRefToRemoteRef (ForeignRef fp) =
+  RemoteRef (toRemotePtr (unsafeForeignPtrToPtr fp))
 
-finalizeForeignHValue :: ForeignHValue -> IO ()
-finalizeForeignHValue (ForeignHValue fp) = finalizeForeignPtr fp
+finalizeForeignRef :: ForeignRef a -> IO ()
+finalizeForeignRef (ForeignRef fp) = finalizeForeignPtr fp
diff --git a/libraries/ghci/GHCi/ResolvedBCO.hs b/libraries/ghci/GHCi/ResolvedBCO.hs
index 9234210418..a349dedaba 100644
--- a/libraries/ghci/GHCi/ResolvedBCO.hs
+++ b/libraries/ghci/GHCi/ResolvedBCO.hs
@@ -6,6 +6,7 @@ module GHCi.ResolvedBCO
 
 import SizedSeq
 import GHCi.RemoteTypes
+import GHCi.BreakArray
 
 import Data.Array.Unboxed
 import Data.Binary
@@ -32,31 +33,14 @@ instance Binary ResolvedBCO
 data ResolvedBCOPtr
   = ResolvedBCORef Int
       -- ^ reference to the Nth BCO in the current set
-  | ResolvedBCOPtr HValueRef
+  | ResolvedBCOPtr (RemoteRef HValue)
       -- ^ reference to a previously created BCO
-  | ResolvedBCOStaticPtr RemotePtr
+  | ResolvedBCOStaticPtr (RemotePtr ())
       -- ^ reference to a static ptr
   | ResolvedBCOPtrBCO ResolvedBCO
       -- ^ a nested BCO
-  | ResolvedBCOPtrLocal HValue
-      -- ^ something local, cannot be serialized
+  | ResolvedBCOPtrBreakArray (RemoteRef BreakArray)
+      -- ^ Resolves to the MutableArray# inside the BreakArray
   deriving (Generic, Show)
 
--- Manual Binary instance is needed because we cannot serialize
--- ResolvedBCOPtrLocal.  This will go away once we have support for
--- remote breakpoints.
-instance Binary ResolvedBCOPtr where
-  put (ResolvedBCORef a) = putWord8 0 >> put a
-  put (ResolvedBCOPtr a) = putWord8 1 >> put a
-  put (ResolvedBCOStaticPtr a) = putWord8 2 >> put a
-  put (ResolvedBCOPtrBCO a) = putWord8 3 >> put a
-  put (ResolvedBCOPtrLocal _) =
-    error "Cannot serialize a local pointer.  Use -fno-external-interpreter?"
-
-  get = do
-    w <- getWord8
-    case w of
-      0 -> ResolvedBCORef <$> get
-      1 -> ResolvedBCOPtr <$> get
-      2 -> ResolvedBCOStaticPtr <$> get
-      _ -> ResolvedBCOPtrBCO <$> get
+instance Binary ResolvedBCOPtr
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index 8934437a10..865072ea7d 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -16,6 +16,7 @@ import GHCi.Message
 import GHCi.ObjLink
 import GHCi.RemoteTypes
 import GHCi.TH
+import GHCi.BreakArray
 
 import Control.Concurrent
 import Control.DeepSeq
@@ -50,16 +51,26 @@ run m = case m of
   ResolveObjs -> resolveObjs
   FindSystemLibrary str -> findSystemLibrary str
   CreateBCOs bco -> createBCOs bco
-  FreeHValueRefs rs -> mapM_ freeHValueRef rs
+  FreeHValueRefs rs -> mapM_ freeRemoteRef rs
   EvalStmt opts r -> evalStmt opts r
   ResumeStmt opts r -> resumeStmt opts r
   AbandonStmt r -> abandonStmt r
   EvalString r -> evalString r
   EvalStringToString r s -> evalStringToString r s
   EvalIO r -> evalIO r
-  MkCostCentre name mod src ->
-    toRemotePtr <$> mkCostCentre (fromRemotePtr name) mod src
+  MkCostCentre mod name src ->
+    toRemotePtr <$> mkCostCentre (fromRemotePtr mod) name src
   CostCentreStackInfo ptr -> ccsToStrings (fromRemotePtr ptr)
+  NewBreakArray sz -> mkRemoteRef =<< newBreakArray sz
+  EnableBreakpoint ref ix b -> do
+    arr <- localRef ref
+    _ <- if b then setBreakOn arr ix else setBreakOff arr ix
+    return ()
+  BreakpointStatus ref ix -> do
+    arr <- localRef ref; r <- getBreak arr ix
+    case r of
+      Nothing -> return False
+      Just w -> return (w /= 0)
   MallocData bs -> mkString bs
   PrepFFI conv args res -> toRemotePtr <$> prepForeignCall conv args res
   FreeFFI p -> freeForeignCallInfo (fromRemotePtr p)
@@ -73,9 +84,9 @@ evalStmt opts expr = do
   io <- mkIO expr
   sandboxIO opts $ do
     rs <- unsafeCoerce io :: IO [HValue]
-    mapM mkHValueRef rs
+    mapM mkRemoteRef rs
  where
-  mkIO (EvalThis href) = localHValueRef href
+  mkIO (EvalThis href) = localRef href
   mkIO (EvalApp l r) = do
     l' <- mkIO l
     r' <- mkIO r
@@ -83,19 +94,19 @@ evalStmt opts expr = do
 
 evalIO :: HValueRef -> IO (EvalResult ())
 evalIO r = do
-  io <- localHValueRef r
+  io <- localRef r
   tryEval (unsafeCoerce io :: IO ())
 
 evalString :: HValueRef -> IO (EvalResult String)
 evalString r = do
-  io <- localHValueRef r
+  io <- localRef r
   tryEval $ do
     r <- unsafeCoerce io :: IO String
     evaluate (force r)
 
 evalStringToString :: HValueRef -> String -> IO (EvalResult String)
 evalStringToString r str = do
-  io <- localHValueRef r
+  io <- localRef r
   tryEval $ do
     r <- (unsafeCoerce io :: String -> IO String) str
     evaluate (force r)
@@ -232,17 +243,17 @@ withBreakAction opts breakMVar statusMVar act
         -- might be a bit surprising.  The exception flag is turned off
         -- as soon as it is hit, or in resetBreakAction below.
 
-   onBreak is_exception info apStack = do
+   onBreak :: BreakpointCallback
+   onBreak ix# uniq# is_exception apStack = do
      tid <- myThreadId
      let resume = ResumeContext
            { resumeBreakMVar = breakMVar
            , resumeStatusMVar = statusMVar
            , resumeThreadId = tid }
-     resume_r <- mkHValueRef (unsafeCoerce resume)
-     apStack_r <- mkHValueRef apStack
-     info_r <- mkHValueRef info
+     resume_r <- mkRemoteRef resume
+     apStack_r <- mkRemoteRef apStack
      ccs <- toRemotePtr <$> getCCSOf apStack
-     putMVar statusMVar $ EvalBreak is_exception apStack_r info_r resume_r ccs
+     putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) (I# uniq#) resume_r ccs
      takeMVar breakMVar
 
    resetBreakAction stablePtr = do
@@ -251,15 +262,11 @@ withBreakAction opts breakMVar statusMVar act
      resetStepFlag
      freeStablePtr stablePtr
 
-data ResumeContext a = ResumeContext
-  { resumeBreakMVar :: MVar ()
-  , resumeStatusMVar :: MVar (EvalStatus a)
-  , resumeThreadId :: ThreadId
-  }
-
-resumeStmt :: EvalOpts -> HValueRef -> IO (EvalStatus [HValueRef])
+resumeStmt
+  :: EvalOpts -> RemoteRef (ResumeContext [HValueRef])
+  -> IO (EvalStatus [HValueRef])
 resumeStmt opts hvref = do
-  ResumeContext{..} <- unsafeCoerce (localHValueRef hvref)
+  ResumeContext{..} <- localRef hvref
   withBreakAction opts resumeBreakMVar resumeStatusMVar $
     mask_ $ do
       putMVar resumeBreakMVar () -- this awakens the stopped thread...
@@ -277,9 +284,9 @@ resumeStmt opts hvref = do
 --          step is necessary to prevent race conditions with
 --          -fbreak-on-exception (see #5975).
 --  See test break010.
-abandonStmt :: HValueRef -> IO ()
+abandonStmt :: RemoteRef (ResumeContext [HValueRef]) -> IO ()
 abandonStmt hvref = do
-  ResumeContext{..} <- unsafeCoerce (localHValueRef hvref)
+  ResumeContext{..} <- localRef hvref
   killThread resumeThreadId
   putMVar resumeBreakMVar ()
   _ <- takeMVar resumeStatusMVar
@@ -293,35 +300,35 @@ setStepFlag = poke stepFlag 1
 resetStepFlag :: IO ()
 resetStepFlag = poke stepFlag 0
 
+type BreakpointCallback = Int# -> Int# -> Bool -> HValue -> IO ()
+
 foreign import ccall "&rts_breakpoint_io_action"
-   breakPointIOAction :: Ptr (StablePtr (Bool -> HValue -> HValue -> IO ()))
+   breakPointIOAction :: Ptr (StablePtr BreakpointCallback)
 
-noBreakStablePtr :: StablePtr (Bool -> HValue -> HValue -> IO ())
+noBreakStablePtr :: StablePtr BreakpointCallback
 noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
 
-noBreakAction :: Bool -> HValue -> HValue -> IO ()
-noBreakAction False _ _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction True  _ _ = return () -- exception: just continue
+noBreakAction :: BreakpointCallback
+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.
-mkString :: ByteString -> IO RemotePtr
+mkString :: ByteString -> IO (RemotePtr ())
 mkString bs = B.unsafeUseAsCStringLen bs $ \(cstr,len) -> do
   ptr <- mallocBytes len
   copyBytes ptr cstr len
-  return (toRemotePtr ptr)
-
-data CCostCentre
+  return (castRemotePtr (toRemotePtr ptr))
 
-mkCostCentre :: Ptr CChar -> String -> String -> IO (Ptr CCostCentre)
+mkCostCentre :: Ptr CChar -> String -> String -> IO (Ptr CostCentre)
 #if defined(PROFILING)
-mkCostCentre c_module srcspan decl_path = do
+mkCostCentre c_module decl_path srcspan = do
   c_name <- newCString decl_path
   c_srcspan <- newCString srcspan
   c_mkCostCentre c_name c_module c_srcspan
 
 foreign import ccall unsafe "mkCostCentre"
-  c_mkCostCentre :: Ptr CChar -> Ptr CChar -> Ptr CChar -> IO (Ptr CCostCentre)
+  c_mkCostCentre :: Ptr CChar -> Ptr CChar -> Ptr CChar -> IO (Ptr CostCentre)
 #else
 mkCostCentre _ _ _ = return nullPtr
 #endif
diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs
index 717192e39d..799bd6261b 100644
--- a/libraries/ghci/GHCi/TH.hs
+++ b/libraries/ghci/GHCi/TH.hs
@@ -28,18 +28,6 @@ import qualified Language.Haskell.TH        as TH
 import qualified Language.Haskell.TH.Syntax as TH
 import Unsafe.Coerce
 
-data QState = QState
-  { qsMap        :: Map TypeRep Dynamic
-       -- ^ persistent data between splices in a module
-  , qsFinalizers :: [TH.Q ()]
-       -- ^ registered finalizers (in reverse order)
-  , qsLocation   :: Maybe TH.Loc
-       -- ^ location for current splice, if any
-  , qsPipe :: Pipe
-       -- ^ pipe to communicate with GHC
-  }
-instance Show QState where show _ = "<QState>"
-
 initQState :: Pipe -> QState
 initQState p = QState M.empty [] Nothing p
 
@@ -133,41 +121,41 @@ instance TH.Quasi GHCiQ where
   qIsExtEnabled x = ghcCmd (IsExtEnabled x)
   qExtsEnabled = ghcCmd ExtsEnabled
 
-startTH :: IO HValueRef
+startTH :: IO (RemoteRef (IORef QState))
 startTH = do
   r <- newIORef (initQState (error "startTH: no pipe"))
-  mkHValueRef (unsafeCoerce r)
+  mkRemoteRef r
 
-finishTH :: Pipe -> HValueRef -> IO ()
+finishTH :: Pipe -> RemoteRef (IORef QState) -> IO ()
 finishTH pipe rstate = do
-  qstateref <- unsafeCoerce <$> localHValueRef rstate
+  qstateref <- localRef rstate
   qstate <- readIORef qstateref
   _ <- runGHCiQ runModFinalizers qstate { qsPipe = pipe }
-  freeHValueRef rstate
+  freeRemoteRef rstate
   return ()
 
 runTH
-  :: Pipe -> HValueRef -> HValueRef
+  :: Pipe -> RemoteRef (IORef QState) -> HValueRef
   -> THResultType
   -> Maybe TH.Loc
   -> IO ByteString
 runTH pipe rstate rhv ty mb_loc = do
-  hv <- localHValueRef rhv
+  hv <- localRef rhv
   case ty of
     THExp -> runTHQ pipe rstate mb_loc (unsafeCoerce hv :: TH.Q TH.Exp)
     THPat -> runTHQ pipe rstate mb_loc (unsafeCoerce hv :: TH.Q TH.Pat)
     THType -> runTHQ pipe rstate mb_loc (unsafeCoerce hv :: TH.Q TH.Type)
     THDec -> runTHQ pipe rstate mb_loc (unsafeCoerce hv :: TH.Q [TH.Dec])
     THAnnWrapper -> do
-      hv <- unsafeCoerce <$> localHValueRef rhv
+      hv <- unsafeCoerce <$> localRef rhv
       case hv :: AnnotationWrapper of
         AnnotationWrapper thing ->
           return $! LB.toStrict (runPut (put (toSerialized serializeWithData thing)))
 
-runTHQ :: Binary a => Pipe -> HValueRef -> Maybe TH.Loc -> TH.Q a
+runTHQ :: Binary a => Pipe -> RemoteRef (IORef QState) -> Maybe TH.Loc -> TH.Q a
        -> IO ByteString
 runTHQ pipe@Pipe{..} rstate mb_loc ghciq = do
-  qstateref <- unsafeCoerce <$> localHValueRef rstate
+  qstateref <- localRef rstate
   qstate <- readIORef qstateref
   let st = qstate { qsLocation = mb_loc, qsPipe = pipe }
   (r,new_state) <- runGHCiQ (TH.runQ ghciq) st
diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in
index 85698c0db3..547374a894 100644
--- a/libraries/ghci/ghci.cabal.in
+++ b/libraries/ghci/ghci.cabal.in
@@ -42,6 +42,7 @@ library
         UnboxedTuples
 
     exposed-modules:
+        GHCi.BreakArray
         GHCi.Message
         GHCi.ResolvedBCO
         GHCi.RemoteTypes