diff options
| author | simonmar <unknown> | 2000-04-14 16:17:47 +0000 |
|---|---|---|
| committer | simonmar <unknown> | 2000-04-14 16:17:47 +0000 |
| commit | bc7b4b64c0c55c99c6c7bb8b9290aa9e916edda7 (patch) | |
| tree | ffa5b0f2892edfa71f258d43e73deb5f3b2ac0b9 | |
| parent | a586da3a7156cd3aa32f0491ef42d7d1b5de4972 (diff) | |
| download | haskell-bc7b4b64c0c55c99c6c7bb8b9290aa9e916edda7.tar.gz | |
[project @ 2000-04-14 16:17:47 by simonmar]
catch exceptions around commitBuffer and free the buffer. This closes
one memory leak in the new I/O stuff, there may be another small one left.
| -rw-r--r-- | ghc/lib/std/PrelIO.lhs | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/ghc/lib/std/PrelIO.lhs b/ghc/lib/std/PrelIO.lhs index 43e0c631bf..c0a957f462 100644 --- a/ghc/lib/std/PrelIO.lhs +++ b/ghc/lib/std/PrelIO.lhs @@ -500,6 +500,13 @@ write_buf fo buf count = do then write_buf fo buf (count - rc) -- partial write else return rc +-- a version of commitBuffer that will free the buffer if an exception is received. +-- DON'T use this if you intend to use the buffer again! +checkedCommitBuffer handle buf sz count flush + = catchException (commitBuffer handle buf sz count flush) + (\e -> do withHandle__ handle (\h_ -> freeBuffer h_ buf sz) + throw e) + foreign import "memcpy" unsafe memcpy :: Addr -> Addr -> Int -> IO () \end{code} @@ -529,7 +536,7 @@ writeLines handle buf bufLen s = let next_n = n + 1 if next_n == bufLen || x == '\n' then do - commitBuffer hdl buf len next_n True{-needs flush-} + checkedCommitBuffer hdl buf len next_n True{-needs flush-} shoveString 0 xs else shoveString next_n xs @@ -553,7 +560,7 @@ writeLines hdl buf len@(I# bufLen) s = let next_n = n +# 1# if next_n ==# bufLen || x `eqChar#` '\n'# then do - commitBuffer hdl buf len (I# next_n) True{-needs flush-} + checkedCommitBuffer hdl buf len (I# next_n) True{-needs flush-} shoveString 0# xs else shoveString next_n xs @@ -575,7 +582,7 @@ writeBlocks hdl buf bufLen s = let next_n = n + 1 if next_n == bufLen then do - commitBuffer hdl buf len next_n True{-needs flush-} + checkedCommitBuffer hdl buf len next_n True{-needs flush-} shoveString 0 xs else shoveString next_n xs @@ -597,7 +604,7 @@ writeBlocks hdl buf len@(I# bufLen) s = let next_n = n +# 1# if next_n ==# bufLen then do - commitBuffer hdl buf len (I# next_n) True{-needs flush-} + checkedCommitBuffer hdl buf len (I# next_n) True{-needs flush-} shoveString 0# xs else shoveString next_n xs |