Process memory usage metric via VmRss from /proc/self/status

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,19 +421,21 @@ 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.
   let !result = force (run arg)
   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,19 +483,21 @@ 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.
   !result <- fmap force (run arg)
   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

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
+

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