diff options
author | Ben Gamari <ben@smart-cactus.org> | 2020-10-06 12:46:40 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-14 03:35:07 -0500 |
commit | ee77148ede2c51d99cad75da9d4097c892f8017d (patch) | |
tree | 3f66b0ede8e12a2ccc904c55e06f5123f08aba45 /libraries/ghc-compact | |
parent | 267d31c18be5c1cdf8eef0f8c1dc8b532a892059 (diff) | |
download | haskell-ee77148ede2c51d99cad75da9d4097c892f8017d.tar.gz |
ghc-compact: Use keepAlive# in GHC.Compact.Serialized
Diffstat (limited to 'libraries/ghc-compact')
-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) #) |