From 5d5488b5b1690e5ffb3e268bab9893aac3e32f89 Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 25 Jan 2017 10:17:13 -0500 Subject: Live memory usage information. --- examples/dhtd.hs | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) (limited to 'examples') diff --git a/examples/dhtd.hs b/examples/dhtd.hs index c3c0ed15..05a3de26 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs @@ -26,6 +26,8 @@ import Text.Printf import Text.Read import Control.Monad.Reader.Class import System.Posix.Process (getProcessID) +import GHC.Stats +import System.Mem import Data.Torrent (InfoHash) import Network.BitTorrent.Address @@ -187,6 +189,38 @@ clientSession st signalQuit sock n h = do tm <- getCurrentTime let r = map (\PerThread{..} -> (show lbl,show (diffUTCTime tm startTime))) ts hPutClient h $ showReport r + ("mem", s) -> cmd $ return $ do + case s of + "gc" -> do hPutClient h "Performing garbage collection..." + performMajorGC + "" -> do + is_enabled <- getGCStatsEnabled + if is_enabled + then do + GCStats{..} <- getGCStats + let r = [ ("bytesAllocated", show bytesAllocated) + , ("numGcs", show numGcs) + , ("maxBytesUsed", show maxBytesUsed) + , ("numByteUsageSamples", show numByteUsageSamples) + , ("cumulativeBytesUsed", show cumulativeBytesUsed) + , ("bytesCopied", show bytesCopied) + , ("currentBytesUsed", show currentBytesUsed) + , ("currentBytesSlop", show currentBytesSlop) + , ("maxBytesSlop", show maxBytesSlop) + , ("peakMegabytesAllocated", show peakMegabytesAllocated) + , ("mutatorCpuSeconds", show mutatorCpuSeconds) + , ("mutatorWallSeconds", show mutatorWallSeconds) + , ("gcCpuSeconds", show gcCpuSeconds) + , ("gcWallSeconds", show gcWallSeconds) + , ("cpuSeconds", show cpuSeconds) + , ("wallSeconds", show wallSeconds) + , ("parTotBytesCopied", show parTotBytesCopied) + , ("parMaxBytesCopied", show parMaxBytesCopied) + ] + hPutClient h $ showReport r + else hPutClient h "Run with +RTS -T to obtain live memory-usage information." + _ -> hPutClient h "error." + #endif ("closest", s) -> cmd $ do let (ns,hs) = second (dropWhile isSpace) $ break isSpace s -- cgit v1.2.3