linux-perf-0.3: ghc-events-perf/ghc-events-perf-sync.hs
{-# LANGUAGE PatternGuards, BangPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Copyright : (c) 2010,2011,2012 Simon Marlow, Bernie Pope, Mikolaj Konarski
-- License : BSD-style
-- Maintainer : florbitous@gmail.com
-- Stability : experimental
-- Portability : ghc
--
-- Convert Linux perf data into a GHC eventlog, using the output from
-- @perf script@. You need to specify the name of profilee --- the profiled
-- Haskell program --- as the first argument.
-- For example if the profilee is called @Fac@, and the perf data
-- is in a file called @perf.data@, we can generate a ghc log file like so:
--
-- > ghc-events-perf-sync Fac perf.data Fac.perf.eventlog
--
-----------------------------------------------------------------------------
module Main where
import qualified GHC.RTS.Events as GHC
import Data.Map as Map hiding (mapMaybe, map, filter, null)
import Data.List as List (foldl')
import Data.Word (Word64, Word32)
import Data.Maybe (fromMaybe, mapMaybe)
import System.Exit (exitWith, ExitCode (ExitFailure))
import System.Environment (getArgs)
import System.IO (hPutStrLn, stderr, hGetContents)
import Data.Char (isDigit)
import System.Process
-- TODO: also specify different fields for software counters. This is
-- difficult due to perf script bugs.
-- | Select specific fields for perf script to display.
perfScriptCmd :: String -> String
perfScriptCmd inFile =
-- TODO: "perf script -f comm,tid,pid,time,cpu,event,trace -i " ++ inFile
"perf script -f comm,tid,pid,time,cpu,event -i " ++ inFile
-- | Process arguments and calculate the result.
main :: IO ()
main = do
args <- getArgs
case args of
["-h"] ->
putStrLn usage
[profilee, inFile, outFile] -> do
procOut <- createProcess (shell $ perfScriptCmd inFile)
{ std_out = CreatePipe }
case procOut of
(_, Just hout, _, _) -> do
-- read the stdout of perf script
contents <- hGetContents hout
-- Parse the perf events.
-- TODO: should we report that we ignore some mis-formed lines?
let perfEvents = mapMaybe parsePerfLine $ lines contents
-- grab the start time of the first event for profilee
startTime = getStartTime profilee perfEvents
-- convert the perf events into a GHC eventlog
perfEventlog = perfToEventlog startTime perfEvents
-- debug: print the start time
putStrLn $ "starting perf-time: " ++ show startTime
-- write the ghc eventlog to a file
GHC.writeEventLogToFile outFile perfEventlog
_ -> die "Internal error: shell process creation failed"
_other -> die usage
usage :: String
usage =
"Usage: ghc-events-perf-sync program-name perf-file out-eventlog-file"
-- | Exit the program with an error message.
die :: String -> IO a
die s = hPutStrLn stderr s >> exitWith (ExitFailure 1)
-- | Deduce the start time of the Haskell program from its perf events.
getStartTime :: String -> [PerfEvent] -> Maybe Word64
getStartTime _profilee [] = Nothing
getStartTime profilee (event:rest)
| profilee == perfEvent_program event = Just $ perfEvent_time event
| otherwise = getStartTime profilee rest
-- | Haskell representation of a single perf event.
data PerfEvent =
PerfEvent
{ perfEvent_program :: !String
, perfEvent_threadID :: !Word64
, _perfEvent_processID :: !Word64
, perfEvent_time :: !Word64
, _perfEvent_CPU :: !String
, perfEvent_event :: !String
, _perfEvent_trace :: !String
}
deriving (Eq, Show)
-- | Parse a line of @perf script@ output.
parsePerfLine :: String -> Maybe PerfEvent
parsePerfLine string
| comm:ids:cpu:timeStrColon:eventColon:_rest <- words string
, (pidStr, _:tidStr) <- break (== '/') ids
, (timeStr, ":") <- break (== ':') timeStrColon
, (topTime, _:botTime) <- break (== '.') timeStr
, (event, ":") <- break (== ':') eventColon = do
timeMus <- safeReadInt (topTime ++ botTime)
pid <- safeReadInt pidStr
tid <- safeReadInt tidStr
let trace = "" -- TODO: unwords rest
-- Time resolution is 1000 lower than in Haskell eventlogs
-- and in the raw, binary perf events format,
-- hence we multiply by 1000.
time = 1000 * timeMus
return $ PerfEvent comm tid pid time cpu event trace
parsePerfLine _ = Nothing
safeReadInt :: String -> Maybe Word64
safeReadInt string
| all isDigit string = Just $ read string
| otherwise = Nothing
-- | Convert Linux perf event data into a ghc eventlog.
perfToEventlog :: Maybe Word64 -> [PerfEvent] -> GHC.EventLog
perfToEventlog mstart events =
eventLog $ perfToGHC mstart events
where
eventLog :: [GHC.Event] -> GHC.EventLog
eventLog evs = GHC.EventLog (GHC.Header perfEventlogHeader)
(GHC.Data evs)
type TypeMap = Map String Word32
type EventState = (TypeMap, [GHC.Event], Word32)
-- | Convert Linux perf events into ghc events.
perfToGHC :: Maybe Word64 -- initial timestamp
-> [PerfEvent] -- perf events in sorted time order
-> [GHC.Event] -- ghc eventlog
perfToGHC mstart perfEvents =
typeEvents ++ reverse ghcEvents
where
start = fromMaybe 0 mstart
typeEvents :: [GHC.Event]
typeEvents = mkTypeEvents $ Map.toList fullTypeMap
-- we fold over the list of perf events and collect a set of
-- event types and a list of ghc events
(fullTypeMap, ghcEvents, _typeID) = List.foldl' perfToGHCWorker (Map.empty, [], 0) perfEvents
-- convert the set of perf type infos into a list of events
mkTypeEvents :: [(String, Word32)] -> [GHC.Event]
mkTypeEvents = map (\(name, ident) -> GHC.Event 0 $ GHC.PerfName ident name)
-- Extract a new type event and ghc event from the next perf event
-- and update the state.
-- Note: we need (some of) these bangs to avoid stack overflows.
-- XXX a state monad would be nicer
perfToGHCWorker :: EventState -> PerfEvent -> EventState
perfToGHCWorker state@(!typeMap, !events, !typeID) !event
-- only consider events after the profilee start time
| eventTime >= start = (newTypeMap, newEvent:events, newTypeID)
| otherwise = state
where
eventTime = perfEvent_time event
relativeTime = eventTime - start
eventName = perfEvent_event event
(newTypeMap, ghcTypeID, newTypeID) =
case Map.lookup eventName typeMap of
-- We've not seen this event name before, allocate
-- a new event ID for it and insert it into the type map.
Nothing -> let nextTypeID = typeID + 1
nextTypeMap = Map.insert eventName nextTypeID typeMap
in (nextTypeMap, nextTypeID, nextTypeID)
-- We have seen this event before, return its typeID and
-- do not update the typeMap or the type ID counter.
Just thisTypeID -> (typeMap, thisTypeID, typeID)
ghcTID = GHC.KernelThreadId $ perfEvent_threadID event
-- generate the appropriate ghc event
newEvent = GHC.Event relativeTime newEventBody
newEventBody = GHC.PerfTracepoint ghcTypeID ghcTID
-- | The header of the ghc eventlog to be created.
perfEventlogHeader :: [GHC.EventType]
perfEventlogHeader =
[ GHC.EventType GHC.nEVENT_PERF_NAME "perf event name" Nothing
, GHC.EventType GHC.nEVENT_PERF_COUNTER "perf event counter"
(Just $ GHC.sz_perf_num + GHC.sz_kernel_tid + 8)
, GHC.EventType GHC.nEVENT_PERF_TRACEPOINT "perf event tracepoint"
(Just $ GHC.sz_perf_num + GHC.sz_kernel_tid)
]