dph-event-seer: Patches from Amos
authorBen Lippmeier <benl@ouroborus.net>
Mon, 30 Jul 2012 01:43:01 +0000 (11:43 +1000)
committerBen Lippmeier <benl@ouroborus.net>
Mon, 30 Jul 2012 01:43:01 +0000 (11:43 +1000)
dph-event-seer/LICENSE [new file with mode: 0644]
dph-event-seer/dph-event-seer.cabal [new file with mode: 0644]
dph-event-seer/src/HecUsage.hs [new file with mode: 0644]
dph-event-seer/src/HecWake.hs [new file with mode: 0644]
dph-event-seer/src/Main.hs [new file with mode: 0644]

diff --git a/dph-event-seer/LICENSE b/dph-event-seer/LICENSE
new file mode 100644 (file)
index 0000000..d758019
--- /dev/null
@@ -0,0 +1,36 @@
+Copyright (c) 2001-2012, The DPH Team
+
+The DPH Team is:
+  Manuel M T Chakravarty
+  Gabriele Keller
+  Roman Leshchinskiy
+  Ben Lippmeier
+  George Roldugin
+  Amos Robinson
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
diff --git a/dph-event-seer/dph-event-seer.cabal b/dph-event-seer/dph-event-seer.cabal
new file mode 100644 (file)
index 0000000..95b9e94
--- /dev/null
@@ -0,0 +1,24 @@
+Name:                dph-event-seer
+Version:             0.0.0.1
+License:             BSD3
+License-file:        LICENSE
+Author:              The DPH Team
+Maintainer:          Ben Lippmeier <benl@ouroborus.net>, Amos Robinson <amos.robinson@gmail.com>
+Build-Type:          Simple
+Cabal-Version:       >=1.6
+Stability:           experimental
+Category:            Data Structures
+Homepage:            http://www.haskell.org/haskellwiki/GHC/Data_Parallel_Haskell
+Description:         DPH Event Statistic Extractor
+Synopsis:            Analyse eventlog files for time spent in garbage collection, how many HECs are running, and time between thread wakeups.
+
+Executable dph-event-seer
+  Build-depends:
+        base                == 4.*,
+        containers          == 0.4.*,
+        ghc-events          == 0.4.*
+
+  Main-is:        Main.hs
+  hs-source-dirs: src
+  ghc-options:    -O2 -Wall
+  extensions: BangPatterns PatternGuards
diff --git a/dph-event-seer/src/HecUsage.hs b/dph-event-seer/src/HecUsage.hs
new file mode 100644 (file)
index 0000000..c609bd0
--- /dev/null
@@ -0,0 +1,90 @@
+-- HEC usage analysis.
+--      Count time spent with none, some and all HECs active or in garbage collection.
+module HecUsage where
+
+import GHC.RTS.Events
+import GHC.RTS.Events.Analysis
+
+import Data.Map (Map)
+import qualified Data.Map as M
+
+-- | Count results as either N HECs active, or some GC going on
+data HecCurrentCap = HecCap Int | HecGC
+    deriving (Show,Eq,Ord)
+
+data HecUsageState = HecUsageState
+    (Map HecCurrentCap Timestamp) -- ^ results map of active HECs to total time spent
+    Int                           -- ^ threads running
+    Int                           -- ^ threads in GC
+    Timestamp                     -- ^ time of previous event
+    Timestamp                     -- ^ total time spent
+
+hecUsageMachine :: Machine HecUsageState CapEvent
+hecUsageMachine = Machine
+    { initial = HecUsageState M.empty 0 0 0 0
+    , final   = const False
+    , alpha   = alph
+    , delta   = delt
+    }
+ where
+  -- Ignore events with no HEC associated
+  alph (CapEvent Nothing _) = False
+  alph (CapEvent _ (Event _ evt)) = alph_evt evt
+  alph _ = False
+
+  -- Only interested in threads starting, stopping, and GC events
+  alph_evt (RunThread _)        = True
+  alph_evt (StopThread _ _)     = True
+  alph_evt (StartGC)            = True
+  alph_evt (EndGC)              = True
+  alph_evt _                    = False
+
+  {-# INLINE delt #-}
+  delt (HecUsageState counts runR runG timelast timetotal)
+        (CapEvent (Just _cap) (Event timenow evtinfo))
+   = let
+        -- Update number of active threads and GCs
+        (runR',runG')
+          = case evtinfo of
+              RunThread _     -> (runR + 1, runG)
+              StopThread _ _  -> (runR - 1, runG)
+              StartGC         -> (runR, runG + 1)
+              EndGC           -> (runR, runG - 1)
+              _               -> (runR, runG)
+        diff    = timenow - timelast
+        -- Insert into results
+        counts' = update counts (hecCapOf runR runG) diff
+        -- Count total time
+        total'  = timetotal + diff
+     in
+        Just $ HecUsageState counts' runR' runG' timenow total'
+  delt _ _ = Nothing
+
+  -- If HECs are active and GC is running, count it as active time.
+  -- Only count GC time if no HECs active.
+  hecCapOf 0 0          = HecCap 0
+  hecCapOf 0 n | n > 0  = HecGC
+  hecCapOf n _          = HecCap n
+
+  update !counts !k !v = M.insertWith' (+) k v counts
+
+
+showValidate :: (s -> String) -> (i -> String) -> Either (s, i) s -> String
+showValidate showState showInput (Left (state, input)) =
+  "Invalid eventlog:"
+  ++ "\nState:\n" ++ ( showState state )
+  ++ "\nInput:\n" ++ ( showInput input )
+showValidate showState _ (Right state) =
+  "Valid eventlog: " ++ ( showState state )
+
+showMap :: Ord k => (k -> String) -> (a -> String) -> M.Map k a -> String
+showMap showKey showValue m =
+  concat $ zipWith (++)
+    (map showKey . M.keys $ m :: [String])
+    (map (showValue . (M.!) m) . M.keys $ m :: [String])
+
+showHecUsage :: HecUsageState -> String
+showHecUsage (HecUsageState counts runR runG _ total) = "\n" ++ counts' ++ running'
+ where
+  counts' = showMap show (\v -> ":\t" ++ show (v * 100 `div` total) ++ "%\t(" ++ show v ++ ")\n") counts
+  running'= if (runR,runG) == (0,0) then "" else "\nSome threads still running? " ++ show (runR,runG)
diff --git a/dph-event-seer/src/HecWake.hs b/dph-event-seer/src/HecWake.hs
new file mode 100644 (file)
index 0000000..0f8424d
--- /dev/null
@@ -0,0 +1,85 @@
+-- HEC wakeup analysis
+--      Find the times between a HEC asking to wake a thread on a different HEC.
+module HecWake where
+
+import GHC.RTS.Events
+import GHC.RTS.Events.Analysis
+
+import Data.Map (Map)
+import qualified Data.Map as M
+
+import Data.List (sortBy)
+
+
+-- | A single wake-up event. List of these used for results.
+data HecWake = HecWake
+                !Timestamp -- ^ length
+                !Timestamp -- ^ when
+                !ThreadId
+
+data HecWakeState = HecWakeState (Map ThreadId Timestamp) [HecWake]
+
+hecWakeMachine :: Machine HecWakeState CapEvent
+hecWakeMachine = Machine
+  { initial = HecWakeState M.empty []
+  , final   = const False
+  , alpha   = alph
+  , delta   = delt
+  }
+ where
+  alph (CapEvent Nothing _) = False
+  alph (CapEvent _ (Event _ (RunThread _))) = True
+  -- Only wakeups that are pointed at other caps
+  alph (CapEvent (Just thiscap) (Event _ (WakeupThread _ other))) = thiscap /= other
+  alph _ = False
+
+  -- Record the wake request, so we can find time difference when it starts
+  delt (HecWakeState !waketimes lens) (CapEvent (Just thiscap) (Event timenow (WakeupThread tid other)))
+   | thiscap /= other
+   = Just $ HecWakeState (ins tid timenow waketimes) lens
+  -- Record time difference when a thread starts
+  delt (HecWakeState !waketimes !lens) (CapEvent (Just _cap) (Event timenow (RunThread tid)))
+   | Just timethen <- M.lookup tid waketimes
+   = let wake' = HecWake (timenow - timethen) timethen tid in
+     Just $ HecWakeState (M.delete tid waketimes) (wake' : lens)
+  delt s _ = Just s
+
+  -- Record wakeup, but don't overwrite an older value
+  ins !k !v !m
+        | M.member k m  = m
+        | otherwise     = M.insert k v m
+
+
+
+showHecWake :: HecWakeState -> String
+showHecWake (HecWakeState waketimes lens) = waketimes' ++ "\n" ++ lens'
+ where
+  waketimes' = if M.null waketimes then "" else "not all threads scheduled to wake up actually woke up!"
+
+  lens'
+   = if null lens
+        then "No wakes"
+        else concat
+            [   "Min: ", show minL
+            , "\nMax: ", show maxL
+            , "\nMed: ", show medianL
+            , "\nAvg: ", show avgL
+            , "\nCount: ", show (length lens)
+            ]
+  sorted  = sortBy cmp lens
+  lenL    = length sorted
+
+  minL    = head sorted
+  maxL    = last sorted
+  avgL    = fromEnum (sum $ map lenOf sorted) `div` lenL
+
+  medianL = if lenL `mod` 2 == 0
+            then (lenOf (sorted !! lenL_2) + lenOf (sorted !! (lenL_2 - 1))) `div` 2
+            else lenOf $ sorted !! lenL_2
+  lenL_2  = lenL `div` 2
+
+  cmp x y = lenOf x `compare` lenOf y
+  lenOf (HecWake len _ _) = len
+
+instance Show HecWake where
+  show (HecWake len when what) = concat [show len, " (@", show when, ", thread " , show what, ")"]
diff --git a/dph-event-seer/src/Main.hs b/dph-event-seer/src/Main.hs
new file mode 100644 (file)
index 0000000..674f081
--- /dev/null
@@ -0,0 +1,67 @@
+-- DPH Event Seer.
+--      Analyse log files for time spent in GC, time spent with all CPUs active, etc.
+--      Compile your program with "-eventlog" and then run with "+RTS -l",
+--      then parse the eventlog with this.
+module Main where
+
+import GHC.RTS.Events
+import GHC.RTS.Events.Analysis
+
+import System.Environment
+import System.IO
+import System.Exit
+
+import HecUsage
+import HecWake
+
+main :: IO ()
+main = getArgs >>= command
+
+command :: [String] -> IO ()
+
+command ["--help"] = do
+    putStr usage
+
+command ["show", file] = do
+    eventLog <- readLogOrDie file
+    putStrLn $ ppEventLog eventLog
+
+command ["usage", file] = do
+    eventLog <- readLogOrDie file
+    let capEvents = sortEvents . events . dat $ eventLog
+    let result = validate hecUsageMachine capEvents
+    putStrLn $ showValidate showHecUsage show result
+
+command ["wake", file] = do
+    eventLog <- readLogOrDie file
+    let capEvents = sortEvents . events . dat $ eventLog
+    let result = validate hecWakeMachine capEvents
+    putStrLn $ showValidate showHecWake show result
+
+command _ = putStr usage >> die "Unrecognized command"
+
+usage :: String
+usage = unlines $ map pad strings
+ where
+    align = 4 + (maximum . map (length . fst) $ strings)
+    pad (x, y) = zipWith const (x ++ repeat ' ') (replicate align ()) ++ y
+    strings = [ ("dph-event-seer --help:",                     "Display this help.")
+
+              , ("dph-event-seer show <file>:",                "Raw event log data.")
+
+              , ("dph-event-seer usage <file>:",        "Show amount of time spent with n HECs active, and in GC")
+              , ("dph-event-seer wake <file>:",        "Times between waking a thread on a different HEC and it starting")
+              , ("", "")
+              , ("", "Compile your program with '-eventlog' then run with '+RTS -l' to produce a .eventlog.")
+              , ("", "Then analyse the output with this program.")
+              ]
+
+readLogOrDie :: FilePath -> IO EventLog
+readLogOrDie file = do
+    e <- readEventLogFromFile file
+    case e of
+        Left s    -> die ("Failed to parse " ++ file ++ ": " ++ s)
+        Right evlog -> return evlog
+
+die :: String -> IO a
+die s = do hPutStrLn stderr s; exitWith (ExitFailure 1)