diff options
author | Ben Gamari <ben@smart-cactus.org> | 2020-10-06 12:46:40 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2020-12-27 11:24:26 -0500 |
commit | a193728e20cd44d4d33952d3d267d382f5bdf90c (patch) | |
tree | 52860eb1ba0121cbefea69288c7042768e84e69a | |
parent | b4b87a3af43df9f9191910ca9859811a25982af1 (diff) | |
download | haskell-a193728e20cd44d4d33952d3d267d382f5bdf90c.tar.gz |
ghc-compact: Use keepAlive# in GHC.Compact.Serialized
(cherry picked from commit de1b380a17ceccb095a5c772846cd5c0215242ac)
-rw-r--r-- | libraries/ghc-compact/GHC/Compact/Serialized.hs | 12 |
1 files changed, 2 insertions, 10 deletions
diff --git a/libraries/ghc-compact/GHC/Compact/Serialized.hs b/libraries/ghc-compact/GHC/Compact/Serialized.hs index ac79c95b16..943aabf012 100644 --- a/libraries/ghc-compact/GHC/Compact/Serialized.hs +++ b/libraries/ghc-compact/GHC/Compact/Serialized.hs @@ -29,6 +29,7 @@ module GHC.Compact.Serialized( import GHC.Prim import GHC.Types import GHC.Word (Word8) +import GHC.IO (unIO) import GHC.Ptr (Ptr(..), plusPtr) @@ -74,12 +75,6 @@ mkBlockList buffer = compactGetFirstBlock buffer >>= go rest <- go next return $ item : rest --- We MUST mark withSerializedCompact as NOINLINE --- Otherwise the compiler will eliminate the call to touch# --- causing the Compact# to be potentially GCed too eagerly, --- before func had a chance to copy everything into its own --- buffers/sockets/whatever - -- | Serialize the 'Compact', and call the provided function with -- with the 'Compact' serialized representation. It is not safe -- to return the pointer from the action and use it after @@ -89,7 +84,6 @@ mkBlockList buffer = compactGetFirstBlock buffer >>= go -- unsound to use 'unsafeInterleaveIO' to lazily construct -- a lazy bytestring from the 'Ptr'. -- -{-# NOINLINE withSerializedCompact #-} withSerializedCompact :: Compact a -> (SerializedCompact a -> IO c) -> IO c withSerializedCompact (Compact buffer root lock) func = withMVar lock $ \_ -> do @@ -97,9 +91,7 @@ withSerializedCompact (Compact buffer root lock) func = withMVar lock $ \_ -> do (# s', rootAddr #) -> (# s', Ptr rootAddr #) ) blockList <- mkBlockList buffer let serialized = SerializedCompact blockList rootPtr - r <- func serialized - IO (\s -> case touch# buffer s of - s' -> (# s', r #) ) + IO $ \s -> keepAlive# buffer s (unIO $ func serialized) fixupPointers :: Addr# -> Addr# -> State# RealWorld -> (# State# RealWorld, Maybe (Compact a) #) |