Module hierarchy: ByteCode and Runtime (cf #13009)

Update haddock submodule

1 files changed, 667 insertions, 0 deletions

diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
new file mode 100644
index 0000000000..9eadacca1c
--- /dev/null
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -0,0 +1,667 @@
+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, BangPatterns, CPP #-}
+
+--
+-- | Interacting with the interpreter, whether it is running on an
+-- external process or in the current process.
+--
+module GHC.Runtime.Interpreter
+  ( -- * High-level interface to the interpreter
+    evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..)
+  , resumeStmt
+  , abandonStmt
+  , evalIO
+  , evalString
+  , evalStringToIOString
+  , mallocData
+  , createBCOs
+  , addSptEntry
+  , mkCostCentres
+  , costCentreStackInfo
+  , newBreakArray
+  , enableBreakpoint
+  , breakpointStatus
+  , getBreakpointVar
+  , getClosure
+  , seqHValue
+
+  -- * The object-code linker
+  , initObjLinker
+  , lookupSymbol
+  , lookupClosure
+  , loadDLL
+  , loadArchive
+  , loadObj
+  , unloadObj
+  , addLibrarySearchPath
+  , removeLibrarySearchPath
+  , resolveObjs
+  , findSystemLibrary
+
+  -- * Lower-level API using messages
+  , iservCmd, Message(..), withIServ, stopIServ
+  , iservCall, readIServ, writeIServ
+  , purgeLookupSymbolCache
+  , freeHValueRefs
+  , mkFinalizedHValue
+  , wormhole, wormholeRef
+  , mkEvalOpts
+  , fromEvalResult
+  ) where
+
+import GhcPrelude
+
+import GHCi.Message
+#if defined(HAVE_INTERNAL_INTERPRETER)
+import GHCi.Run
+#endif
+import GHCi.RemoteTypes
+import GHCi.ResolvedBCO
+import GHCi.BreakArray (BreakArray)
+import Fingerprint
+import HscTypes
+import UniqFM
+import Panic
+import DynFlags
+import ErrUtils
+import Outputable
+import Exception
+import BasicTypes
+import FastString
+import Util
+import Hooks
+
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.Binary
+import Data.Binary.Put
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LB
+import Data.IORef
+import Foreign hiding (void)
+import GHC.Exts.Heap
+import GHC.Stack.CCS (CostCentre,CostCentreStack)
+import System.Exit
+import Data.Maybe
+import GHC.IO.Handle.Types (Handle)
+#if defined(mingw32_HOST_OS)
+import Foreign.C
+import GHC.IO.Handle.FD (fdToHandle)
+#else
+import System.Posix as Posix
+#endif
+import System.Directory
+import System.Process
+import GHC.Conc (getNumProcessors, pseq, par)
+
+{- Note [Remote GHCi]
+
+When the flag -fexternal-interpreter is given to GHC, interpreted code
+is run in a separate process called iserv, and we communicate with the
+external process over a pipe using Binary-encoded messages.
+
+Motivation
+~~~~~~~~~~
+
+When the interpreted code is running in a separate process, it can
+use a different "way", e.g. profiled or dynamic.  This means
+
+- compiling Template Haskell code with -prof does not require
+  building the code without -prof first
+
+- when GHC itself is profiled, it can interpret unprofiled code,
+  and the same applies to dynamic linking.
+
+- An unprofiled GHCi can load and run profiled code, which means it
+  can use the stack-trace functionality provided by profiling without
+  taking the performance hit on the compiler that profiling would
+  entail.
+
+For other reasons see remote-GHCi on the wiki.
+
+Implementation Overview
+~~~~~~~~~~~~~~~~~~~~~~~
+
+The main pieces are:
+
+- libraries/ghci, containing:
+  - types for talking about remote values (GHCi.RemoteTypes)
+  - the message protocol (GHCi.Message),
+  - implementation of the messages (GHCi.Run)
+  - implementation of Template Haskell (GHCi.TH)
+  - a few other things needed to run interpreted code
+
+- top-level iserv directory, containing the codefor the external
+  server.  This is a fairly simple wrapper, most of the functionality
+  is provided by modules in libraries/ghci.
+
+- This module which provides the interface to the server used
+  by the rest of GHC.
+
+GHC works with and without -fexternal-interpreter.  With the flag, all
+interpreted code is run by the iserv binary.  Without the flag,
+interpreted code is run in the same process as GHC.
+
+Things that do not work with -fexternal-interpreter
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+dynCompileExpr cannot work, because we have no way to run code of an
+unknown type in the remote process.  This API fails with an error
+message if it is used with -fexternal-interpreter.
+
+Other Notes on Remote GHCi
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+  * This wiki page has an implementation overview:
+    https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/external-interpreter
+  * Note [External GHCi pointers] in compiler/ghci/GHCi.hs
+  * Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs
+-}
+
+#if !defined(HAVE_INTERNAL_INTERPRETER)
+needExtInt :: IO a
+needExtInt = throwIO
+  (InstallationError "this operation requires -fexternal-interpreter")
+#endif
+
+-- | Run a command in the interpreter's context.  With
+-- @-fexternal-interpreter@, the command is serialized and sent to an
+-- external iserv process, and the response is deserialized (hence the
+-- @Binary@ constraint).  With @-fno-external-interpreter@ we execute
+-- the command directly here.
+iservCmd :: Binary a => HscEnv -> Message a -> IO a
+iservCmd hsc_env@HscEnv{..} msg
+ | gopt Opt_ExternalInterpreter hsc_dflags =
+     withIServ hsc_env $ \iserv ->
+       uninterruptibleMask_ $ do -- Note [uninterruptibleMask_]
+         iservCall iserv msg
+ | otherwise = -- Just run it directly
+#if defined(HAVE_INTERNAL_INTERPRETER)
+   run msg
+#else
+   needExtInt
+#endif
+
+-- Note [uninterruptibleMask_ and iservCmd]
+--
+-- If we receive an async exception, such as ^C, while communicating
+-- with the iserv process then we will be out-of-sync and not be able
+-- to recoever.  Thus we use uninterruptibleMask_ during
+-- communication.  A ^C will be delivered to the iserv process (because
+-- signals get sent to the whole process group) which will interrupt
+-- the running computation and return an EvalException result.
+
+-- | Grab a lock on the 'IServ' and do something with it.
+-- Overloaded because this is used from TcM as well as IO.
+withIServ
+  :: (MonadIO m, ExceptionMonad m)
+  => HscEnv -> (IServ -> m a) -> m a
+withIServ HscEnv{..} action =
+  gmask $ \restore -> do
+    m <- liftIO $ takeMVar hsc_iserv
+      -- start the iserv process if we haven't done so yet
+    iserv <- maybe (liftIO $ startIServ hsc_dflags) return m
+               `gonException` (liftIO $ putMVar hsc_iserv Nothing)
+      -- free any ForeignHValues that have been garbage collected.
+    let iserv' = iserv{ iservPendingFrees = [] }
+    a <- (do
+      liftIO $ when (not (null (iservPendingFrees iserv))) $
+        iservCall iserv (FreeHValueRefs (iservPendingFrees iserv))
+        -- run the inner action
+      restore $ action iserv)
+          `gonException` (liftIO $ putMVar hsc_iserv (Just iserv'))
+    liftIO $ putMVar hsc_iserv (Just iserv')
+    return a
+
+
+-- -----------------------------------------------------------------------------
+-- Wrappers around messages
+
+-- | Execute an action of type @IO [a]@, returning 'ForeignHValue's for
+-- each of the results.
+evalStmt
+  :: 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 ->
+    iservCmd hsc_env (EvalStmt (mkEvalOpts dflags step) expr)
+  handleEvalStatus hsc_env status
+ where
+  withExpr :: EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
+  withExpr (EvalThis fhv) cont =
+    withForeignRef fhv $ \hvref -> cont (EvalThis hvref)
+  withExpr (EvalApp fl fr) cont =
+    withExpr fl $ \fl' ->
+    withExpr fr $ \fr' ->
+    cont (EvalApp fl' fr')
+
+resumeStmt
+  :: HscEnv -> Bool -> ForeignRef (ResumeContext [HValueRef])
+  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
+resumeStmt hsc_env step resume_ctxt = do
+  let dflags = hsc_dflags hsc_env
+  status <- withForeignRef resume_ctxt $ \rhv ->
+    iservCmd hsc_env (ResumeStmt (mkEvalOpts dflags step) rhv)
+  handleEvalStatus hsc_env status
+
+abandonStmt :: HscEnv -> ForeignRef (ResumeContext [HValueRef]) -> IO ()
+abandonStmt hsc_env resume_ctxt = do
+  withForeignRef resume_ctxt $ \rhv ->
+    iservCmd hsc_env (AbandonStmt rhv)
+
+handleEvalStatus
+  :: HscEnv -> EvalStatus [HValueRef]
+  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
+handleEvalStatus hsc_env status =
+  case status of
+    EvalBreak a b c d e f -> return (EvalBreak a b c d e f)
+    EvalComplete alloc res ->
+      EvalComplete alloc <$> addFinalizer res
+ where
+  addFinalizer (EvalException e) = return (EvalException e)
+  addFinalizer (EvalSuccess rs) = do
+    EvalSuccess <$> mapM (mkFinalizedHValue hsc_env) rs
+
+-- | Execute an action of type @IO ()@
+evalIO :: HscEnv -> ForeignHValue -> IO ()
+evalIO hsc_env fhv = do
+  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 $ 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 $ 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 (RemotePtr ())
+mallocData hsc_env bs = iservCmd hsc_env (MallocData bs)
+
+mkCostCentres
+  :: HscEnv -> String -> [(String,String)] -> IO [RemotePtr CostCentre]
+mkCostCentres hsc_env mod ccs =
+  iservCmd hsc_env (MkCostCentres mod ccs)
+
+-- | Create a set of BCOs that may be mutually recursive.
+createBCOs :: HscEnv -> [ResolvedBCO] -> IO [HValueRef]
+createBCOs hsc_env rbcos = do
+  n_jobs <- case parMakeCount (hsc_dflags hsc_env) of
+              Nothing -> liftIO getNumProcessors
+              Just n  -> return n
+  -- Serializing ResolvedBCO is expensive, so if we're in parallel mode
+  -- (-j<n>) parallelise the serialization.
+  if (n_jobs == 1)
+    then
+      iservCmd hsc_env (CreateBCOs [runPut (put rbcos)])
+
+    else do
+      old_caps <- getNumCapabilities
+      if old_caps == n_jobs
+         then void $ evaluate puts
+         else bracket_ (setNumCapabilities n_jobs)
+                       (setNumCapabilities old_caps)
+                       (void $ evaluate puts)
+      iservCmd hsc_env (CreateBCOs puts)
+ where
+  puts = parMap doChunk (chunkList 100 rbcos)
+
+  -- make sure we force the whole lazy ByteString
+  doChunk c = pseq (LB.length bs) bs
+    where bs = runPut (put c)
+
+  -- We don't have the parallel package, so roll our own simple parMap
+  parMap _ [] = []
+  parMap f (x:xs) = fx `par` (fxs `pseq` (fx : fxs))
+    where fx = f x; fxs = parMap f xs
+
+addSptEntry :: HscEnv -> Fingerprint -> ForeignHValue -> IO ()
+addSptEntry hsc_env fpr ref =
+  withForeignRef ref $ \val ->
+    iservCmd hsc_env (AddSptEntry fpr val)
+
+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)
+
+getBreakpointVar :: HscEnv -> ForeignHValue -> Int -> IO (Maybe ForeignHValue)
+getBreakpointVar hsc_env ref ix =
+  withForeignRef ref $ \apStack -> do
+    mb <- iservCmd hsc_env (GetBreakpointVar apStack ix)
+    mapM (mkFinalizedHValue hsc_env) mb
+
+getClosure :: HscEnv -> ForeignHValue -> IO (GenClosure ForeignHValue)
+getClosure hsc_env ref =
+  withForeignRef ref $ \hval -> do
+    mb <- iservCmd hsc_env (GetClosure hval)
+    mapM (mkFinalizedHValue hsc_env) mb
+
+seqHValue :: HscEnv -> ForeignHValue -> IO ()
+seqHValue hsc_env ref =
+  withForeignRef ref $ \hval ->
+    iservCmd hsc_env (Seq hval) >>= fromEvalResult
+
+-- -----------------------------------------------------------------------------
+-- Interface to the object-code linker
+
+initObjLinker :: HscEnv -> IO ()
+initObjLinker hsc_env = iservCmd hsc_env InitLinker
+
+lookupSymbol :: HscEnv -> FastString -> IO (Maybe (Ptr ()))
+lookupSymbol hsc_env@HscEnv{..} str
+ | gopt Opt_ExternalInterpreter hsc_dflags =
+     -- Profiling of GHCi showed a lot of time and allocation spent
+     -- making cross-process LookupSymbol calls, so I added a GHC-side
+     -- cache which sped things up quite a lot.  We have to be careful
+     -- to purge this cache when unloading code though.
+     withIServ hsc_env $ \iserv@IServ{..} -> do
+       cache <- readIORef iservLookupSymbolCache
+       case lookupUFM cache str of
+         Just p -> return (Just p)
+         Nothing -> do
+           m <- uninterruptibleMask_ $
+                    iservCall iserv (LookupSymbol (unpackFS str))
+           case m of
+             Nothing -> return Nothing
+             Just r -> do
+               let p = fromRemotePtr r
+               writeIORef iservLookupSymbolCache $! addToUFM cache str p
+               return (Just p)
+ | otherwise =
+#if defined(HAVE_INTERNAL_INTERPRETER)
+   fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str))
+#else
+   needExtInt
+#endif
+
+lookupClosure :: HscEnv -> String -> IO (Maybe HValueRef)
+lookupClosure hsc_env str =
+  iservCmd hsc_env (LookupClosure str)
+
+purgeLookupSymbolCache :: HscEnv -> IO ()
+purgeLookupSymbolCache hsc_env@HscEnv{..} =
+ when (gopt Opt_ExternalInterpreter hsc_dflags) $
+   withIServ hsc_env $ \IServ{..} ->
+     writeIORef iservLookupSymbolCache emptyUFM
+
+
+-- | loadDLL loads a dynamic library using the OS's native linker
+-- (i.e. dlopen() on Unix, LoadLibrary() on Windows).  It takes either
+-- an absolute pathname to the file, or a relative filename
+-- (e.g. "libfoo.so" or "foo.dll").  In the latter case, loadDLL
+-- searches the standard locations for the appropriate library.
+--
+-- Returns:
+--
+-- Nothing      => success
+-- Just err_msg => failure
+loadDLL :: HscEnv -> String -> IO (Maybe String)
+loadDLL hsc_env str = iservCmd hsc_env (LoadDLL str)
+
+loadArchive :: HscEnv -> String -> IO ()
+loadArchive hsc_env path = do
+  path' <- canonicalizePath path -- Note [loadObj and relative paths]
+  iservCmd hsc_env (LoadArchive path')
+
+loadObj :: HscEnv -> String -> IO ()
+loadObj hsc_env path = do
+  path' <- canonicalizePath path -- Note [loadObj and relative paths]
+  iservCmd hsc_env (LoadObj path')
+
+unloadObj :: HscEnv -> String -> IO ()
+unloadObj hsc_env path = do
+  path' <- canonicalizePath path -- Note [loadObj and relative paths]
+  iservCmd hsc_env (UnloadObj path')
+
+-- Note [loadObj and relative paths]
+-- the iserv process might have a different current directory from the
+-- GHC process, so we must make paths absolute before sending them
+-- over.
+
+addLibrarySearchPath :: HscEnv -> String -> IO (Ptr ())
+addLibrarySearchPath hsc_env str =
+  fromRemotePtr <$> iservCmd hsc_env (AddLibrarySearchPath str)
+
+removeLibrarySearchPath :: HscEnv -> Ptr () -> IO Bool
+removeLibrarySearchPath hsc_env p =
+  iservCmd hsc_env (RemoveLibrarySearchPath (toRemotePtr p))
+
+resolveObjs :: HscEnv -> IO SuccessFlag
+resolveObjs hsc_env = successIf <$> iservCmd hsc_env ResolveObjs
+
+findSystemLibrary :: HscEnv -> String -> IO (Maybe String)
+findSystemLibrary hsc_env str = iservCmd hsc_env (FindSystemLibrary str)
+
+
+-- -----------------------------------------------------------------------------
+-- Raw calls and messages
+
+-- | Send a 'Message' and receive the response from the iserv process
+iservCall :: Binary a => IServ -> Message a -> IO a
+iservCall iserv@IServ{..} msg =
+  remoteCall iservPipe msg
+    `catch` \(e :: SomeException) -> handleIServFailure iserv e
+
+-- | Read a value from the iserv process
+readIServ :: IServ -> Get a -> IO a
+readIServ iserv@IServ{..} get =
+  readPipe iservPipe get
+    `catch` \(e :: SomeException) -> handleIServFailure iserv e
+
+-- | Send a value to the iserv process
+writeIServ :: IServ -> Put -> IO ()
+writeIServ iserv@IServ{..} put =
+  writePipe iservPipe put
+    `catch` \(e :: SomeException) -> handleIServFailure iserv e
+
+handleIServFailure :: IServ -> SomeException -> IO a
+handleIServFailure IServ{..} e = do
+  ex <- getProcessExitCode iservProcess
+  case ex of
+    Just (ExitFailure n) ->
+      throw (InstallationError ("ghc-iserv terminated (" ++ show n ++ ")"))
+    _ -> do
+      terminateProcess iservProcess
+      _ <- waitForProcess iservProcess
+      throw e
+
+-- -----------------------------------------------------------------------------
+-- Starting and stopping the iserv process
+
+startIServ :: DynFlags -> IO IServ
+startIServ dflags = do
+  let flavour
+        | WayProf `elem` ways dflags = "-prof"
+        | WayDyn `elem` ways dflags = "-dyn"
+        | otherwise = ""
+      prog = pgm_i dflags ++ flavour
+      opts = getOpts dflags opt_i
+  debugTraceMsg dflags 3 $ text "Starting " <> text prog
+  let createProc = lookupHook createIservProcessHook
+                              (\cp -> do { (_,_,_,ph) <- createProcess cp
+                                         ; return ph })
+                              dflags
+  (ph, rh, wh) <- runWithPipes createProc prog opts
+  lo_ref <- newIORef Nothing
+  cache_ref <- newIORef emptyUFM
+  return $ IServ
+    { iservPipe = Pipe { pipeRead = rh
+                       , pipeWrite = wh
+                       , pipeLeftovers = lo_ref }
+    , iservProcess = ph
+    , iservLookupSymbolCache = cache_ref
+    , iservPendingFrees = []
+    }
+
+stopIServ :: HscEnv -> IO ()
+stopIServ HscEnv{..} =
+  gmask $ \_restore -> do
+    m <- takeMVar hsc_iserv
+    maybe (return ()) stop m
+    putMVar hsc_iserv Nothing
+ where
+  stop iserv = do
+    ex <- getProcessExitCode (iservProcess iserv)
+    if isJust ex
+       then return ()
+       else iservCall iserv Shutdown
+
+runWithPipes :: (CreateProcess -> IO ProcessHandle)
+             -> FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)
+#if defined(mingw32_HOST_OS)
+foreign import ccall "io.h _close"
+   c__close :: CInt -> IO CInt
+
+foreign import ccall unsafe "io.h _get_osfhandle"
+   _get_osfhandle :: CInt -> IO CInt
+
+runWithPipes createProc prog opts = do
+    (rfd1, wfd1) <- createPipeFd -- we read on rfd1
+    (rfd2, wfd2) <- createPipeFd -- we write on wfd2
+    wh_client    <- _get_osfhandle wfd1
+    rh_client    <- _get_osfhandle rfd2
+    let args = show wh_client : show rh_client : opts
+    ph <- createProc (proc prog args)
+    rh <- mkHandle rfd1
+    wh <- mkHandle wfd2
+    return (ph, rh, wh)
+      where mkHandle :: CInt -> IO Handle
+            mkHandle fd = (fdToHandle fd) `onException` (c__close fd)
+
+#else
+runWithPipes createProc prog opts = do
+    (rfd1, wfd1) <- Posix.createPipe -- we read on rfd1
+    (rfd2, wfd2) <- Posix.createPipe -- we write on wfd2
+    setFdOption rfd1 CloseOnExec True
+    setFdOption wfd2 CloseOnExec True
+    let args = show wfd1 : show rfd2 : opts
+    ph <- createProc (proc prog args)
+    closeFd wfd1
+    closeFd rfd2
+    rh <- fdToHandle rfd1
+    wh <- fdToHandle wfd2
+    return (ph, rh, wh)
+#endif
+
+-- -----------------------------------------------------------------------------
+{- Note [External GHCi pointers]
+
+We have the following ways to reference things in GHCi:
+
+HValue
+------
+
+HValue is a direct reference to a value in the local heap.  Obviously
+we cannot use this to refer to things in the external process.
+
+
+RemoteRef
+---------
+
+RemoteRef is a StablePtr to a heap-resident value.  When
+-fexternal-interpreter is used, this value resides in the external
+process's heap.  RemoteRefs are mostly used to send pointers in
+messages between GHC and iserv.
+
+A RemoteRef must be explicitly freed when no longer required, using
+freeHValueRefs, or by attaching a finalizer with mkForeignHValue.
+
+To get from a RemoteRef to an HValue you can use 'wormholeRef', which
+fails with an error message if -fexternal-interpreter is in use.
+
+ForeignRef
+----------
+
+A ForeignRef is a RemoteRef with a finalizer that will free the
+'RemoteRef' when it is garbage collected.  We mostly use ForeignHValue
+on the GHC side.
+
+The finalizer adds the RemoteRef to the iservPendingFrees list in the
+IServ record.  The next call to iservCmd will free any RemoteRefs in
+the list.  It was done this way rather than calling iservCmd directly,
+because I didn't want to have arbitrary threads calling iservCmd.  In
+principle it would probably be ok, but it seems less hairy this way.
+-}
+
+-- | Creates a 'ForeignRef' that will automatically release the
+-- 'RemoteRef' when it is no longer referenced.
+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 = freeRemoteRef hvref
+    | otherwise =
+      modifyMVar_ hsc_iserv $ \mb_iserv ->
+        case mb_iserv of
+          Nothing -> return Nothing -- already shut down
+          Just iserv@IServ{..} ->
+            return (Just iserv{iservPendingFrees = hvref : iservPendingFrees})
+
+freeHValueRefs :: HscEnv -> [HValueRef] -> IO ()
+freeHValueRefs _ [] = return ()
+freeHValueRefs hsc_env refs = iservCmd hsc_env (FreeHValueRefs refs)
+
+-- | Convert a 'ForeignRef' to the value it references 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 -> ForeignRef a -> IO a
+wormhole dflags r = wormholeRef dflags (unsafeForeignRefToRemoteRef r)
+
+-- | Convert an 'RemoteRef' to the value it references 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 -> RemoteRef a -> IO a
+wormholeRef dflags _r
+  | gopt Opt_ExternalInterpreter dflags
+  = throwIO (InstallationError
+      "this operation requires -fno-external-interpreter")
+#if defined(HAVE_INTERNAL_INTERPRETER)
+  | otherwise
+  = localRef _r
+#else
+  | otherwise
+  = throwIO (InstallationError
+      "can't wormhole a value in a stage1 compiler")
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Misc utils
+
+mkEvalOpts :: DynFlags -> Bool -> EvalOpts
+mkEvalOpts dflags step =
+  EvalOpts
+    { useSandboxThread = gopt Opt_GhciSandbox dflags
+    , singleStep = step
+    , breakOnException = gopt Opt_BreakOnException dflags
+    , breakOnError = gopt Opt_BreakOnError dflags }
+
+fromEvalResult :: EvalResult a -> IO a
+fromEvalResult (EvalException e) = throwIO (fromSerializableException e)
+fromEvalResult (EvalSuccess a) = return a