Commit 7a68254a authored by Phuong Trinh's avatar Phuong Trinh Committed by Marge Bot

Fix #16392: revertCAFs in external interpreter when necessary

We revert CAFs when loading/adding modules in ghci (presumably to refresh
execution states and to allow for object code to be unloaded from the runtime).
However, with `-fexternal-interpreter` enabled, we are only doing it in the
ghci process instead of the external interpreter process where the cafs are
allocated and computed. This makes sure that revertCAFs is done in the
appropriate process no matter if that flag is present or not.
parent 25c3dd39
Pipeline #3221 passed with stages
in 306 minutes and 35 seconds
......@@ -456,14 +456,13 @@ printStats dflags ActionStats{actionAllocs = mallocs, actionElapsedTime = secs}
revertCAFs :: GhciMonad m => m ()
revertCAFs = do
liftIO rts_revertCAFs
hsc_env <- GHC.getSession
liftIO $ iservCmd hsc_env RtsRevertCAFs
s <- getGHCiState
when (not (ghc_e s)) turnOffBuffering
-- Have to turn off buffering again, because we just
-- reverted stdout, stderr & stdin to their defaults.
foreign import ccall "revertCAFs" rts_revertCAFs :: IO ()
-- Make it "safe", just in case
-----------------------------------------------------------------------------
-- To flush buffers for the *interpreted* computation we need
......
......@@ -61,6 +61,7 @@ import System.IO.Error
data Message a where
-- | Exit the iserv process
Shutdown :: Message ()
RtsRevertCAFs :: Message ()
-- RTS Linker -------------------------------------------
......@@ -485,7 +486,9 @@ getMessage = do
33 -> Msg <$> (AddSptEntry <$> get <*> get)
34 -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)
35 -> Msg <$> (GetClosure <$> get)
_ -> Msg <$> (Seq <$> get)
36 -> Msg <$> (Seq <$> get)
37 -> Msg <$> return RtsRevertCAFs
_ -> error $ "Unknown Message code " ++ (show b)
putMessage :: Message a -> Put
putMessage m = case m of
......@@ -526,6 +529,7 @@ putMessage m = case m of
RunTH st q loc ty -> putWord8 34 >> put st >> put q >> put loc >> put ty
GetClosure a -> putWord8 35 >> put a
Seq a -> putWord8 36 >> put a
RtsRevertCAFs -> putWord8 37
-- -----------------------------------------------------------------------------
-- Reading/writing messages
......
......@@ -44,9 +44,13 @@ import Unsafe.Coerce
-- -----------------------------------------------------------------------------
-- Implement messages
foreign import ccall "revertCAFs" rts_revertCAFs :: IO ()
-- Make it "safe", just in case
run :: Message a -> IO a
run m = case m of
InitLinker -> initObjLinker RetainCAFs
RtsRevertCAFs -> rts_revertCAFs
LookupSymbol str -> fmap toRemotePtr <$> lookupSymbol str
LookupClosure str -> lookupClosure str
LoadDLL str -> loadDLL str
......
module A (caf, c_two) where
import Debug.Trace (trace)
data C = C Int Int
caf :: C
caf = C 3 (trace "value forced" 4)
c_two :: C -> Int
c_two (C _ b) = b
:set -fobject-code
:load A.hs
c_two caf
:load A.hs
c_two caf
test('T16392',
[extra_files(['A.hs']),
extra_ways(['ghci-ext'])],
ghci_script, ['T16392.script'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment