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

1 files changed, 17 insertions, 16 deletions

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