fix memory leak
I'm unsure why this fixed it, but it did. Seems to suggest that the memory leak is not due to a bug in my code, but that ghc didn't manage to take full advantage of laziness, or was failing to gc something it could have.
This commit is contained in:
parent
095593a9af
commit
0f4ee4f298
3 changed files with 20 additions and 38 deletions
26
P2P/Annex.hs
26
P2P/Annex.hs
|
@ -72,15 +72,15 @@ runLocal runmode runner a = case a of
|
|||
Right b -> runner (next b)
|
||||
Right Nothing -> return (Left "content not available")
|
||||
Left e -> return (Left (show e))
|
||||
StoreContent k af o l b next -> do
|
||||
StoreContent k af o l getb next -> do
|
||||
ok <- flip catchNonAsync (const $ return False) $
|
||||
transfer download k af $
|
||||
getViaTmp AlwaysVerify k $ \tmp ->
|
||||
unVerified $ storefile tmp o l b
|
||||
unVerified $ storefile tmp o l getb
|
||||
runner (next ok)
|
||||
StoreContentTo dest o l b next -> do
|
||||
StoreContentTo dest o l getb next -> do
|
||||
ok <- flip catchNonAsync (const $ return False) $
|
||||
storefile dest o l b
|
||||
storefile dest o l getb
|
||||
runner (next ok)
|
||||
SetPresent k u next -> do
|
||||
v <- tryNonAsync $ logChange k u InfoPresent
|
||||
|
@ -120,10 +120,14 @@ runLocal runmode runner a = case a of
|
|||
-- Transfer logs are updated higher in the stack when
|
||||
-- a client.
|
||||
Client -> ta
|
||||
storefile dest (Offset o) (Len l) b = liftIO $ do
|
||||
withBinaryFile dest ReadWriteMode $ \h -> do
|
||||
when (o /= 0) $
|
||||
hSeek h AbsoluteSeek o
|
||||
L.hPut h b
|
||||
sz <- getFileSize dest
|
||||
return (toInteger sz == l + o)
|
||||
storefile dest (Offset o) (Len l) getb = do
|
||||
v <- runner getb
|
||||
case v of
|
||||
Right b -> liftIO $ do
|
||||
withBinaryFile dest ReadWriteMode $ \h -> do
|
||||
when (o /= 0) $
|
||||
hSeek h AbsoluteSeek o
|
||||
L.hPut h b
|
||||
sz <- liftIO $ getFileSize dest
|
||||
return (toInteger sz == l + o)
|
||||
Left e -> error e
|
||||
|
|
|
@ -200,7 +200,7 @@ data LocalF c
|
|||
| ReadContent Key AssociatedFile Offset (L.ByteString -> c)
|
||||
-- ^ Lazily reads the content of a key. Note that the content
|
||||
-- may change while it's being sent.
|
||||
| StoreContent Key AssociatedFile Offset Len L.ByteString (Bool -> c)
|
||||
| StoreContent Key AssociatedFile Offset Len (Proto L.ByteString) (Bool -> c)
|
||||
-- ^ Stores content to the key's temp file starting at an offset.
|
||||
-- Once the whole content of the key has been stored, moves the
|
||||
-- temp file into place as the content of the key, and returns True.
|
||||
|
@ -208,7 +208,7 @@ data LocalF c
|
|||
-- Note: The ByteString may not contain the entire remaining content
|
||||
-- of the key. Only once the temp file size == Len has the whole
|
||||
-- content been transferred.
|
||||
| StoreContentTo FilePath Offset Len L.ByteString (Bool -> c)
|
||||
| StoreContentTo FilePath Offset Len (Proto L.ByteString) (Bool -> c)
|
||||
-- ^ Stores the content to a temp file starting at an offset.
|
||||
-- Once the whole content of the key has been stored, returns True.
|
||||
--
|
||||
|
@ -388,7 +388,7 @@ sendContent key af offset@(Offset n) p = do
|
|||
net $ sendBytes len content p'
|
||||
checkSuccess
|
||||
|
||||
receiveContent :: MeterUpdate -> Local Len -> (Offset -> Len -> L.ByteString -> Local Bool) -> (Offset -> Message) -> Proto Bool
|
||||
receiveContent :: MeterUpdate -> Local Len -> (Offset -> Len -> Proto L.ByteString -> Local Bool) -> (Offset -> Message) -> Proto Bool
|
||||
receiveContent p sizer storer mkmsg = do
|
||||
Len n <- local sizer
|
||||
let p' = offsetMeterUpdate p (toBytesProcessed n)
|
||||
|
@ -397,8 +397,8 @@ receiveContent p sizer storer mkmsg = do
|
|||
r <- net receiveMessage
|
||||
case r of
|
||||
DATA len -> do
|
||||
ok <- local . storer offset len
|
||||
=<< net (receiveBytes len p')
|
||||
ok <- local $ storer offset len
|
||||
(net (receiveBytes len p'))
|
||||
sendSuccess ok
|
||||
return ok
|
||||
_ -> do
|
||||
|
|
|
@ -4,28 +4,6 @@ Mostly working!
|
|||
|
||||
Current todo list:
|
||||
|
||||
* copy --to peer of a 100 mb file causes the memory of the remotedaemon
|
||||
to creep up from 40 mb to 136 mb. Once the transfer is done, the
|
||||
remotedaemon continues using all that memory. Memory leak. Profile it.
|
||||
(The sending process creeps up some initially, but stops at 45 mb used.
|
||||
That could just be buffering.)
|
||||
(copy --from peer does not leak on either end; the remotedaemon uses 34
|
||||
mb and the receiver 44 mb.)
|
||||
|
||||
Profiling results: Leak is in hGetMetered, or perhaps in
|
||||
the consumer of the data it reads. Graph shows `ARR_WORDS` is
|
||||
the type; that must be a bytestring.
|
||||
|
||||
<pre> individual inherited
|
||||
COST CENTRE MODULE no. entries %time %alloc %time %alloc
|
||||
tryNonAsync Utility.Exception 3241 0 0.0 0.1 49.3 65.8
|
||||
receiveExactly P2P.IO 3429 0 0.0 0.0 49.3 65.7
|
||||
hGetMetered Utility.Metered 3430 0 49.1 65.6 49.3 65.7
|
||||
</pre>
|
||||
|
||||
Switching to L.hGet, it still leaks, so seems hGetMetered is not at fault
|
||||
and the bytestring is being buffered excessively somehow.
|
||||
|
||||
* When a transfer can't be done because another transfer of the same
|
||||
object is already in progress, the message about this is output by the
|
||||
remotedaemon --debug, but not forwarded to the peer, which shows
|
||||
|
|
Loading…
Reference in a new issue