summaryrefslogtreecommitdiff
path: root/libraries/ghc-compact
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2020-10-06 12:46:40 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-02-14 03:35:07 -0500
commitee77148ede2c51d99cad75da9d4097c892f8017d (patch)
tree3f66b0ede8e12a2ccc904c55e06f5123f08aba45 /libraries/ghc-compact
parent267d31c18be5c1cdf8eef0f8c1dc8b532a892059 (diff)
downloadhaskell-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.hs12
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) #)