diff --git a/src/Weigh.hs b/src/Weigh.hs index b38fb62..4773070 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 @@ -108,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) @@ -134,6 +136,7 @@ data Weight = ,weightLiveBytes :: !Word64 ,weightMaxBytes :: !Word64 ,weightMaxOSBytes :: !Word64 + ,weightMaxRssBytes :: !Word64 ,weightWallTime :: !Double } deriving (Read,Show) @@ -344,7 +347,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 +362,7 @@ weighDispatch args cases = , weightLiveBytes = liveBytes , weightMaxBytes = maxByte , weightMaxOSBytes = maxOSBytes + , weightMaxRssBytes = maxRssBytes , weightWallTime = end - start })) return Nothing @@ -408,7 +412,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 +421,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 +435,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 +459,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 +474,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 +483,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 +497,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 +524,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 )) -------------------------------------------------------------------------------- @@ -575,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) = @@ -584,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 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