From 5feaa0bd0a2cf708ff96626e371e4f20c75940f8 Mon Sep 17 00:00:00 2001 From: Dmitry Krylov Date: Tue, 3 Mar 2020 22:11:01 +1000 Subject: [PATCH 1/3] Add used memory measure via VmRSS from /proc/self/status --- src/Weigh.hs | 22 ++++++++++++++++------ src/Weigh/OsStats.hs | 32 ++++++++++++++++++++++++++++++++ weigh.cabal | 1 + 3 files changed, 49 insertions(+), 6 deletions(-) create mode 100644 src/Weigh/OsStats.hs diff --git a/src/Weigh.hs b/src/Weigh.hs index b38fb62..2ac56f3 100644 --- a/src/Weigh.hs +++ b/src/Weigh.hs @@ -93,6 +93,7 @@ import System.Mem import System.Process import Text.Printf import qualified Weigh.GHCStats as GHCStats +import qualified Weigh.OsStats as OsStats -------------------------------------------------------------------------------- -- Types @@ -134,6 +135,7 @@ data Weight = ,weightLiveBytes :: !Word64 ,weightMaxBytes :: !Word64 ,weightMaxOSBytes :: !Word64 + ,weightMaxRssBytes :: !Word64 ,weightWallTime :: !Double } deriving (Read,Show) @@ -344,7 +346,7 @@ weighDispatch args cases = Action !run arg _ _ -> do initializeTime start <- getTime - (bytes, gcs, liveBytes, maxByte, maxOSBytes) <- + (bytes, gcs, liveBytes, maxByte, maxOSBytes, maxRssBytes) <- case run of Right f -> weighFunc f arg Left m -> weighAction m arg @@ -359,6 +361,7 @@ weighDispatch args cases = , weightLiveBytes = liveBytes , weightMaxBytes = maxByte , weightMaxOSBytes = maxOSBytes + , weightMaxRssBytes = maxRssBytes , weightWallTime = end - start })) return Nothing @@ -408,7 +411,7 @@ weighFunc :: (NFData a) => (b -> a) -- ^ A function whose memory use we want to measure. -> b -- ^ Argument to the function. Doesn't have to be forced. - -> IO (Word64,Word32,Word64,Word64,Word64) -- ^ Bytes allocated and garbage collections. + -> IO (Word64,Word32,Word64,Word64,Word64,Word64) -- ^ Bytes allocated and garbage collections. weighFunc run !arg = snd <$> weighFuncResult run arg -- | Weigh a pure function and return the result. This function is heavily @@ -417,12 +420,13 @@ weighFuncResult :: (NFData a) => (b -> a) -- ^ A function whose memory use we want to measure. -> b -- ^ Argument to the function. Doesn't have to be forced. - -> IO (a, (Word64,Word32,Word64,Word64,Word64)) -- ^ Result, Bytes allocated, GCs. + -> IO (a, (Word64,Word32,Word64,Word64,Word64,Word64)) -- ^ Result, Bytes allocated, GCs. weighFuncResult run !arg = do ghcStatsSizeInBytes <- GHCStats.getGhcStatsSizeInBytes performGC -- The above forces getStats data to be generated NOW. !bootupStats <- GHCStats.getStats + !bootupTotalRssInBytes <- OsStats.getVmRss -- We need the above to subtract "program startup" overhead. This -- operation itself adds n bytes for the size of GCStats, but we -- subtract again that later. @@ -430,6 +434,7 @@ weighFuncResult run !arg = do performGC -- The above forces getStats data to be generated NOW. !actionStats <- GHCStats.getStats + !actionTotalRssInBytes <- OsStats.getVmRss let reflectionGCs = 1 -- We performed an additional GC. actionBytes = (GHCStats.totalBytesAllocated actionStats `subtracting` @@ -453,7 +458,8 @@ weighFuncResult run !arg = do maxOSBytes = (GHCStats.maxOSBytes actionStats `subtracting` GHCStats.maxOSBytes bootupStats) - return (result, (actualBytes, actionGCs, liveBytes, maxBytes, maxOSBytes)) + maxRssBytes = actionTotalRssInBytes `subtracting` bootupTotalRssInBytes + return (result, (actualBytes, actionGCs, liveBytes, maxBytes, maxOSBytes, maxRssBytes)) subtracting :: (Ord p, Num p) => p -> p -> p subtracting x y = @@ -467,7 +473,7 @@ weighAction :: (NFData a) => (b -> IO a) -- ^ A function whose memory use we want to measure. -> b -- ^ Argument to the function. Doesn't have to be forced. - -> IO (Word64,Word32,Word64,Word64,Word64) -- ^ Bytes allocated and garbage collections. + -> IO (Word64,Word32,Word64,Word64,Word64,Word64) -- ^ Bytes allocated and garbage collections. weighAction run !arg = snd <$> weighActionResult run arg -- | Weigh an IO action, and return the result. This function is heavily @@ -476,12 +482,13 @@ weighActionResult :: (NFData a) => (b -> IO a) -- ^ A function whose memory use we want to measure. -> b -- ^ Argument to the function. Doesn't have to be forced. - -> IO (a, (Word64,Word32,Word64,Word64,Word64)) -- ^ Result, Bytes allocated and GCs. + -> IO (a, (Word64,Word32,Word64,Word64,Word64,Word64)) -- ^ Result, Bytes allocated and GCs. weighActionResult run !arg = do ghcStatsSizeInBytes <- GHCStats.getGhcStatsSizeInBytes performGC -- The above forces getStats data to be generated NOW. !bootupStats <- GHCStats.getStats + !bootupTotalRssInBytes <- OsStats.getVmRss -- We need the above to subtract "program startup" overhead. This -- operation itself adds n bytes for the size of GCStats, but we -- subtract again that later. @@ -489,6 +496,7 @@ weighActionResult run !arg = do performGC -- The above forces getStats data to be generated NOW. !actionStats <- GHCStats.getStats + !actionTotalRssInBytes <- OsStats.getVmRss let reflectionGCs = 1 -- We performed an additional GC. actionBytes = (GHCStats.totalBytesAllocated actionStats `subtracting` @@ -515,12 +523,14 @@ weighActionResult run !arg = do 0 (GHCStats.maxOSBytes actionStats `subtracting` GHCStats.maxOSBytes bootupStats) + maxRssBytes = actionTotalRssInBytes `subtracting` bootupTotalRssInBytes return (result, ( actualBytes , actionGCs , liveBytes , maxBytes , maxOSBytes + , maxRssBytes )) -------------------------------------------------------------------------------- diff --git a/src/Weigh/OsStats.hs b/src/Weigh/OsStats.hs new file mode 100644 index 0000000..72d5684 --- /dev/null +++ b/src/Weigh/OsStats.hs @@ -0,0 +1,32 @@ +module Weigh.OsStats + ( getVmRssWithError + , getVmRss + ) + where + + +import Text.Read +import Data.List +import Data.Word + + +getVmRss :: IO Word64 +getVmRss = either (const 0) id <$> getVmRssWithError + + +-- | Get 'VmRSS' (resident set size) from file "/proc/self/status". +-- Returns either error message or memory size in bytes. +-- +getVmRssWithError :: IO (Either String Word64) +getVmRssWithError = do + stat <- readFile "/proc/self/status" + return $ + case filter (isPrefixOf "VmRSS:") $ lines stat of + [] -> Left "No VmRSS line in /proc/self/status" + (line:_) -> + case words line of + "VmRSS:":sz:"kB":[] -> (* kb) <$> readEither sz + _ -> Left $ "Can't parse \"" ++ line ++ "\"" + where + kb = 1024 + diff --git a/weigh.cabal b/weigh.cabal index 18ba3e4..508ed75 100644 --- a/weigh.cabal +++ b/weigh.cabal @@ -19,6 +19,7 @@ library ghc-options: -Wall -O2 exposed-modules: Weigh other-modules: Weigh.GHCStats + , Weigh.OsStats build-depends: base >= 4.7 && < 5 , process , deepseq From 32492f462105c55c600715b340759f8bcb7a94aa Mon Sep 17 00:00:00 2001 From: Dmitry Krylov Date: Tue, 3 Mar 2020 22:18:10 +1000 Subject: [PATCH 2/3] Add columns for used memory measure via VmRSS from /proc/self/status --- src/Weigh.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Weigh.hs b/src/Weigh.hs index 2ac56f3..7291fca 100644 --- a/src/Weigh.hs +++ b/src/Weigh.hs @@ -109,6 +109,7 @@ data Column | MaxOS -- ^ Maximum memory in use by the RTS. Valid only for -- GHC >= 8.2.2. For unsupported GHC, this is reported -- as 0. + | MaxRss -- ^ Maximum residency memory in use (via OS) | WallTime -- ^ Rough execution time. For general indication, not a benchmark tool. deriving (Show, Eq, Enum) @@ -585,6 +586,7 @@ reportTabular config = tabled , (Check, (True, "Check")) , (Max, (False, "Max")) , (MaxOS, (False, "MaxOS")) + , (MaxRss, (False, "MaxRss")) , (WallTime, (False, "Wall Time")) ] toRow (w, err) = @@ -594,6 +596,7 @@ reportTabular config = tabled , (Live, (False, commas (weightLiveBytes w))) , (Max, (False, commas (weightMaxBytes w))) , (MaxOS, (False, commas (weightMaxOSBytes w))) + , (MaxRss, (False, commas (weightMaxRssBytes w))) , (WallTime, (False, printf "%.3fs" (weightWallTime w))) , ( Check , ( True From ba6e86072740cf6f5b2d3b924be8c1058eda1185 Mon Sep 17 00:00:00 2001 From: Dmitry Krylov Date: Tue, 3 Mar 2020 22:56:54 +1000 Subject: [PATCH 3/3] Fix spaces --- src/Weigh.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Weigh.hs b/src/Weigh.hs index 7291fca..4773070 100644 --- a/src/Weigh.hs +++ b/src/Weigh.hs @@ -531,7 +531,7 @@ weighActionResult run !arg = do , liveBytes , maxBytes , maxOSBytes - , maxRssBytes + , maxRssBytes )) --------------------------------------------------------------------------------