diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Simon Marlow, Bernie Pope, Mikolaj Konarski 2010, 2011, 2012 + +All rights reserved. + +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 the name of Simon Marlow nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT +OWNER OR 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/Profiling/Linux/Perf.hs b/Profiling/Linux/Perf.hs new file mode 100644 --- /dev/null +++ b/Profiling/Linux/Perf.hs @@ -0,0 +1,248 @@ +{-# LANGUAGE PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2010,2011,2012 Simon Marlow, Bernie Pope, Mikolaj Konarski +-- License : BSD-style +-- Maintainer : florbitous@gmail.com +-- Stability : experimental +-- Portability : ghc +-- +-- A higher-level interface to the perf data file parsing code. +-- +-- Below is an example program which reads and parses a perf.data file and then +-- dumps the contents to standard output: +-- +-- @ +--module Main where +-- +--import Profiling.Linux.Perf (readAndDisplay, OutputStyle (..)) +--import System.Environment (getArgs) +-- +--main :: IO () +--main = do +-- args <- getArgs +-- case args of +-- [] -> return () +-- (file:_) -> readAndDisplay Dump file +-- @ + +----------------------------------------------------------------------------- + +module Profiling.Linux.Perf + ( -- * Data types + TypeMap + , TypeInfo (..) + , OutputStyle (..) + -- * Functions + , readAndDisplay + , readPerfData + , display + , makeTypeMap + , sortEventsOnTime + ) where + +import Profiling.Linux.Perf.Parse + ( readHeader, readAttributes, readAttributeIDs, readEventTypes, readEvent ) +import Profiling.Linux.Perf.Types + ( FileHeader (..), FileAttr (..), TraceEventType (..), Event (..) + , EventPayload (..), EventHeader (..) , EventAttr (..), EventAttrFlag (..) + , testEventAttrFlag, PID (..), TID (..), EventTypeID (..), EventSource (..) + , EventID (..), TimeStamp (..), SampleTypeBitMap (..), ByteCount64 (..) + , PerfData (..) ) +import Profiling.Linux.Perf.Pretty ( pretty ) +import Text.PrettyPrint as Pretty + ( render, Doc, empty, text, (<+>), (<>), vcat, ($$), int, hsep, hcat ) +import Data.List as List (intersperse, sortBy, foldl') +import Data.Map as Map hiding (mapMaybe, map, filter, null) +import System.IO (openFile, IOMode(ReadMode), Handle) +import Data.Maybe (mapMaybe) +import Data.ByteString.Lazy.Char8 (unpack) + +-- | Associate events with their event types. +-- Events are (usually) tagged with an "EventID". Many events can share the same +-- "EventID". Each "EventID" is associated with exactly one event type, which includes +-- the name of the event, an "EventSource" and an "EventTypeID" +type TypeMap = Map EventID TypeInfo + +-- | Type information for of event. +data TypeInfo = + TypeInfo + { typeInfo_name :: String -- ^ Printable name of the event source. + , typeInfo_source :: EventSource -- ^ Kind of the event source (hardware, software, tracepoint etc.). + , typeInfo_id :: EventTypeID -- ^ Unique number of this type of event. + } + +-- | Sort a list of events in ascending time order. +-- Events without a timestamp are treated as having a timestamp of 0, +-- which places them at the start of the sorted output. +sortEventsOnTime :: [Event] -> [Event] +sortEventsOnTime = + sortBy compareEventTime + where + -- Compare two events based on their timestamp. + compareEventTime :: Event -> Event -> Ordering + compareEventTime e1 e2 = + compare (getEventTime $ ev_payload e1) (getEventTime $ ev_payload e2) + -- Get the timestamp of an event if it has one, otherwise + -- set it to 0 (for the purposes of sorting them). + getEventTime :: EventPayload -> TimeStamp + getEventTime e@(SampleEvent {}) = maybe (TimeStamp 0) id $ eventPayload_SampleTime e + getEventTime e@(ForkEvent {}) = eventPayload_time e + getEventTime e@(ExitEvent {}) = eventPayload_time e + getEventTime e@(ThrottleEvent {}) = eventPayload_time e + getEventTime e@(UnThrottleEvent {}) = eventPayload_time e + getEventTime other = TimeStamp 0 + +-- | Build a map from "EventID"s to their type information. +makeTypeMap :: PerfData -> TypeMap +makeTypeMap perfData = + List.foldl' idsToInfo Map.empty attrsIDs + where + -- Event IDs from the file header, to be associated with the event attributes + -- from the header. + idss :: [[EventID]] + idss = perfData_idss perfData + types :: [TraceEventType] + types = perfData_types perfData + attrs :: [EventAttr] + attrs = map fa_attr $ perfData_attrs perfData + -- pair attributes with their corresponding event IDs + attrsIDs :: [(EventAttr, EventID)] + attrsIDs = [(attribute, id) | (attribute, idents) <- zip attrs idss, id <- idents] + -- mapping from event type id to name + eventTypeToName :: Map EventTypeID String + eventTypeToName = Map.fromList $ map (\t -> (te_event_id t, unpack $ te_name t)) types + -- update the type map with a new entry for a given event type + idsToInfo :: TypeMap -> (EventAttr, EventID) -> TypeMap + idsToInfo acc (attr, eventID) = + case Map.lookup typeID eventTypeToName of + -- We don't have a type name for this particular event. + -- This shouldn't happen in a well formatted perf data file, + -- but we prefer to ignore it rather than generate an error. + Nothing -> acc + -- Update the event type map, mapping each event id to the name. + Just typeName -> + Map.insert eventID (TypeInfo typeName typeSource typeID) acc + where + typeSource = ea_type attr + typeID = ea_config attr + +-- | Style to use for printing the event data. +data OutputStyle + = Dump -- ^ Output full details of the data file preserving the original order of the events. + | Trace -- ^ Output command and sample events in time order with event type annotations. + +-- | Read the contents of the perf.data file and render it +-- on stdout in a specified style. +readAndDisplay :: OutputStyle -> FilePath -> IO () +readAndDisplay style file = display style =<< readPerfData file + +-- | Read and parse the perf.data file into its constituent components. +readPerfData :: FilePath -> IO PerfData +readPerfData file = do + h <- openFile file ReadMode + header <- readHeader h + attrs <- readAttributes h header + idss <- mapM (readAttributeIDs h) attrs + types <- readEventTypes h header + -- See: samplingType in perffile/session.c and the way it is set in the CERN readperf code. + -- They also assume there is just one sampleType. + let attrTypeInfo = getAttrInfo attrs + (sampleType, sampleIdAll) = + case attrTypeInfo of + [] -> (SampleTypeBitMap 0, False) + x:_ -> x + dataOffset = fh_data_offset header + maxOffset = fh_data_size header + dataOffset + events <- readEvents h maxOffset dataOffset sampleType + return $ PerfData header attrs idss types events + +-- | Render the components of the perf.data file under the specified style. +-- Don't create a single big @Doc@ or @String@ to avoid stack overflows. +-- Instead, lazily print events as they are rendered. +display :: OutputStyle -> PerfData -> IO () +display style contents = + let docs = case style of + Dump -> dumper contents + Trace -> tracer contents + in mapM_ (putStrLn . render) docs + +-- | Get the Sample Type and test the sample_id_all bit in the flags field. +getAttrInfo :: [FileAttr] -> [(SampleTypeBitMap, Bool)] +getAttrInfo = map getSampleTypeAndIdAll + where + getSampleTypeAndIdAll :: FileAttr -> (SampleTypeBitMap, Bool) + getSampleTypeAndIdAll fattr + = (ea_sample_type attr, testEventAttrFlag (ea_flags attr) SampleIdAll) + where + attr = fa_attr $ fattr + +-- | Read the events from file and return them in the order that they appear +-- (not sorted on timestamp). +readEvents :: Handle -> ByteCount64 -> ByteCount64 -> SampleTypeBitMap -> IO [Event] +readEvents h maxOffset offset sampleType = + readWorker offset [] + where + readWorker :: ByteCount64 -> [Event] -> IO [Event] + readWorker offset acc + | offset >= maxOffset = return $ reverse acc + | otherwise = do + event <- readEvent h offset sampleType + let size = eh_size $ ev_header event + nextOffset = offset + fromIntegral size + readWorker nextOffset (event:acc) + +-- | Dump the events in a sequence, showing all their internal values. +dumper :: PerfData -> [Doc] +dumper (PerfData header attrs idss types events) = + intersperse separator $ + [ text "Perf File Header:" + , pretty header + , text "Perf File Attributes:" + , vcat $ intersperse separator $ + map prettyAttrAndIds $ zip attrs idss + , text "Trace Event Types:" + , vcat $ map pretty types + , text "Events:" + ] ++ map pretty events + where + prettyAttrAndIds (attr, ids) = + pretty attr $$ (text "ids:" <+> (hsep $ map pretty ids)) + separator :: Doc + separator = text $ replicate 40 '-' + +-- | Print a time sorted sequence of comm and sample events. Sample events +-- show their human-friendly source name. +tracer :: PerfData -> [Doc] +tracer perfData@(PerfData header attrs idss types events) = + concatMap (prettyPayload typeMap . ev_payload) sortedEvents + where + -- Render a list of docs in comma separated form. + csv :: [Doc] -> [Doc] + csv docs = [hcat $ intersperse (text ", ") docs] + sortedEvents = sortEventsOnTime events + typeMap = makeTypeMap perfData + prettyPayload :: TypeMap -> EventPayload -> [Doc] + prettyPayload _typeMap ev@(CommEvent {}) = + csv [ text "PID" <+> (pretty . eventPayload_pid) ev + , text "TID" <+> (pretty . eventPayload_tid) ev + , text "command" <+> (pretty . eventPayload_CommName) ev ] + prettyPayload typeMap ev@(SampleEvent {}) = + csv [ text "PID" <+> (pretty . eventPayload_SamplePID) ev + , text "TID" <+> (pretty . eventPayload_SampleTID) ev + , sampleDoc + , text "time" <+> (pretty . eventPayload_SampleTime) ev + , text "CPU" <+> (pretty . eventPayload_SampleCPU) ev + , text "IP" <+> (pretty . eventPayload_SampleIP) ev + , text "Addr" <+> (pretty . eventPayload_SampleAddr) ev + , text "Stream" <+> (pretty . eventPayload_SampleStreamID) ev + , text "Period" <+> (pretty . eventPayload_SamplePeriod) ev ] + where + -- Try to retrieve the sample event source from the type info for this event. + sampleDoc + | Just id <- eventPayload_SampleID ev, + Just typeInfo <- Map.lookup id typeMap = + text "sample" <+> (text . typeInfo_name) typeInfo + | otherwise = text "sample " + prettyPayload _typeMap other = [] diff --git a/Profiling/Linux/Perf/Parse.hsc b/Profiling/Linux/Perf/Parse.hsc new file mode 100644 --- /dev/null +++ b/Profiling/Linux/Perf/Parse.hsc @@ -0,0 +1,564 @@ +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2010,2011,2012 Simon Marlow, Bernie Pope, Mikolaj Konarski +-- License : BSD-style +-- Maintainer : florbitous@gmail.com +-- Stability : experimental +-- Portability : ghc +-- +-- A library to parse and pretty print the contents of @perf.data@ file, +-- the output of the @perf record@ command on +-- Linux (Linux performance counter information). +-- +----------------------------------------------------------------------------- + +module Profiling.Linux.Perf.Parse + ( readHeader + , readAttributes + , readAttributeIDs + , readEventHeader + , readEvent + , readEventTypes + ) where + +import Profiling.Linux.Perf.Types as Types + ( FileSection (..), FileHeader (..), EventAttr (..), FileAttr (..), TraceEventType (..) + , EventHeader (..), EventPayload (..), SampleFormat (..), EventType (..), Event (..) + , EventAttrFlag (..), TID (..), PID (..), EventTypeID (..), testEventAttrFlag + , EventSource (..), EventID (..), TimeStamp (..), SampleTypeBitMap (..) + , ByteCount64 (..), ByteCount32 (..), ByteCount16 (..) ) +import Data.Word ( Word64, Word8, Word16, Word32 ) +import Data.Binary ( Binary (..), getWord8 ) +import Control.Monad.Error ( ErrorT (..), lift, replicateM, when, throwError ) +import System.IO ( hSeek, Handle, SeekMode (..) ) +import Data.ByteString.Lazy as B ( ByteString, hGet ) +import Data.Binary.Get + ( Get, runGet, getLazyByteString, getLazyByteStringNul, getWord16le, + getWord32le, getWord64le, remaining, getRemainingLazyByteString ) +import Data.Bits (testBit) +import Foreign.Storable (sizeOf) +import Data.Int (Int64) + +#include +#include "perf_file.h" + +-- ----------------------------------------------------------------------------- + +bytesInWord64 :: Int +bytesInWord64 = sizeOf (undefined :: Word64) + +type GetEvents a = ErrorT String Get a + +getE :: Binary a => GetEvents a +getE = lift get + +-- read a null terminated (lazy) byte string +getBSNul :: GetEvents B.ByteString +getBSNul = lift getLazyByteStringNul + +getBS :: Int64 -> GetEvents B.ByteString +getBS = lift . getLazyByteString + +-- read an unsigned 8 bit word +getU8 :: GetEvents Word8 +getU8 = lift getWord8 + +-- read an unsigned 16 bit word +getU16 :: GetEvents Word16 +getU16 = lift getWord16le + +-- read an unsigned 32 bit word +getU32 :: GetEvents Word32 +getU32 = lift getWord32le + +-- read an unsigned 64 bit word +getU64 :: GetEvents Word64 +getU64 = lift getWord64le + +-- read a process ID as a 32 bit word and return PID type +getPID :: GetEvents PID +getPID = PID `fmap` getU32 + +-- read a thread ID as a 32 bit word and return TID type +getTID :: GetEvents TID +getTID = TID `fmap` getU32 + +-- read an event ID as a 64 bit word and return EventID type +getEventID :: GetEvents EventID +getEventID = EventID `fmap` getU64 + +-- read a timeStamp as a 64 bit word and return TimeStamp type +getTimeStamp :: GetEvents TimeStamp +getTimeStamp = TimeStamp `fmap` getU64 + +-- read a byte count as a 64 bit word and return a ByteCount64 type +getByteCount64 :: GetEvents ByteCount64 +getByteCount64 = ByteCount64 `fmap` getU64 + +-- read a byte count as a 32 bit word and return a ByteCount32 type +getByteCount32 :: GetEvents ByteCount32 +getByteCount32 = ByteCount32 `fmap` getU32 + +-- read a byte count as a 16 bit word and return a ByteCount16 type +getByteCount16 :: GetEvents ByteCount16 +getByteCount16 = ByteCount16 `fmap` getU16 + +runGetEvents :: GetEvents a -> B.ByteString -> Either String a +runGetEvents = runGet . runErrorT + +runGetEventsCheck :: GetEvents a -> B.ByteString -> IO a +runGetEventsCheck g b = + case runGetEvents g b of + Left e -> fail e + Right v -> return v + +-- magic 8 bytes at the start of the perf file, "PERFFILE" +pERF_MAGIC = 0x454c494646524550 :: Word64 + +hEADER_FEAT_BITS = (#const HEADER_FEAT_BITS) :: Int + +-- ----------------------------------------------------------------------------- + +-- from /util/header.h +-- +-- struct perf_file_section { +-- u64 offset; +-- u64 size; +-- }; + +parseFileSection :: GetEvents FileSection +parseFileSection = do + sec_offset <- getByteCount64 + sec_size <- getByteCount64 + return FileSection{..} + +-- from /util/header.h +-- +-- struct perf_file_header { +-- u64 magic; +-- u64 size; +-- u64 attr_size; +-- struct perf_file_section attrs; +-- struct perf_file_section data; +-- struct perf_file_section event_types; +-- DECLARE_BITMAP(adds_features, HEADER_FEAT_BITS); +-- }; + +parseFileHeader :: GetEvents FileHeader +parseFileHeader = do + magic <- getU64 + when (magic /= pERF_MAGIC) $ + throwError "incompatible file format, or not a perf file" + fh_size <- getByteCount64 + fh_attr_size <- getByteCount64 + FileSection fh_attrs_offset fh_attrs_size <- parseFileSection + FileSection fh_data_offset fh_data_size <- parseFileSection + FileSection fh_event_offset fh_event_size <- parseFileSection + fh_adds_features <- replicateM (hEADER_FEAT_BITS `quot` 32) $ getU32 + return FileHeader{..} + +-- from /linux/perf_event.h + +-- enum perf_type_id { +-- PERF_TYPE_HARDWARE = 0, +-- PERF_TYPE_SOFTWARE = 1, +-- PERF_TYPE_TRACEPOINT = 2, +-- PERF_TYPE_HW_CACHE = 3, +-- PERF_TYPE_RAW = 4, +-- PERF_TYPE_BREAKPOINT = 5, +-- +-- PERF_TYPE_MAX, /* non-ABI */ +-- }; + +readPerfType :: Word32 -> EventSource +readPerfType x + | x < fromIntegral (fromEnum PerfTypeUnknown) = toEnum $ fromIntegral x + | otherwise = PerfTypeUnknown + +parseEventSource :: GetEvents EventSource +parseEventSource = readPerfType `fmap` getU32 + +-- from /linux/perf_event.h +-- +-- struct perf_event_attr { +-- +-- /* +-- * Major type: hardware/software/tracepoint/etc. +-- */ +-- __u32 type; +-- +-- /* +-- * Size of the attr structure, for fwd/bwd compat. +-- */ +-- __u32 size; +-- +-- /* +-- * Type specific configuration information. +-- */ +-- __u64 config; +-- +-- union { +-- __u64 sample_period; +-- __u64 sample_freq; +-- }; +-- __u64 sample_type; +-- __u64 read_format; +-- +-- __u64 disabled : 1, /* off by default */ +-- inherit : 1, /* children inherit it */ +-- pinned : 1, /* must always be on PMU */ +-- exclusive : 1, /* only group on PMU */ +-- exclude_user : 1, /* don't count user */ +-- exclude_kernel : 1, /* ditto kernel */ +-- exclude_hv : 1, /* ditto hypervisor */ +-- exclude_idle : 1, /* don't count when idle */ +-- mmap : 1, /* include mmap data */ +-- comm : 1, /* include comm data */ +-- freq : 1, /* use freq, not period */ +-- inherit_stat : 1, /* per task counts */ +-- enable_on_exec : 1, /* next exec enables */ +-- task : 1, /* trace fork/exit */ +-- watermark : 1, /* wakeup_watermark */ +-- /* +-- * precise_ip: +-- * +-- * 0 - SAMPLE_IP can have arbitrary skid +-- * 1 - SAMPLE_IP must have constant skid +-- * 2 - SAMPLE_IP requested to have 0 skid +-- * 3 - SAMPLE_IP must have 0 skid +-- * +-- * See also PERF_RECORD_MISC_EXACT_IP +-- */ +-- precise_ip : 2, /* skid constraint */ +-- mmap_data : 1, /* non-exec mmap data */ +-- sample_id_all : 1, /* sample_type all events */ +-- +-- __reserved_1 : 45; +-- +-- union { +-- __u32 wakeup_events; /* wakeup every n events */ +-- __u32 wakeup_watermark; /* bytes before wakeup */ +-- }; +-- +-- __u32 bp_type; +-- union { +-- __u64 bp_addr; +-- __u64 config1; /* extension of config */ +-- }; +-- union { +-- __u64 bp_len; +-- __u64 config2; /* extension of config1 */ +-- }; +-- }; + +parseEventAttr :: GetEvents EventAttr +parseEventAttr = do + ea_type <- parseEventSource + ea_size <- getByteCount32 + ea_config <- EventTypeID `fmap` getU64 + ea_sample_period_or_freq <- getU64 + ea_sample_type <- SampleTypeBitMap `fmap` getU64 + ea_read_format <- getU64 + ea_flags <- getU64 + ea_wakeup_events_or_watermark <- getU32 + ea_bp_type <- getU32 + ea_bp_addr_or_config1 <- getU64 + ea_bp_len_or_config2 <- getU64 + return EventAttr{..} + +parseEventAttrFlags :: Word64 -> [EventAttrFlag] +parseEventAttrFlags word = + foldr testFlag [] ([toEnum 0 ..]::[EventAttrFlag]) + where + testFlag :: EventAttrFlag -> [EventAttrFlag] -> [EventAttrFlag] + testFlag flag rest + | testBit word (fromEnum flag) = flag : rest + | otherwise = rest + +-- from /util/header.c +-- +-- struct perf_file_attr { +-- struct perf_event_attr attr; +-- struct perf_file_section ids; +-- }; + +parseFileAttr :: GetEvents FileAttr +parseFileAttr = do + fa_attr <- parseEventAttr + FileSection fa_ids_offset fa_ids_size <- parseFileSection + return FileAttr{..} + +-- from /util/event.h +-- +-- struct perf_trace_event_type { +-- u64 event_id; +-- char name[MAX_EVENT_NAME]; +-- }; + +parseTraceEventType :: GetEvents TraceEventType +parseTraceEventType = do + te_event_id <- EventTypeID `fmap` getU64 + te_name <- getBSNul + return TraceEventType{..} + +-- from /linux/perf_event.h +-- +-- struct perf_event_header { +-- __u32 type; +-- __u16 misc; +-- __u16 size; +-- }; + +parseEventHeader :: GetEvents EventHeader +parseEventHeader = do + eh_type <- (toEnum . fromIntegral) `fmap` getU32 + eh_misc <- getU16 + eh_size <- getByteCount16 + return EventHeader{..} + +-- from /util/event.h +-- +-- struct mmap_event { +-- struct perf_event_header header; +-- u32 pid, tid; +-- u64 start; +-- u64 len; +-- u64 pgoff; +-- char filename[PATH_MAX]; +-- }; + +parseMmapEvent :: GetEvents EventPayload +parseMmapEvent = do + -- note we do not parse the event header here, it is done in parseEvent + eventPayload_pid <- getPID + eventPayload_tid <- getTID + eventPayload_MmapStart <- getU64 + eventPayload_MmapLen <- getU64 + eventPayload_MmapPgoff <- getU64 + eventPayload_MmapFilename <- getBSNul + return MmapEvent{..} + +-- from /util/event.h +-- +-- struct comm_event { +-- struct perf_event_header header; +-- u32 pid, tid; +-- char comm[16]; +-- }; + +parseCommEvent :: GetEvents EventPayload +parseCommEvent = do + eventPayload_pid <- getPID + eventPayload_tid <- getTID + eventPayload_CommName <- getBSNul + return CommEvent{..} + +-- from /util/event.h +-- +-- struct fork_event { +-- struct perf_event_header header; +-- u32 pid, ppid; +-- u32 tid, ptid; +-- u64 time; +-- }; + +parseForkEvent :: GetEvents EventPayload +parseForkEvent = do + eventPayload_pid <- getPID + eventPayload_ppid <- getPID + eventPayload_tid <- getTID + eventPayload_ptid <- getTID + eventPayload_time <- getTimeStamp + return ForkEvent{..} + +-- ForkEvent and ExitEvent have the same binary structure. + +parseExitEvent :: GetEvents EventPayload +parseExitEvent = do + eventPayload_pid <- getPID + eventPayload_ppid <- getPID + eventPayload_tid <- getTID + eventPayload_ptid <- getTID + eventPayload_time <- getTimeStamp + return ExitEvent{..} + +-- from /util/event.h +-- +-- struct lost_event { +-- struct perf_event_header header; +-- u64 id; +-- u64 lost; +-- }; + +parseLostEvent :: GetEvents EventPayload +parseLostEvent = do + eventPayload_id <- getEventID + eventPayload_Lost <- getU64 + return LostEvent{..} + +-- from /linux/perf_event.h +-- Note: cannnot find corresponding entry in /util/event.h + +-- struct { +-- struct perf_event_header header; +-- u64 time; +-- u64 id; +-- u64 stream_id; +-- }; + +parseThrottleEvent :: GetEvents EventPayload +parseThrottleEvent = do + eventPayload_time <- getTimeStamp + eventPayload_id <- getEventID + eventPayload_stream_id <- getU64 + return ThrottleEvent{..} + +parseUnThrottleEvent :: GetEvents EventPayload +parseUnThrottleEvent = do + eventPayload_time <- getTimeStamp + eventPayload_id <- getEventID + eventPayload_stream_id <- getU64 + return UnThrottleEvent{..} + +-- from /util/event.h +-- +-- struct read_event { +-- struct perf_event_header header; +-- u32 pid, tid; +-- u64 value; +-- u64 time_enabled; +-- u64 time_running; +-- u64 id; +-- }; + +parseReadEvent :: GetEvents EventPayload +parseReadEvent = do + eventPayload_pid <- getPID + eventPayload_tid <- getTID + eventPayload_ReadValue <- getU64 + eventPayload_ReadTimeEnabled <- getU64 + eventPayload_ReadTimeRunning <- getU64 + eventPayload_id <- getEventID + return ReadEvent{..} + +parseSampleType :: SampleTypeBitMap -> SampleFormat -> GetEvents a -> GetEvents (Maybe a) +parseSampleType sampleType format parser + | testBit (sampleTypeBitMap sampleType) (fromEnum format) = Just `fmap` parser + | otherwise = return Nothing + +parseSampleEvent :: SampleTypeBitMap -> GetEvents EventPayload +parseSampleEvent sampleType = do + eventPayload_SampleIP <- parseSampleType sampleType PERF_SAMPLE_IP getU64 + eventPayload_SamplePID <- parseSampleType sampleType PERF_SAMPLE_TID getPID + eventPayload_SampleTID <- parseSampleType sampleType PERF_SAMPLE_TID getTID + eventPayload_SampleTime <- parseSampleType sampleType PERF_SAMPLE_TIME getTimeStamp + eventPayload_SampleAddr <- parseSampleType sampleType PERF_SAMPLE_ADDR getU64 + eventPayload_SampleID <- parseSampleType sampleType PERF_SAMPLE_ID getEventID + eventPayload_SampleStreamID <- parseSampleType sampleType PERF_SAMPLE_STREAM_ID getU64 + eventPayload_SampleCPU <- parseSampleType sampleType PERF_SAMPLE_CPU getU32 + eventPayload_SamplePeriod <- parseSampleType sampleType PERF_SAMPLE_PERIOD getU64 + return SampleEvent{..} + +-- sample_id_all +-- if this flag is set to TRUE then events other than SampleEvent +-- have additional information. See perf_event__parse_sample +-- in cern_perf/readperf/origperf.c and also perf_event__parse_id_sample. +-- We use ea_sample_type from EventAttr to determine what sampling +-- information we have. + +parseEventPayload :: SampleTypeBitMap -> EventType -> GetEvents EventPayload +parseEventPayload sampleType eventType = + case eventType of + PERF_RECORD_MMAP -> parseMmapEvent + PERF_RECORD_LOST -> parseLostEvent + PERF_RECORD_COMM -> parseCommEvent + PERF_RECORD_EXIT -> parseExitEvent + PERF_RECORD_THROTTLE -> parseThrottleEvent + PERF_RECORD_UNTHROTTLE -> parseUnThrottleEvent + PERF_RECORD_FORK -> parseForkEvent + PERF_RECORD_READ -> parseReadEvent + PERF_RECORD_SAMPLE -> parseSampleEvent sampleType + PERF_RECORD_UNKNOWN _ -> return UnknownEvent + +parseEvent :: SampleTypeBitMap -> GetEvents Event +parseEvent sampleType = do + ev_header <- parseEventHeader + let eventType = eh_type ev_header + ev_payload <- parseEventPayload sampleType eventType + return Event{..} + +-- ----------------------------------------------------------------------------- + +-- | Read an "EventHeader" from the input file handle. +readEventHeader :: Handle -- ^ Input file. + -> ByteCount64 -- ^ Byte offset from the start of the file to the start of the event header. + -> IO EventHeader +readEventHeader h offset = do + hSeek h AbsoluteSeek $ fromIntegral offset + b <- B.hGet h (#size struct perf_event_header) + runGetEventsCheck parseEventHeader b + +-- | Read an event record from the input file handle. +readEvent :: Handle -- ^ Input file. + -> ByteCount64 -- ^ Offset from the start of the file to the start of the event. + -> SampleTypeBitMap -- ^ A bitmap indicating what data is stored in a sample event. + -> IO Event +readEvent h offset sampleType = do + hSeek h AbsoluteSeek $ fromIntegral offset + let headerSize = #size struct perf_event_header + headerBytes <- B.hGet h headerSize + ev_header <- runGetEventsCheck parseEventHeader headerBytes + let payloadSize = (fromIntegral $ eh_size ev_header) - headerSize + payloadBytes <- B.hGet h payloadSize + ev_payload <- runGetEventsCheck (parseEventPayload sampleType $ eh_type ev_header) payloadBytes + return Event{..} + +-- | Read the perf data "FileHeader" from the input file handle. +readHeader :: Handle -- ^ Input file. + -> IO FileHeader +readHeader h = do + b <- B.hGet h (#size struct perf_file_header) + runGetEventsCheck parseFileHeader b + +-- | Read the perf event attributes from the input file handle. +readAttributes :: Handle -- ^ Input file. + -> FileHeader -- ^ Perf file header containing the byte offset of the attribute data. + -> IO [FileAttr] +readAttributes h fh = do + -- XXX I wonder if this calculation should be: + -- fh_attrs_size fh `quot` fh_attr_size fh ? + let nr_attrs = fh_attrs_size fh `quot` (#size struct perf_file_attr) + hSeek h AbsoluteSeek (fromIntegral (fh_attrs_offset fh)) + b <- B.hGet h (fromIntegral (fh_attrs_size fh)) + runGetEventsCheck (replicateM (fromIntegral nr_attrs) parseFileAttr) b + +-- | Read the "EventID"s from the input file handle. +readAttributeIDs :: Handle -- ^ Input file. + -> FileAttr -- ^ File attribute containing the byte offset of the event ID data. + -> IO [EventID] +readAttributeIDs h attr = do + let offset = fromIntegral $ fa_ids_offset attr + size = fromIntegral $ fa_ids_size attr + hSeek h AbsoluteSeek offset + b <- B.hGet h size + ws <- runGetEventsCheck (replicateM (size `div` bytesInWord64) getU64) b + return $ map EventID ws + +-- | Read the event type information from the input file handle. +readEventTypes :: Handle -- ^ Input file. + -> FileHeader -- ^ Perf file header containing the byte offset of the event type data. + -> IO [TraceEventType] +readEventTypes h fh = do + hSeek h AbsoluteSeek (fromIntegral (fh_event_offset fh)) + loop nr_types [] + where + loop 0 acc = return $ reverse acc + loop n acc = do + b <- B.hGet h sizeOfTypeRecord + nextRecord <- runGetEventsCheck parseTraceEventType b + loop (n-1) (nextRecord:acc) + sizeOfTypeRecord :: Int + sizeOfTypeRecord = fromIntegral (#size struct perf_trace_event_type) + nr_types = (fromIntegral $ fh_event_size fh) `quot` sizeOfTypeRecord diff --git a/Profiling/Linux/Perf/Pretty.hs b/Profiling/Linux/Perf/Pretty.hs new file mode 100644 --- /dev/null +++ b/Profiling/Linux/Perf/Pretty.hs @@ -0,0 +1,68 @@ +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2012 Simon Marlow, Bernie Pope, Mikolaj Konarski +-- License : BSD-style +-- Maintainer : florbitous@gmail.com +-- Stability : experimental +-- Portability : ghc +-- +-- Pretty printing utilities. +-- +----------------------------------------------------------------------------- + +module Profiling.Linux.Perf.Pretty + ( Pretty (..) + , prettyString + , showBits + ) where + +import Data.Word (Word64, Word32, Word16, Word8, Word) +import Data.Char (chr) +import Text.PrettyPrint (text, (<+>), ($$), render, empty, integer, (<>), hsep, Doc) +import Data.ByteString.Lazy (ByteString) +import Data.ByteString.Lazy.Char8 (unpack) +import Data.Bits (testBit, Bits, bitSize) + +-- ----------------------------------------------------------------------------- + +-- | Pretty printing interface. +class Pretty a where + -- ^ Generate a document for a value. + pretty :: a -> Doc + +-- | Render an instance of "Pretty" as a "String". +prettyString :: Pretty a => a -> String +prettyString = render . pretty + +instance Pretty a => Pretty (Maybe a) where + pretty Nothing = empty + pretty (Just x) = pretty x + +instance Pretty Word8 where + pretty = integer . fromIntegral + +instance Pretty Word16 where + pretty = integer . fromIntegral + +instance Pretty Word32 where + pretty = integer . fromIntegral + +instance Pretty Word64 where + pretty = integer . fromIntegral + +instance (Pretty a, Pretty b) => Pretty (a, b) where + pretty (x, y) = text "(" <> pretty x <> text "," <+> pretty y <> text ")" + +instance Pretty ByteString where + pretty = text . unpack + +-- | Render an instance of "Bits" as a list of "Bool", where "True" represents the high bit and "False" represents the low bit. +bits :: Bits a => a -> [Bool] +bits x = map (testBit x) [0 .. bitSize x - 1] + +-- | Render an instance of "Bits" as a "String". +showBits :: Bits a => a -> String +showBits = map toBit . bits + where + toBit True = '1' + toBit False = '0' diff --git a/Profiling/Linux/Perf/Types.hs b/Profiling/Linux/Perf/Types.hs new file mode 100644 --- /dev/null +++ b/Profiling/Linux/Perf/Types.hs @@ -0,0 +1,537 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2010,2011,2012 Simon Marlow, Bernie Pope, Mikolaj Konarski +-- License : BSD-style +-- Maintainer : florbitous@gmail.com +-- Stability : experimental +-- Portability : ghc +-- +-- Types for representing the parsed contents of a @perf.data@ file output +-- the @perf record@ command on Linux (Linux performance counter information). +-- +-- There is an intentional close correspondence between the types in this +-- module and the representation in the C implementation of perf. +-- +----------------------------------------------------------------------------- + +module Profiling.Linux.Perf.Types + ( -- * Identifiers + PID (..) + , TID (..) + , EventID (..) + , EventTypeID (..) + + -- * Byte counters + + , ByteCount64 (..) + , ByteCount32 (..) + , ByteCount16 (..) + + -- * Timestamps + + , TimeStamp (..) + + -- * File structure + + , FileSection (..) + , FileHeader (..) + , FileAttr (..) + + -- * Event data + + , Event (..) + , EventCPUMode (..) + , EventAttr (..) + , EventHeader (..) + , EventPayload (..) + + -- * Event type information + + , EventType (..) + , SampleFormat (..) + , TraceEventType (..) + , EventAttrFlag (..) + , EventSource (..) + , SampleTypeBitMap (..) + , testEventAttrFlag + + -- * An abstract representation of the perf data file + + , PerfData (..) + ) where + +import Data.Word (Word64, Word32, Word16, Word8, Word) +import Text.PrettyPrint (text, (<+>), ($$), render, empty, integer, (<>), hsep, Doc) +import Data.ByteString.Lazy (ByteString) +import Profiling.Linux.Perf.Pretty (Pretty (..), showBits) +import Data.Bits (testBit) + +-- ----------------------------------------------------------------------------- + +-- | The various parts of the perf.data file collected together. +data PerfData = + PerfData + { perfData_fileHeader :: FileHeader -- ^ File header explains the structure of the file. + , perfData_attrs :: [FileAttr] -- ^ Common attributes of events. + , perfData_idss :: [[EventID]] -- ^ Event identifiers to be associated with the event attributes. + , perfData_types :: [TraceEventType] -- ^ Event type information. + , perfData_events :: [Event] -- ^ The event payload. + } + +-- | Process ID. +newtype PID = PID { pid :: Word32 } + deriving (Eq, Ord, Show, Pretty) + +-- | Thread ID. +newtype TID = TID { tid :: Word32 } + deriving (Eq, Ord, Show, Pretty) + +-- | Event type ID (magic unique number of an event type). +newtype EventTypeID = EventTypeID { eventTypeID :: Word64 } + deriving (Eq, Ord, Show, Pretty) + +-- | Event ID. +-- Not really an identity. This number is used to link +-- an event to an event type. Multiple events can have the same EventID, +-- which means they all have the same event type. +newtype EventID = EventID { eventID :: Word64 } + deriving (Eq, Ord, Show, Pretty) + +-- | Measurement of time passed in nanoseconds since a given point. +newtype TimeStamp = TimeStamp { timeStamp :: Word64 } + deriving (Eq, Ord, Show, Pretty) + +-- | A bitmap encoding information about the content of sample events. +newtype SampleTypeBitMap = SampleTypeBitMap { sampleTypeBitMap :: Word64 } + deriving (Eq, Show, Pretty) + +-- | A 64 bit measurement in bytes. For example the size of an object, or an offset. +newtype ByteCount64 = ByteCount64 { byteCount64 :: Word64 } + deriving (Eq, Ord, Show, Pretty, Enum, Integral, Real, Num) + +-- | A 32 bit measurement in bytes. For example the size of an object, or an offset. +newtype ByteCount32 = ByteCount32 { byteCount32 :: Word32 } + deriving (Eq, Ord, Show, Pretty, Enum, Integral, Real, Num) + +-- | A 16 bit measurement in bytes. For example the size of an object, or an offset. +newtype ByteCount16 = ByteCount16 { byteCount16 :: Word16 } + deriving (Eq, Ord, Show, Pretty, Enum, Integral, Real, Num) + +-- | A Single event record. +data Event = + Event + { ev_header :: EventHeader -- ^ Information about the structure of the event. + , ev_payload :: EventPayload -- ^ The event data. + } + +instance Pretty Event where + pretty ev@(Event {}) = + text "header: " <+> (pretty $ ev_header ev) $$ + text "payload: " <+> (pretty $ ev_payload ev) + +-- XXX should probably get this from the definintion of the C type +-- | Encoding of the @perf_event_header->type@. +data EventType + = PERF_RECORD_MMAP -- 1 + | PERF_RECORD_LOST -- 2 + | PERF_RECORD_COMM -- 3 + | PERF_RECORD_EXIT -- 4 + | PERF_RECORD_THROTTLE -- 5 + | PERF_RECORD_UNTHROTTLE -- 6 + | PERF_RECORD_FORK -- 7 + | PERF_RECORD_READ -- 8 + | PERF_RECORD_SAMPLE -- 9 + | PERF_RECORD_UNKNOWN Int -- possibly a bad number? + deriving (Eq, Show) + +instance Enum EventType where + + toEnum 1 = PERF_RECORD_MMAP + toEnum 2 = PERF_RECORD_LOST + toEnum 3 = PERF_RECORD_COMM + toEnum 4 = PERF_RECORD_EXIT + toEnum 5 = PERF_RECORD_THROTTLE + toEnum 6 = PERF_RECORD_UNTHROTTLE + toEnum 7 = PERF_RECORD_FORK + toEnum 8 = PERF_RECORD_READ + toEnum 9 = PERF_RECORD_SAMPLE + toEnum other = PERF_RECORD_UNKNOWN other + + fromEnum PERF_RECORD_MMAP = 1 + fromEnum PERF_RECORD_LOST = 2 + fromEnum PERF_RECORD_COMM = 3 + fromEnum PERF_RECORD_EXIT = 4 + fromEnum PERF_RECORD_THROTTLE = 5 + fromEnum PERF_RECORD_UNTHROTTLE = 6 + fromEnum PERF_RECORD_FORK = 7 + fromEnum PERF_RECORD_READ = 8 + fromEnum PERF_RECORD_SAMPLE = 9 + fromEnum (PERF_RECORD_UNKNOWN other) = other + +instance Pretty EventType where + pretty = text . show + +-- | Information about what is stored in a sample event. +data SampleFormat + = PERF_SAMPLE_IP -- ^ 1U << 0 + | PERF_SAMPLE_TID -- ^ 1U << 1 + | PERF_SAMPLE_TIME -- ^ 1U << 2 + | PERF_SAMPLE_ADDR -- ^ 1U << 3 + | PERF_SAMPLE_READ -- ^ 1U << 4 + | PERF_SAMPLE_CALLCHAIN -- ^ 1U << 5 + | PERF_SAMPLE_ID -- ^ 1U << 6 + | PERF_SAMPLE_CPU -- ^ 1U << 7 + | PERF_SAMPLE_PERIOD -- ^ 1U << 8 + | PERF_SAMPLE_STREAM_ID -- ^ 1U << 9 + | PERF_SAMPLE_RAW -- ^ 1U << 10 + deriving (Eq, Enum, Show) + +instance Pretty SampleFormat where + pretty = text . show + +-- | A bitfield in @perf_event_header->misc@. +data EventCPUMode + = PERF_RECORD_CPUMODE_UNKNOWN -- ^ 0 + | PERF_RECORD_MISC_KERNEL -- ^ 1 + | PERF_RECORD_MISC_USER -- ^ 2 + | PERF_RECORD_MISC_HYPERVISOR -- ^ 3 + deriving (Eq, Show) + +instance Pretty EventCPUMode where + pretty = text . show + +-- | Corresponds with the @perf_file_section@ struct in @\\/util\/header.h@ +data FileSection + = FileSection { + sec_offset :: ByteCount64, -- ^ File offset to the section. + sec_size :: ByteCount64 -- ^ Size of the section in bytes. + } + +instance Pretty FileSection where + pretty fs = text "offset:" <+> pretty (sec_offset fs) $$ + text "size:" <+> pretty (sec_size fs) + +-- | Corresponds with the @perf_file_header@ struct in @\\/util\/header.h@ +data FileHeader + = FileHeader { + fh_size :: ByteCount64, -- ^ Size of (this) header. + fh_attr_size :: ByteCount64, -- ^ Size of one attribute section. + fh_attrs_offset :: ByteCount64, -- ^ File offset to the attribute section. + fh_attrs_size :: ByteCount64, -- ^ Size of the attribute section in bytes. + fh_data_offset :: ByteCount64, -- ^ File offset to the data section. + fh_data_size :: ByteCount64, -- ^ Size of the data section in bytes. + fh_event_offset :: ByteCount64, -- ^ File offset to the event section. + fh_event_size :: ByteCount64, -- ^ Size of the event section in bytes. + fh_adds_features :: [Word32] -- ^ Bitfield. + } + +instance Pretty FileHeader where + pretty fh = + text "size:" <+> pretty (fh_size fh) $$ + text "attribute size:" <+> pretty (fh_attr_size fh) $$ + text "attributes offset:" <+> pretty (fh_attrs_offset fh) $$ + text "attributes size:" <+> pretty (fh_attrs_size fh) $$ + text "data offset:" <+> pretty (fh_data_offset fh) $$ + text "data size:" <+> pretty (fh_data_size fh) $$ + text "event offset:" <+> pretty (fh_event_offset fh) $$ + text "event size:" <+> pretty (fh_event_size fh) $$ + text "features:" <+> hsep (Prelude.map pretty $ fh_adds_features fh) + +-- | See struct @perf_event_attr@ in @linux\/perf_event.h@ +data EventAttrFlag + = Disabled -- ^ off by default + | Inherit -- ^ children inherit it + | Pinned -- ^ must always be on PMU + | Exclusive -- ^ only group on PMU + | ExcludeUser -- ^ don't count user + | ExcludeKernel -- ^ ditto kernel + | ExcludeHV -- ^ ditto hypervisor + | ExcludeIdle -- ^ don't count when idle + | Mmap -- ^ include mmap data + | Comm -- ^ include comm data + | Freq -- ^ use freq, not period + | InheritStat -- ^ per task counts + | EnableOnExec -- ^ next exec enables + | Task -- ^ trace fork/exit + | WaterMark -- ^ wakeup_watermark + + + | ArbitrarySkid -- ^ precise_ip, See also @PERF_RECORD_MISC_EXACT_IP@ + | ConstantSkid -- ^ precise_ip, See also @PERF_RECORD_MISC_EXACT_IP@ + | RequestedZeroSkid -- ^ precise_ip, See also @PERF_RECORD_MISC_EXACT_IP@ + | CompulsoryZeroSkid -- ^ precise_ip, See also @PERF_RECORD_MISC_EXACT_IP@ + + | MmapData -- ^ non-exec mmap data + | SampleIdAll -- ^ sample_type all events + deriving (Eq, Ord, Enum, Show) + +instance Pretty EventAttrFlag where + pretty Disabled = text "disabled" + pretty Inherit = text "inherit" + pretty Pinned = text "pinned" + pretty Exclusive = text "exclusive" + pretty ExcludeUser = text "exclude-user" + pretty ExcludeKernel = text "exclude-kernel" + pretty ExcludeHV = text "exclude-hypervisor" + pretty ExcludeIdle = text "exclude-idle" + pretty Mmap = text "mmap" + pretty Comm = text "comm" + pretty Freq = text "freq" + pretty InheritStat = text "inherit-stat" + pretty EnableOnExec = text "enable-on-exec" + pretty Task = text "task" + pretty WaterMark = text "watermark" + pretty ArbitrarySkid = text "arbitrary-skid" + pretty ConstantSkid = text "constant-skid" + pretty RequestedZeroSkid = text "requested-zero-skid" + pretty CompulsoryZeroSkid = text "compulsory-zero-skid" + pretty MmapData = text "mmap-data" + pretty SampleIdAll = text "sample-id-all" + +-- | Test if a given EventAttrFlag is set. + +-- Tedious definition because of the way the skid flags are +-- implemented as a 2 bit word instead of individual single bits. +testEventAttrFlag :: Word64 -> EventAttrFlag -> Bool +testEventAttrFlag word flag = + case flag of + Disabled -> testBit word 0 + Inherit -> testBit word 1 + Pinned -> testBit word 2 + Exclusive -> testBit word 3 + ExcludeUser -> testBit word 4 + ExcludeKernel -> testBit word 5 + ExcludeHV -> testBit word 6 + ExcludeIdle -> testBit word 7 + Mmap -> testBit word 8 + Comm -> testBit word 9 + Freq -> testBit word 10 + InheritStat -> testBit word 11 + EnableOnExec -> testBit word 12 + Task -> testBit word 13 + WaterMark -> testBit word 14 + ArbitrarySkid -> not (testBit word 15) && not (testBit word 16) + ConstantSkid -> not (testBit word 15) && (testBit word 16) + RequestedZeroSkid -> (testBit word 15) && not (testBit word 16) + CompulsoryZeroSkid -> (testBit word 15) && (testBit word 16) + MmapData -> testBit word 17 + SampleIdAll -> testBit word 18 + +-- | Pretty print an event attribute bit field as a list of set flags. +prettyFlags :: Word64 -> Doc +prettyFlags word = foldr testFlag empty [toEnum 0 ..] + where + testFlag :: EventAttrFlag -> Doc -> Doc + testFlag flag rest + | testEventAttrFlag word flag = pretty flag <+> rest + | otherwise = rest + +-- | Corresponds with the enum @perf_type_id@ in @include\/linux\/perf_event.h@ + +-- XXX should really derive this directly from the header file +data EventSource + = PerfTypeHardware -- ^ 0 + | PerfTypeSoftware -- ^ 1 + | PerfTypeTracePoint -- ^ 2 + | PerfTypeHwCache -- ^ 3 + | PerfTypeRaw -- ^ 4 + | PerfTypeBreakpoint -- ^ 5 + | PerfTypeUnknown + deriving (Eq, Ord, Show, Enum) + +instance Pretty EventSource where + pretty = text . show + +-- | Corresponds with the @perf_event_attr@ struct in @include\/linux\/perf_event.h@ +data EventAttr + = EventAttr { + ea_type :: EventSource, -- ^ Major type: hardware/software/tracepoint/etc. + -- defined as enum perf_type_id in include/linux/perf_event.h + ea_size :: ByteCount32, -- ^ Size of the attr structure, for fwd/bwd compat. + ea_config :: EventTypeID, -- ^ Link to .event id of perf trace event type. + + + ea_sample_period_or_freq :: Word64, -- ^ Number of events when a sample is generated if .freq + -- is not set or frequency for sampling if .freq is set. + ea_sample_type :: SampleTypeBitMap, -- ^ Information about what is stored in the sampling record. + ea_read_format :: Word64, -- + ea_flags :: Word64, -- + ea_wakeup_events_or_watermark :: Word32, -- ^ Wakeup every n events or bytes before wakeup. + ea_bp_type :: Word32, -- + ea_bp_addr_or_config1 :: Word64, -- + ea_bp_len_or_config2 :: Word64 -- + } + +instance Pretty EventAttr where + pretty ea = + text "type:" <+> pretty (ea_type ea) $$ + text "size:" <+> pretty (ea_size ea) $$ + text "config:" <+> pretty (ea_config ea) $$ + text "sample period or frequency:" <+> pretty (ea_sample_period_or_freq ea) $$ + text "sample type:" <+> pretty (ea_sample_type ea) $$ + text "read format:" <+> pretty (ea_read_format ea) $$ + text "flags:" <+> prettyFlags (ea_flags ea) $$ + text "wakeup events or watermark:" <+> pretty (ea_wakeup_events_or_watermark ea) $$ + text "bp type:" <+> pretty (ea_bp_type ea) $$ + text "bp address or config1:" <+> pretty (ea_bp_addr_or_config1 ea) $$ + text "bp length or config2:" <+> pretty (ea_bp_len_or_config2 ea) + + +-- | Layout of event attribute and attribute ids. +data FileAttr = FileAttr { + fa_attr :: EventAttr, -- ^ The attribute payload. + fa_ids_offset :: ByteCount64, -- ^ File offset to the ids section. + fa_ids_size :: ByteCount64 -- ^ Size of the ids section in bytes. +} + +instance Pretty FileAttr where + pretty fa = + text "event attribute:" <+> pretty (fa_attr fa) $$ + text "ids offset:" <+> pretty (fa_ids_offset fa) $$ + text "ids size:" <+> pretty (fa_ids_size fa) + +-- | Identity and printable name of an event type. +data TraceEventType = TraceEventType { + te_event_id :: EventTypeID, -- ^ This entry belongs to the perf event attr entry where .config + -- has the same value as this id. + te_name :: ByteString +} + +instance Pretty TraceEventType where + pretty te = + text "event id:" <+> pretty (te_event_id te) $$ + text "name:" <+> pretty (te_name te) + +-- | Corresponds with the @perf_event_header@ struct in @\\/util\/perf_event.h@ +data EventHeader = EventHeader { + eh_type :: EventType, + eh_misc :: Word16, + eh_size :: ByteCount16 +} + +instance Pretty EventHeader where + pretty eh = + text "type:" <+> pretty (eh_type eh) $$ + text "misc:" <+> pretty (eh_misc eh) $$ + text "size:" <+> pretty (eh_size eh) + +data EventPayload = + -- Corresponds with the @comm_event@ struct in @\\/util\/event.h@ (without the header). + CommEvent { + eventPayload_pid :: PID, -- ^ process id + eventPayload_tid :: TID, -- ^ thread id + eventPayload_CommName :: ByteString -- ^ name of the application + } + -- Corresponds with the @mmap_event@ struct in @\\/util\/event.h@ (without the header). + | MmapEvent { + eventPayload_pid :: PID, + eventPayload_tid :: TID, + eventPayload_MmapStart :: Word64, -- ^ start of memory range + eventPayload_MmapLen :: Word64, -- ^ size of memory range + eventPayload_MmapPgoff :: Word64, -- ^ page offset + eventPayload_MmapFilename :: ByteString -- ^ binary file using this range + } + -- ForkEvent corresponds with the @fork_event@ struct in @\\/util\/event.h@ (without the header) + | ForkEvent { + eventPayload_pid :: PID, + eventPayload_ppid :: PID, -- ^ parent proecess id + eventPayload_tid :: TID, + eventPayload_ptid :: TID, -- ^ parent thread id + eventPayload_time :: TimeStamp -- ^ timestamp + } + -- Corresponds with the @exit_event@ struct in @\\/util\/event.h@ (without the header) + | ExitEvent { + eventPayload_pid :: PID, + eventPayload_ppid :: PID, + eventPayload_tid :: TID, + eventPayload_ptid :: TID, + eventPayload_time :: TimeStamp + } + -- Corresponds with the @lost_event@ struct in @\\/util\/event.h@ (without the header) + | LostEvent { + eventPayload_id :: EventID, + eventPayload_Lost :: Word64 + } + -- Corresponds with the @read_event@ struct in @\\/util\/event.h@ (without the header) + | ReadEvent { + eventPayload_pid :: PID, + eventPayload_tid :: TID, + eventPayload_ReadValue :: Word64, + eventPayload_ReadTimeEnabled :: Word64, + eventPayload_ReadTimeRunning :: Word64, + eventPayload_id :: EventID + } + | SampleEvent { + eventPayload_SampleIP :: Maybe Word64, -- ^ Instruction pointer. + eventPayload_SamplePID :: Maybe PID, -- ^ Process ID. + eventPayload_SampleTID :: Maybe TID, -- ^ Thread ID. + eventPayload_SampleTime :: Maybe TimeStamp, -- ^ Timestamp. + eventPayload_SampleAddr :: Maybe Word64, -- + eventPayload_SampleID :: Maybe EventID, -- ^ Event ID. + eventPayload_SampleStreamID :: Maybe Word64, -- + eventPayload_SampleCPU :: Maybe Word32, -- ^ CPU ID. + eventPayload_SamplePeriod :: Maybe Word64 -- ^ Duration of sample. + } + -- ThrottleEvent and UnThrottleEvent are mentioned in + -- @\\/linux\/perf_event.h@ + -- but does not appear in @\\/util\/event.h@ + | ThrottleEvent { + eventPayload_time :: TimeStamp, + eventPayload_id :: EventID, + eventPayload_stream_id :: Word64 + } + | UnThrottleEvent { + eventPayload_time :: TimeStamp, + eventPayload_id :: EventID, + eventPayload_stream_id :: Word64 + } + | UnknownEvent -- ^ An unrecognised event was encountered. + deriving (Show) + +instance Pretty EventPayload where + pretty ce@(CommEvent{}) = + text "pid:" <+> pretty (eventPayload_pid ce) $$ + text "tid:" <+> pretty (eventPayload_tid ce) $$ + text "comm:" <+> pretty (eventPayload_CommName ce) + pretty me@(MmapEvent{}) = + text "pid:" <+> pretty (eventPayload_pid me) $$ + text "tid:" <+> pretty (eventPayload_tid me) $$ + text "start:" <+> pretty (eventPayload_MmapStart me) $$ + text "len:" <+> pretty (eventPayload_MmapLen me) $$ + text "pgoff:" <+> pretty (eventPayload_MmapPgoff me) $$ + text "filename:" <+> pretty (eventPayload_MmapFilename me) + pretty fe@(ForkEvent{}) = + text "pid:" <+> pretty (eventPayload_pid fe) $$ + text "ppid:" <+> pretty (eventPayload_ppid fe) $$ + text "tid:" <+> pretty (eventPayload_tid fe) $$ + text "ptid:" <+> pretty (eventPayload_ptid fe) $$ + text "time:" <+> pretty (eventPayload_time fe) + pretty ee@(ExitEvent{}) = + text "pid:" <+> pretty (eventPayload_pid ee) $$ + text "ppid:" <+> pretty (eventPayload_ppid ee) $$ + text "tid:" <+> pretty (eventPayload_tid ee) $$ + text "ptid:" <+> pretty (eventPayload_ptid ee) $$ + text "time:" <+> pretty (eventPayload_time ee) + pretty le@(LostEvent {}) = + text "id:" <+> pretty (eventPayload_id le) $$ + text "lost:" <+> pretty (eventPayload_Lost le) + pretty se@(SampleEvent {}) = + text "ip:" <+> pretty (eventPayload_SampleIP se) $$ + text "pid:" <+> pretty (eventPayload_SamplePID se) $$ + text "tid:" <+> pretty (eventPayload_SampleTID se) $$ + text "time:" <+> pretty (eventPayload_SampleTime se) $$ + text "addr:" <+> pretty (eventPayload_SampleAddr se) $$ + text "id:" <+> pretty (eventPayload_SampleID se) $$ + text "streamid:" <+> pretty (eventPayload_SampleStreamID se) $$ + text "cpu:" <+> pretty (eventPayload_SampleCPU se) $$ + text "period:" <+> pretty (eventPayload_SamplePeriod se) + pretty te@(ThrottleEvent {}) = + text "time:" <+> pretty (eventPayload_time te) $$ + text "id:" <+> pretty (eventPayload_id te) $$ + text "stream_id:" <+> pretty (eventPayload_stream_id te) + pretty ue@(UnThrottleEvent {}) = + text "time:" <+> pretty (eventPayload_time ue) $$ + text "id:" <+> pretty (eventPayload_id ue) $$ + text "stream_id:" <+> pretty (eventPayload_stream_id ue) + pretty UnknownEvent = text "Unknown" diff --git a/Profiling/Linux/Perf/perf_file.h b/Profiling/Linux/Perf/perf_file.h new file mode 100644 --- /dev/null +++ b/Profiling/Linux/Perf/perf_file.h @@ -0,0 +1,39 @@ +#include "HsFFI.h" +#include + +typedef HsWord64 u64; + +#define HEADER_FEAT_BITS 256 + +#define BITS_PER_BYTE 8 +#define DIV_ROUND_UP(n,d) (((n) + (d) - 1) / (d)) +#define BITS_TO_LONGS(nr) DIV_ROUND_UP(nr, BITS_PER_BYTE * sizeof(long)) +#define DECLARE_BITMAP(name,bits) \ + unsigned long name[BITS_TO_LONGS(bits)] + +struct perf_file_section { + u64 offset; + u64 size; +}; + +struct perf_file_header { + u64 magic; + u64 size; + u64 attr_size; + struct perf_file_section attrs; + struct perf_file_section data; + struct perf_file_section event_types; + DECLARE_BITMAP(adds_features, HEADER_FEAT_BITS); +}; + +struct perf_file_attr { + struct perf_event_attr attr; + struct perf_file_section ids; +}; + +#define MAX_EVENT_NAME 64 + +struct perf_trace_event_type { + u64 event_id; + char name[MAX_EVENT_NAME]; +}; diff --git a/README.ghc-events-perf.md b/README.ghc-events-perf.md new file mode 100644 --- /dev/null +++ b/README.ghc-events-perf.md @@ -0,0 +1,51 @@ +Crash-course of the ghc-events-perf tool: + + ghc --make -eventlog -rtsopts -threaded MyProgram.hs + + ghc-events-perf record MyProgram --RTS +RTS -N2 -l-g-p + + ghc-events-perf convert MyProgram + + threadscope MyProgram.total.eventlog + + +A longer example, pointing out some common pitfalls and using the test +data files from the test/ directory of the library's github repository. +The Haskell program test/ParFib.hs is compiled with GHC >= 7.8 as follows + + ghc --make -eventlog -rtsopts -threaded ParFib.hs + +Test data files corresponding to test/ParFib.perf.data and test/ParFib.eventlog +can be created with + + sudo path-to/ghc-events-perf record +GhcEventsPerf -o ParFib.perf.data -GhcEventsPerf ./ParFib --RTS +RTS -N2 -la + +At this point, one can change the owner or permissions of ParFib.perf.data +and parse and view it with the standard 'perf script' command or with +the 'dump-perf' tool that uses our Haskell library for parsing perf data. + +The perf data can be transformed to an eventlog and synchronized +and merged with the standard eventlog using + + ghc-events-perf convert ParFib ParFib.total.eventlog ParFib.perf.data ParFib.eventlog + +The resulting big eventlog can be displayed with + + ghc-events show ParFib.total.eventlog | less + +but it's best viewed in ThreadScope with + + threadscope ParFib.total.eventlog + +in the Timeline main pane, with Instant Events selected in the Traces tab +and with the View/Event_Labels option on. If no perf events show up +in the Instant Events traces, your GHC is probably 7.6 or older. + +Note: in this version of haskell-linux-perf one can obtain the perf data +just as well by running 'perf record' or 'perf script record' by hand +instead of by running 'ghc-events-perf record'. In other versions +(to be found on the sync-by-syscall and control-execution branches) +'ghc-events-perf record' is mandatory, since it inserts special +synchronizing events. See the findings recorded in from_linux-perf-users.md +for some background related to our current design decisions +and shedding light on possible future directions. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,43 @@ +linux-perf +========== + +linux-perf is a library for parsing, representing in Haskell +and pretty-printing the data file output of the Linux 'perf' +command (Linux performance counters). + +License and Copyright +--------------------- + +linux-perf is distributed as open source software under the terms of the BSD +License (see the file LICENSE in the top directory). + +Authors: Simon Marlow, Bernie Pope, Mikolaj Konarski, Duncan Coutts, copyright 2010, 2011, 2012. + +Contact information +------------------- + +Email Bernie Pope: + + florbitous_at_gmail_dot_com + +Building and installing +----------------------- + +linux-perf uses the cabal infrastructure for configuring, building +and installation. It needs access to the header files from the Linux +kernel source distribution (one that is sufficiently recent to support +the performance counters tool). + +To build and install: + + cabal install --extra-include-dirs=/path/to/linux/headers/ + +To clean: + + cabal clean + +To test: + + dump-perf test/ParFib.perf.data | less + +For longer examples see README.ghc-events-perf.md. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/dump-perf/dump-perf.hs b/dump-perf/dump-perf.hs new file mode 100644 --- /dev/null +++ b/dump-perf/dump-perf.hs @@ -0,0 +1,44 @@ +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2010,2011,2012 Simon Marlow, Bernie Pope +-- License : BSD-style +-- Maintainer : florbitous@gmail.com +-- Stability : experimental +-- Portability : ghc +-- +-- A program to parse and then pretty print the contents of @perf.data@ to +-- stdout. @perf.data@ is the output of the @perf record@ command on +-- Linux (Linux performance counter information). +-- +-- The main use of this program is to demonstrate how to use the +-- 'Profilinf.Linux.Perf' library. +-- +-- Usage: dump-perf [--dump] [file] +-- +-- If filename is missing then it will assume the input is @perf.data@ +-- in the current working directory. +-- +----------------------------------------------------------------------------- + +module Main where + +import Profiling.Linux.Perf (OutputStyle (..), readAndDisplay) +import System.Exit (exitWith, ExitCode (ExitFailure)) +import System.IO (hPutStrLn, stderr) +import System.Environment (getArgs) + +die :: String -> IO a +die s = hPutStrLn stderr s >> exitWith (ExitFailure 1) + +main :: IO () +main = do + args <- getArgs + (outputStyle, file) <- case args of + [] -> return (Dump, "perf.data") + ["--dump"] -> return (Dump, "perf.data") + ["--trace"] -> return (Trace, "perf.data") + [file] -> return (Dump, file) + ["--dump", file] -> return (Dump, file) + ["--trace", file] -> return (Trace, file) + _ -> die "Syntax: dump-perf [--dump] [file]" + readAndDisplay outputStyle file diff --git a/from_linux-perf-users.md b/from_linux-perf-users.md new file mode 100644 --- /dev/null +++ b/from_linux-perf-users.md @@ -0,0 +1,72 @@ +We greatly benefited from the help of the perf mailing list +. Here is a condensed summary. + +> > I'm writing a tool to parse the perf.data output of perf and was wondering about the source of the +> timestamps found in perf_sample events? Specifically I mean the u64 time field in the perf_sample struct +> in util/event.h. I believe it is in nanoseconds from a particular event (system start?), but I can't find +> any documentation about where the time comes from. +> > +> > I'm also interested in reading from this time source from a userspace program, is that possible? + +> Code wise, you'll need to follow perf_clock(). I believe for x86 with a +> stable TSC you end up in native_sched_clock() in arch/x86/kernel/tsc.c. + +> As for the corresponding userspace call I believe it is +> clock_gettime(CLOCK_MONOTONIC, ...). + +But later it does not prove to be the case: + +> > Now our main problem is relating the perf timestamps +> > to a public clock API (like posix_gettime, etc.) in order +> > to chronologically merge the perf log with our external event logs. +> > We've so far determined experimentally that even the +> > clock_gettime(CLOCK_MONOTONIC, ...) values are not identical +> > to the perf timestamps at the same places, though they are quite close. + +> > We're working around right now by syncing with a timestamp +> > of a known event, but that leaves us vulnerable to a time drift. +> > If there's no way currently to generate externally meaningful +> > timestamps, could we file a feature request for the sake of the future? + +> You mean like this: https://lkml.org/lkml/2011/6/7/638? + +> I'm still waiting for certain changes to core perf before I try again to get it committed. I haven't forgotten; it's just not ready yet. + +> And using the time-of-day patch against a newer kernel (tried 3.2, 3.4 and 3.6) I do see the offset you mentioned. + +Another issue: + +> > Are we missing anything? Is the "--timestamp" option of perf-record +> > related in any way? Any other tips? + +> That option adds the timestamps to the samples if it were not otherwise added. + +Yet another: + +> > Could someone clarify the behaviour of the -p PID flag of perf-record? +> > In our experiments (3.2.0-27 #43-Ubuntu SMP x86_64), +> > it ignores events on threads spawned after perf-record is started. +> > Is this the intended behaviour, and is there any work-around? + +> > Generally, what is the best (vs CPU/IO, distortion of profiling results) +> > way to record only events of a given OS process, with all its threads? + +> > The version of perf-record that we use already contains the separate +> > -p PID and -t TID options, so the initial PID patch is already in. +> > It's just that the -p PID option ignores all threads spawned +> > after the process is started, AFAICT. + +> AFAIK perf events aren't inherited when -p, -t or -u option is used due +> to a performance reason. But if you start the process on the command +> line with perf record, it'll be inherited and counted properly. + +> I guess your problem might be solved by using a cgroup: + +> mkdir ${cgroup_root}/mygroup +> echo NNNN > ${cgroup_root}/mygroup/tasks +> perf record -a -e cycles -G mygroup + +Another answer: + +> I see the problem now. The perf tool gets FORK events as threads are created, +> but it does not respond to them and create new counters. Some refactoring is needed to make that happen. diff --git a/ghc-events-perf/ghc-events-perf-record.hs b/ghc-events-perf/ghc-events-perf-record.hs new file mode 100644 --- /dev/null +++ b/ghc-events-perf/ghc-events-perf-record.hs @@ -0,0 +1,846 @@ +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2012 Bernie Pope, Mikolaj Konarski +-- License : BSD-style +-- Maintainer : florbitous@gmail.com +-- Stability : experimental +-- Portability : ghc +-- +-- A tool to @perf record@ a trace of another program. +-- +-- The Linux performance counter tool @perf@ can record events for a given +-- Haskell program (profilee). This tool runs @perf@, adding our default set +-- of options. In particular, it specifies our default set +-- of events to be recorded. +-- +-- Usage: +-- +-- > ghc-events-perf-record [--RTS] +-- > [ +GhcEventsPerf [record-args ... ] -GhcEventsPerf ] +-- > program-name [program-args ... ] +-- +-- Getting help: +-- +-- > ghc-events-perf-record +GhcEventsPerf -h +-- +-- The --RTS is to stop ghc from grabbing any +RTS ... -RTS commands from +-- the command line. +-- +----------------------------------------------------------------------------- + +module Main where + +import System.Posix.Process +import System.Environment +import System.Exit +import System.Console.GetOpt +import Data.Char (isDigit) +import System.Directory + (findExecutable, getPermissions, executable, doesFileExist) +import System.FilePath (splitFileName) + +-- | Process arguments and run the main machinery. +main :: IO () +main = getArgs >>= command + +command :: [String] -> IO () +command argv = do + let (recPerfArgv, profileeArgv) = grabGhcEventsPerfArgv argv + recPerfOptions <- parseGhcEventsPerfOptions recPerfArgv + profile recPerfOptions profileeArgv + +-- | Profile the given program with the given options. +profile :: Options -> [String] -> IO () +profile _options [] = ioError $ userError ("You did not supply a name of a program to profile") +profile options (profileeCommand:profileeArgs) = do + profileePath <- checkProfilee profileeCommand + -- run perf record with the profilee command + perfProcess options profileePath profileeArgs + +-- | Check if the profilee program exists and is executable. +checkProfilee :: FilePath -> IO FilePath +checkProfilee profileeCommand = do + let (profileeDir, _profileeFile) = splitFileName profileeCommand + profileePath <- + if null profileeDir + -- profilee program name was not prefixed with a directory path + then do + -- try to look up the program name in the PATH environment + maybeProfileePath <- findExecutable profileeCommand + case maybeProfileePath of + Nothing -> ioError $ userError ("Command: " ++ profileeCommand ++ " not found") + Just profileePath -> return profileePath + else + return profileeCommand + exists <- doesFileExist profileePath + if exists + then do + -- check if we can execute the profilee program + perms <- getPermissions profileePath + if executable perms + then return profileePath + else ioError $ userError ("You do not have permission to execute program: " ++ profileePath) + else ioError $ userError ("File: " ++ profileePath ++ " does not exist") + +-- | Options for @ghc-events-perf-record@, some of which are passed on +-- to @perf record@. +data Options = Options + { options_events :: [String] + , options_mmap :: String + , options_output :: FilePath + , options_help :: Bool + } deriving Show + +defaultOptions :: Options +defaultOptions = Options + { options_events = [] + , options_mmap = "" + , options_output = defaultPerfOutputFile + , options_help = False + } + +defaultPerfOutputFile :: FilePath +defaultPerfOutputFile = "perf.data" + +-- | Parse the command line arguments that appeared between +-- +GhcEventsPerf and -GhcEventsPerf. +parseGhcEventsPerfOptions :: [String] -> IO Options +parseGhcEventsPerfOptions argv = + case getOpt Permute recOptions argv of + (foundOptions, _unknowns, _errors@[]) -> do + let options = foldl (flip id) defaultOptions foundOptions + if options_help options + then putStrLn usage >> exitSuccess + else return options + (_flags, _unknowns , errs@(_:_)) -> + ioError $ userError (concat errs ++ usage) + +usage :: String +usage = usageInfo header recOptions + +header :: String +header = "Usage: ghc-events-perf-record [--RTS] [ +GhcEventsPerf [record-args ... ] -GhcEventsPerf ] program-name [program-args ... ]" + +recOptions :: [OptDescr (Options -> Options)] +recOptions = + [ Option + "e" ["event"] + (ReqArg (\e opts -> opts { options_events = e : options_events opts }) "E") + "Event to trace, instead of default events. Can be specified multiple times." + + , Option + "h" ["help"] + (NoArg $ \opts -> opts { options_help = True }) + ("Display a help message for this program.") + + , Option + "o" ["output"] + (ReqArg (\f opts -> opts { options_output = f }) "OUT") + ("Output file to store perf record data. " ++ + "Defaults to " ++ show defaultPerfOutputFile ++ ".") + , Option + "m" ["mmap-pages"] + (ReqArg (\mm opts -> opts {options_mmap = mm }) "MM") + ("Number of mmap data pages. " ++ + "Defaults to " ++ defaultMmap ++ ".") + ] + +-- | Check that a string can be safely intepreted as an integer, +-- otherwise fail with an error message. +safeReadInt :: String -> String -> Int +safeReadInt option cs + | length cs > 0 && all isDigit cs = read cs + | otherwise = + error ("The argument for option " ++ option ++ + " should be an integer, but it was " ++ cs) + +-- | Cut out all the arguments between +GhcEventsPerf -GhcEventsPerf from the command +-- line. Return two lists: 1) everything between the markers, +-- and 2) everything else. +grabGhcEventsPerfArgv :: [String] -> ([String], [String]) +grabGhcEventsPerfArgv cmdline = + (reverse cmdIns, reverse cmdOuts) + where + (cmdIns, cmdOuts) = outside cmdline ([], []) + outside, inside :: [String] -> ([String], [String]) -> ([String], [String]) + outside [] acc = acc + outside ("+GhcEventsPerf":rest) acc = inside rest acc + outside (str:rest) (ins, outs) = outside rest (ins, str:outs) + inside [] acc = acc + inside ("-GhcEventsPerf":rest) acc = outside rest acc + inside (str:rest) (ins, outs) = inside rest (str:ins, outs) + +-- | Run @perf record@ with our options and the profilee program. +perfProcess :: Options -> FilePath -> [String] -> IO () +perfProcess options profileeProgram profileeArgs = do + executeFile "perf" True (perfCommand ++ args) Nothing + where + perfCommand = ["record"] + args = + concat [output, frequency, moreTimestamps, mmap, selectedEvents, profilee] + output = ["-o", options_output options] + -- Value 1 means hIgh frequency, needed for tracepoints, + -- but too much traffic for counters/ + frequency = ["-c", "1"] + -- From linux-perf-users@vger.kernel.org: + -- The "--timestamp" option adds the timestamps to the samples + -- if it were not otherwise added. + moreTimestamps = ["--timestamp"] + profilee = profileeProgram : profileeArgs + -- If no events were specified on the command line then use the defaults. + selectedEvents + | null optionEvents = mkEventFlags defaultEvents + | otherwise = mkEventFlags optionEvents + where + optionEvents = options_events options + -- If no mmap pages were specified on the command line, use the defaults. + selectedMmap + | null optionMmap = defaultMmap + | otherwise = optionMmap + where + optionMmap = options_mmap options + mmap = ["--mmap-pages", selectedMmap] + mkEventFlags :: [String] -> [String] + mkEventFlags = alternate (repeat "-e") + +-- | The default value of the mmap-pages setting. +-- That's an order of magnitude too little to avoid IO/CPU overload +-- with typical examples, but that's the highest permitted value, +-- unless @ghc-events-perf-record@ is run as root. +-- Can be overridden by the user. +defaultMmap :: String +defaultMmap = "128" + +-- | Record these events by default unless the user specifies alternatives. +defaultEvents :: [String] +defaultEvents = + [ + -- scheduler events to record + "sched:sched_process_exit", + "sched:sched_kthread_stop", + "sched:sched_kthread_stop_ret", + "sched:sched_wakeup", + "sched:sched_wakeup_new", + "sched:sched_switch", + "sched:sched_migrate_task", + "sched:sched_process_free", + "sched:sched_process_exit", + "sched:sched_wait_task", + "sched:sched_process_wait", + "sched:sched_process_fork", + "sched:sched_stat_iowait", + "sched:sched_pi_setprio" +-- These are too frequent, mostly in COMM events, and cause IO/CPU overload: +-- "sched:sched_stat_wait", +-- "sched:sched_stat_sleep", +-- "sched:sched_stat_runtime", + + -- system calls to record +-- For raw_syscalls, we currently don't indicate which system call is made. +-- These events are usually too dense, too. +-- "raw_syscalls:sys_enter", +-- "raw_syscalls:sys_exit" + ] ++ syscalls3 ++ syscalls4 ++ syscalls5 ++ syscalls6 ++ syscalls7 + ++ syscalls8 ++ syscalls9 ++ syscalls10 ++ syscalls11 +-- Tracing more syscalls causes +-- Error: sys_perf_event_open() syscall returned with 24 (Too many open files) +-- ++ syscalls1 ++ syscalls2 + where + -- The list taken from http://www.berniepope.id.au/linuxPerfEvents.html. + syscalls1 = + [ + "syscalls:sys_enter_socket", + "syscalls:sys_exit_socket", + "syscalls:sys_enter_socketpair", + "syscalls:sys_exit_socketpair", + "syscalls:sys_enter_bind", + "syscalls:sys_exit_bind", + "syscalls:sys_enter_listen", + "syscalls:sys_exit_listen", + "syscalls:sys_enter_accept4", + "syscalls:sys_exit_accept4", + "syscalls:sys_enter_accept", + "syscalls:sys_exit_accept", + "syscalls:sys_enter_connect", + "syscalls:sys_exit_connect", + "syscalls:sys_enter_getsockname", + "syscalls:sys_exit_getsockname", + "syscalls:sys_enter_getpeername", + "syscalls:sys_exit_getpeername", + "syscalls:sys_enter_sendto", + "syscalls:sys_exit_sendto", + "syscalls:sys_enter_recvfrom", + "syscalls:sys_exit_recvfrom", + "syscalls:sys_enter_setsockopt", + "syscalls:sys_exit_setsockopt", + "syscalls:sys_enter_getsockopt", + "syscalls:sys_exit_getsockopt", + "syscalls:sys_enter_shutdown", + "syscalls:sys_exit_shutdown", + "syscalls:sys_enter_sendmsg", + "syscalls:sys_exit_sendmsg", + "syscalls:sys_enter_sendmmsg", + "syscalls:sys_exit_sendmmsg", + "syscalls:sys_enter_recvmsg", + "syscalls:sys_exit_recvmsg", + "syscalls:sys_enter_recvmmsg", + "syscalls:sys_exit_recvmmsg", + "syscalls:sys_enter_add_key", + "syscalls:sys_exit_add_key", + "syscalls:sys_enter_request_key", + "syscalls:sys_exit_request_key", + "syscalls:sys_enter_keyctl", + "syscalls:sys_exit_keyctl", + "syscalls:sys_enter_mq_open", + "syscalls:sys_exit_mq_open", + "syscalls:sys_enter_mq_unlink", + "syscalls:sys_exit_mq_unlink", + "syscalls:sys_enter_mq_timedsend", + "syscalls:sys_exit_mq_timedsend", + "syscalls:sys_enter_mq_timedreceive", + "syscalls:sys_exit_mq_timedreceive" + ] + syscalls2 = + [ + "syscalls:sys_enter_mq_notify", + "syscalls:sys_exit_mq_notify", + "syscalls:sys_enter_mq_getsetattr", + "syscalls:sys_exit_mq_getsetattr", + "syscalls:sys_enter_shmget", + "syscalls:sys_exit_shmget", + "syscalls:sys_enter_shmctl", + "syscalls:sys_exit_shmctl", + "syscalls:sys_enter_shmat", + "syscalls:sys_exit_shmat", + "syscalls:sys_enter_shmdt", + "syscalls:sys_exit_shmdt", + "syscalls:sys_enter_semget", + "syscalls:sys_exit_semget", + "syscalls:sys_enter_semtimedop", + "syscalls:sys_exit_semtimedop", + "syscalls:sys_enter_semop", + "syscalls:sys_exit_semop", + "syscalls:sys_enter_msgget", + "syscalls:sys_exit_msgget", + "syscalls:sys_enter_msgctl", + "syscalls:sys_exit_msgctl", + "syscalls:sys_enter_msgsnd", + "syscalls:sys_exit_msgsnd", + "syscalls:sys_enter_msgrcv", + "syscalls:sys_exit_msgrcv", + "syscalls:sys_enter_quotactl", + "syscalls:sys_exit_quotactl", + "syscalls:sys_enter_name_to_handle_at", + "syscalls:sys_exit_name_to_handle_at", + "syscalls:sys_enter_open_by_handle_at", + "syscalls:sys_exit_open_by_handle_at", +-- Not present on some systems +-- "syscalls:sys_enter_nfsservctl", +-- "syscalls:sys_exit_nfsservctl", + "syscalls:sys_enter_flock", + "syscalls:sys_exit_flock", + "syscalls:sys_enter_io_setup", + "syscalls:sys_exit_io_setup", + "syscalls:sys_enter_io_destroy", + "syscalls:sys_exit_io_destroy", + "syscalls:sys_enter_io_submit", + "syscalls:sys_exit_io_submit", + "syscalls:sys_enter_io_cancel", + "syscalls:sys_exit_io_cancel", + "syscalls:sys_enter_io_getevents", + "syscalls:sys_exit_io_getevents", + "syscalls:sys_enter_eventfd2", + "syscalls:sys_exit_eventfd2", + "syscalls:sys_enter_eventfd", + "syscalls:sys_exit_eventfd" + ] + syscalls3 = + [ + "syscalls:sys_enter_timerfd_create", + "syscalls:sys_exit_timerfd_create", + "syscalls:sys_enter_timerfd_settime", + "syscalls:sys_exit_timerfd_settime", + "syscalls:sys_enter_timerfd_gettime", + "syscalls:sys_exit_timerfd_gettime", + "syscalls:sys_enter_signalfd4", + "syscalls:sys_exit_signalfd4", + "syscalls:sys_enter_signalfd", + "syscalls:sys_exit_signalfd", + "syscalls:sys_enter_epoll_create1", + "syscalls:sys_exit_epoll_create1", + "syscalls:sys_enter_epoll_create", + "syscalls:sys_exit_epoll_create", + "syscalls:sys_enter_epoll_ctl", + "syscalls:sys_exit_epoll_ctl", + "syscalls:sys_enter_epoll_wait", + "syscalls:sys_exit_epoll_wait", + "syscalls:sys_enter_epoll_pwait", + "syscalls:sys_exit_epoll_pwait", + "syscalls:sys_enter_fanotify_init", + "syscalls:sys_exit_fanotify_init", + "syscalls:sys_enter_inotify_init1", + "syscalls:sys_exit_inotify_init1", + "syscalls:sys_enter_inotify_init", + "syscalls:sys_exit_inotify_init", + "syscalls:sys_enter_inotify_add_watch", + "syscalls:sys_exit_inotify_add_watch", + "syscalls:sys_enter_inotify_rm_watch", + "syscalls:sys_exit_inotify_rm_watch", + "syscalls:sys_enter_ioprio_set", + "syscalls:sys_exit_ioprio_set", + "syscalls:sys_enter_ioprio_get", + "syscalls:sys_exit_ioprio_get", + "syscalls:sys_enter_statfs", + "syscalls:sys_exit_statfs", + "syscalls:sys_enter_fstatfs", + "syscalls:sys_exit_fstatfs", + "syscalls:sys_enter_ustat", + "syscalls:sys_exit_ustat", + "syscalls:sys_enter_utime", + "syscalls:sys_exit_utime", + "syscalls:sys_enter_utimensat", + "syscalls:sys_exit_utimensat", + "syscalls:sys_enter_futimesat", + "syscalls:sys_exit_futimesat", + "syscalls:sys_enter_utimes", + "syscalls:sys_exit_utimes", + "syscalls:sys_enter_sync", + "syscalls:sys_exit_sync" + ] + syscalls4 = + [ + "syscalls:sys_enter_syncfs", + "syscalls:sys_exit_syncfs", + "syscalls:sys_enter_fsync", + "syscalls:sys_exit_fsync", + "syscalls:sys_enter_fdatasync", + "syscalls:sys_exit_fdatasync", + "syscalls:sys_enter_vmsplice", + "syscalls:sys_exit_vmsplice", + "syscalls:sys_enter_splice", + "syscalls:sys_exit_splice", + "syscalls:sys_enter_tee", + "syscalls:sys_exit_tee", + "syscalls:sys_enter_setxattr", + "syscalls:sys_exit_setxattr", + "syscalls:sys_enter_lsetxattr", + "syscalls:sys_exit_lsetxattr", + "syscalls:sys_enter_fsetxattr", + "syscalls:sys_exit_fsetxattr", + "syscalls:sys_enter_getxattr", + "syscalls:sys_exit_getxattr", + "syscalls:sys_enter_lgetxattr", + "syscalls:sys_exit_lgetxattr", + "syscalls:sys_enter_fgetxattr", + "syscalls:sys_exit_fgetxattr", + "syscalls:sys_enter_listxattr", + "syscalls:sys_exit_listxattr", + "syscalls:sys_enter_llistxattr", + "syscalls:sys_exit_llistxattr", + "syscalls:sys_enter_flistxattr", + "syscalls:sys_exit_flistxattr", + "syscalls:sys_enter_removexattr", + "syscalls:sys_exit_removexattr", + "syscalls:sys_enter_lremovexattr", + "syscalls:sys_exit_lremovexattr", + "syscalls:sys_enter_fremovexattr", + "syscalls:sys_exit_fremovexattr", + "syscalls:sys_enter_umount", + "syscalls:sys_exit_umount", + "syscalls:sys_enter_mount", + "syscalls:sys_exit_mount", + "syscalls:sys_enter_pivot_root", + "syscalls:sys_exit_pivot_root", + "syscalls:sys_enter_sysfs", + "syscalls:sys_exit_sysfs", + "syscalls:sys_enter_getcwd", + "syscalls:sys_exit_getcwd", + "syscalls:sys_enter_select", + "syscalls:sys_exit_select", + "syscalls:sys_enter_pselect6", + "syscalls:sys_exit_pselect6" + ] + syscalls5 = + [ + "syscalls:sys_enter_poll", + "syscalls:sys_exit_poll", + "syscalls:sys_enter_ppoll", + "syscalls:sys_exit_ppoll", + "syscalls:sys_enter_getdents", + "syscalls:sys_exit_getdents", + "syscalls:sys_enter_getdents64", + "syscalls:sys_exit_getdents64", + "syscalls:sys_enter_ioctl", + "syscalls:sys_exit_ioctl", + "syscalls:sys_enter_dup3", + "syscalls:sys_exit_dup3", + "syscalls:sys_enter_dup2", + "syscalls:sys_exit_dup2", + "syscalls:sys_enter_dup", + "syscalls:sys_exit_dup", + "syscalls:sys_enter_fcntl", + "syscalls:sys_exit_fcntl", + "syscalls:sys_enter_mknodat", + "syscalls:sys_exit_mknodat", + "syscalls:sys_enter_mknod", + "syscalls:sys_exit_mknod", + "syscalls:sys_enter_mkdirat", + "syscalls:sys_exit_mkdirat", + "syscalls:sys_enter_mkdir", + "syscalls:sys_exit_mkdir", + "syscalls:sys_enter_rmdir", + "syscalls:sys_exit_rmdir", + "syscalls:sys_enter_unlinkat", + "syscalls:sys_exit_unlinkat", + "syscalls:sys_enter_unlink", + "syscalls:sys_exit_unlink", + "syscalls:sys_enter_symlinkat", + "syscalls:sys_exit_symlinkat", + "syscalls:sys_enter_symlink", + "syscalls:sys_exit_symlink", + "syscalls:sys_enter_linkat", + "syscalls:sys_exit_linkat", + "syscalls:sys_enter_link", + "syscalls:sys_exit_link", + "syscalls:sys_enter_renameat", + "syscalls:sys_exit_renameat", + "syscalls:sys_enter_rename", + "syscalls:sys_exit_rename", + "syscalls:sys_enter_pipe2", + "syscalls:sys_exit_pipe2", + "syscalls:sys_enter_pipe", + "syscalls:sys_exit_pipe" + ] + syscalls6 = + [ + "syscalls:sys_enter_newstat", + "syscalls:sys_exit_newstat", + "syscalls:sys_enter_newlstat", + "syscalls:sys_exit_newlstat", + "syscalls:sys_enter_newfstatat", + "syscalls:sys_exit_newfstatat", + "syscalls:sys_enter_newfstat", + "syscalls:sys_exit_newfstat", + "syscalls:sys_enter_readlinkat", + "syscalls:sys_exit_readlinkat", + "syscalls:sys_enter_readlink", + "syscalls:sys_exit_readlink", + "syscalls:sys_enter_lseek", + "syscalls:sys_exit_lseek", + "syscalls:sys_enter_read", + "syscalls:sys_exit_read", + "syscalls:sys_enter_write", + "syscalls:sys_exit_write", + "syscalls:sys_enter_readv", + "syscalls:sys_exit_readv", + "syscalls:sys_enter_writev", + "syscalls:sys_exit_writev", + "syscalls:sys_enter_preadv", + "syscalls:sys_exit_preadv", + "syscalls:sys_enter_pwritev", + "syscalls:sys_exit_pwritev", + "syscalls:sys_enter_sendfile64", + "syscalls:sys_exit_sendfile64", + "syscalls:sys_enter_truncate", + "syscalls:sys_exit_truncate", + "syscalls:sys_enter_ftruncate", + "syscalls:sys_exit_ftruncate", + "syscalls:sys_enter_faccessat", + "syscalls:sys_exit_faccessat", + "syscalls:sys_enter_access", + "syscalls:sys_exit_access", + "syscalls:sys_enter_chdir", + "syscalls:sys_exit_chdir", + "syscalls:sys_enter_fchdir", + "syscalls:sys_exit_fchdir", + "syscalls:sys_enter_chroot", + "syscalls:sys_exit_chroot", + "syscalls:sys_enter_fchmod", + "syscalls:sys_exit_fchmod", + "syscalls:sys_enter_fchmodat", + "syscalls:sys_exit_fchmodat", + "syscalls:sys_enter_chmod", + "syscalls:sys_exit_chmod", + "syscalls:sys_enter_chown", + "syscalls:sys_exit_chown", + "syscalls:sys_enter_fchownat", + "syscalls:sys_exit_fchownat" + ] + syscalls7 = + [ + "syscalls:sys_enter_lchown", + "syscalls:sys_exit_lchown", + "syscalls:sys_enter_fchown", + "syscalls:sys_exit_fchown", + "syscalls:sys_enter_open", + "syscalls:sys_exit_open", + "syscalls:sys_enter_openat", + "syscalls:sys_exit_openat", + "syscalls:sys_enter_creat", + "syscalls:sys_exit_creat", + "syscalls:sys_enter_close", + "syscalls:sys_exit_close", + "syscalls:sys_enter_vhangup", + "syscalls:sys_exit_vhangup", + "syscalls:sys_enter_move_pages", + "syscalls:sys_exit_move_pages", + "syscalls:sys_enter_mbind", + "syscalls:sys_exit_mbind", + "syscalls:sys_enter_set_mempolicy", + "syscalls:sys_exit_set_mempolicy", + "syscalls:sys_enter_migrate_pages", + "syscalls:sys_exit_migrate_pages", + "syscalls:sys_enter_get_mempolicy", + "syscalls:sys_exit_get_mempolicy", + "syscalls:sys_enter_swapoff", + "syscalls:sys_exit_swapoff", + "syscalls:sys_enter_swapon", + "syscalls:sys_exit_swapon", + "syscalls:sys_enter_msync", + "syscalls:sys_exit_msync", + "syscalls:sys_enter_mremap", + "syscalls:sys_exit_mremap", + "syscalls:sys_enter_mprotect", + "syscalls:sys_exit_mprotect", + "syscalls:sys_enter_brk", + "syscalls:sys_exit_brk", + "syscalls:sys_enter_munmap", + "syscalls:sys_exit_munmap", + "syscalls:sys_enter_mlock", + "syscalls:sys_exit_mlock", + "syscalls:sys_enter_munlock", + "syscalls:sys_exit_munlock", + "syscalls:sys_enter_mlockall", + "syscalls:sys_exit_mlockall", + "syscalls:sys_enter_munlockall", + "syscalls:sys_exit_munlockall", + "syscalls:sys_enter_mincore", + "syscalls:sys_exit_mincore", + "syscalls:sys_enter_madvise", + "syscalls:sys_exit_madvise", + "syscalls:sys_enter_remap_file_pages", + "syscalls:sys_exit_remap_file_pages" + ] + syscalls8 = + [ + "syscalls:sys_enter_perf_event_open", + "syscalls:sys_exit_perf_event_open", + "syscalls:sys_enter_kexec_load", + "syscalls:sys_exit_kexec_load", + "syscalls:sys_enter_acct", + "syscalls:sys_exit_acct", + "syscalls:sys_enter_delete_module", + "syscalls:sys_exit_delete_module", + "syscalls:sys_enter_init_module", + "syscalls:sys_exit_init_module", + "syscalls:sys_enter_set_robust_list", + "syscalls:sys_exit_set_robust_list", + "syscalls:sys_enter_get_robust_list", + "syscalls:sys_exit_get_robust_list", + "syscalls:sys_enter_futex", + "syscalls:sys_exit_futex", + "syscalls:sys_enter_getgroups", + "syscalls:sys_exit_getgroups", + "syscalls:sys_enter_setgroups", + "syscalls:sys_exit_setgroups", + "syscalls:sys_enter_setns", + "syscalls:sys_exit_setns", + "syscalls:sys_enter_nanosleep", + "syscalls:sys_exit_nanosleep", + "syscalls:sys_enter_timer_create", + "syscalls:sys_exit_timer_create", + "syscalls:sys_enter_timer_gettime", + "syscalls:sys_exit_timer_gettime", + "syscalls:sys_enter_timer_getoverrun", + "syscalls:sys_exit_timer_getoverrun", + "syscalls:sys_enter_timer_settime", + "syscalls:sys_exit_timer_settime", + "syscalls:sys_enter_timer_delete", + "syscalls:sys_exit_timer_delete", + "syscalls:sys_enter_clock_settime", + "syscalls:sys_exit_clock_settime", +-- Too common, crowds the display +-- "syscalls:sys_enter_clock_gettime", +-- "syscalls:sys_exit_clock_gettime", + "syscalls:sys_enter_clock_adjtime", + "syscalls:sys_exit_clock_adjtime", + "syscalls:sys_enter_clock_getres", + "syscalls:sys_exit_clock_getres", + "syscalls:sys_enter_clock_nanosleep", + "syscalls:sys_exit_clock_nanosleep", + "syscalls:sys_enter_setpriority", + "syscalls:sys_exit_setpriority", + "syscalls:sys_enter_getpriority", + "syscalls:sys_exit_getpriority", + "syscalls:sys_enter_reboot", + "syscalls:sys_exit_reboot", + "syscalls:sys_enter_setregid", + "syscalls:sys_exit_setregid" + ] + syscalls9 = + [ + "syscalls:sys_enter_setgid", + "syscalls:sys_exit_setgid", + "syscalls:sys_enter_setreuid", + "syscalls:sys_exit_setreuid", + "syscalls:sys_enter_setuid", + "syscalls:sys_exit_setuid", + "syscalls:sys_enter_setresuid", + "syscalls:sys_exit_setresuid", + "syscalls:sys_enter_getresuid", + "syscalls:sys_exit_getresuid", + "syscalls:sys_enter_setresgid", + "syscalls:sys_exit_setresgid", + "syscalls:sys_enter_getresgid", + "syscalls:sys_exit_getresgid", + "syscalls:sys_enter_setfsuid", + "syscalls:sys_exit_setfsuid", + "syscalls:sys_enter_setfsgid", + "syscalls:sys_exit_setfsgid", + "syscalls:sys_enter_times", + "syscalls:sys_exit_times", + "syscalls:sys_enter_setpgid", + "syscalls:sys_exit_setpgid", + "syscalls:sys_enter_getpgid", + "syscalls:sys_exit_getpgid", + "syscalls:sys_enter_getpgrp", + "syscalls:sys_exit_getpgrp", + "syscalls:sys_enter_getsid", + "syscalls:sys_exit_getsid", + "syscalls:sys_enter_setsid", + "syscalls:sys_exit_setsid", + "syscalls:sys_enter_newuname", + "syscalls:sys_exit_newuname", + "syscalls:sys_enter_sethostname", + "syscalls:sys_exit_sethostname", + "syscalls:sys_enter_setdomainname", + "syscalls:sys_exit_setdomainname", + "syscalls:sys_enter_getrlimit", + "syscalls:sys_exit_getrlimit", + "syscalls:sys_enter_prlimit64", + "syscalls:sys_exit_prlimit64", + "syscalls:sys_enter_setrlimit", + "syscalls:sys_exit_setrlimit", + "syscalls:sys_enter_getrusage", + "syscalls:sys_exit_getrusage", + "syscalls:sys_enter_umask", + "syscalls:sys_exit_umask", + "syscalls:sys_enter_prctl", + "syscalls:sys_exit_prctl", + "syscalls:sys_enter_restart_syscall", + "syscalls:sys_exit_restart_syscall" + ] + syscalls10 = + [ + "syscalls:sys_enter_rt_sigprocmask", + "syscalls:sys_exit_rt_sigprocmask", + "syscalls:sys_enter_rt_sigpending", + "syscalls:sys_exit_rt_sigpending", + "syscalls:sys_enter_rt_sigtimedwait", + "syscalls:sys_exit_rt_sigtimedwait", + "syscalls:sys_enter_kill", + "syscalls:sys_exit_kill", + "syscalls:sys_enter_tgkill", + "syscalls:sys_exit_tgkill", + "syscalls:sys_enter_tkill", + "syscalls:sys_exit_tkill", + "syscalls:sys_enter_rt_sigqueueinfo", + "syscalls:sys_exit_rt_sigqueueinfo", + "syscalls:sys_enter_rt_tgsigqueueinfo", + "syscalls:sys_exit_rt_tgsigqueueinfo", + "syscalls:sys_enter_rt_sigaction", + "syscalls:sys_exit_rt_sigaction", + "syscalls:sys_enter_pause", + "syscalls:sys_exit_pause", + "syscalls:sys_enter_rt_sigsuspend", + "syscalls:sys_exit_rt_sigsuspend", + "syscalls:sys_enter_alarm", + "syscalls:sys_exit_alarm", + "syscalls:sys_enter_getpid", + "syscalls:sys_exit_getpid", + "syscalls:sys_enter_getppid", + "syscalls:sys_exit_getppid", + "syscalls:sys_enter_getuid", + "syscalls:sys_exit_getuid", + "syscalls:sys_enter_geteuid", + "syscalls:sys_exit_geteuid", + "syscalls:sys_enter_getgid", + "syscalls:sys_exit_getgid", + "syscalls:sys_enter_getegid", + "syscalls:sys_exit_getegid", + "syscalls:sys_enter_gettid", + "syscalls:sys_exit_gettid", + "syscalls:sys_enter_sysinfo", + "syscalls:sys_exit_sysinfo", + "syscalls:sys_enter_ptrace", + "syscalls:sys_exit_ptrace", + "syscalls:sys_enter_capget", + "syscalls:sys_exit_capget", + "syscalls:sys_enter_capset", + "syscalls:sys_exit_capset", + "syscalls:sys_enter_sysctl", + "syscalls:sys_exit_sysctl" + ] + syscalls11 = + [ + "syscalls:sys_enter_time", + "syscalls:sys_exit_time", + "syscalls:sys_enter_gettimeofday", + "syscalls:sys_exit_gettimeofday", + "syscalls:sys_enter_settimeofday", + "syscalls:sys_exit_settimeofday", + "syscalls:sys_enter_adjtimex", + "syscalls:sys_exit_adjtimex", + "syscalls:sys_enter_getitimer", + "syscalls:sys_exit_getitimer", + "syscalls:sys_enter_setitimer", + "syscalls:sys_exit_setitimer", + "syscalls:sys_enter_exit", + "syscalls:sys_exit_exit", + "syscalls:sys_enter_exit_group", + "syscalls:sys_exit_exit_group", + "syscalls:sys_enter_waitid", + "syscalls:sys_exit_waitid", + "syscalls:sys_enter_wait4", + "syscalls:sys_exit_wait4", + "syscalls:sys_enter_syslog", + "syscalls:sys_exit_syslog", + "syscalls:sys_enter_personality", + "syscalls:sys_exit_personality", + "syscalls:sys_enter_set_tid_address", + "syscalls:sys_exit_set_tid_address", + "syscalls:sys_enter_unshare", + "syscalls:sys_exit_unshare", + "syscalls:sys_enter_sched_setscheduler", + "syscalls:sys_exit_sched_setscheduler", + "syscalls:sys_enter_sched_setparam", + "syscalls:sys_exit_sched_setparam", + "syscalls:sys_enter_sched_getscheduler", + "syscalls:sys_exit_sched_getscheduler", + "syscalls:sys_enter_sched_getparam", + "syscalls:sys_exit_sched_getparam", + "syscalls:sys_enter_sched_setaffinity", + "syscalls:sys_exit_sched_setaffinity", + "syscalls:sys_enter_sched_getaffinity", + "syscalls:sys_exit_sched_getaffinity", +-- Too common, crowds the display +-- "syscalls:sys_enter_sched_yield", +-- "syscalls:sys_exit_sched_yield", + "syscalls:sys_enter_sched_get_priority_max", + "syscalls:sys_exit_sched_get_priority_max", + "syscalls:sys_enter_sched_get_priority_min", + "syscalls:sys_exit_sched_get_priority_min", + "syscalls:sys_enter_sched_rr_get_interval", + "syscalls:sys_exit_sched_rr_get_interval", + "syscalls:sys_enter_mmap", + "syscalls:sys_exit_mmap" + ] + +-- Given two lists [a, b, c ..] [d, e, f ..] +-- return a single list by alternating elements from +-- each: [a, d, b, e, c, f ..] until at least one +-- of the lists is exhausted. +alternate :: [a] -> [a] -> [a] +alternate [] _ = [] +alternate _ [] = [] +alternate (x:xs) (y:ys) = x : y : alternate xs ys diff --git a/ghc-events-perf/ghc-events-perf-sync.hs b/ghc-events-perf/ghc-events-perf-sync.hs new file mode 100644 --- /dev/null +++ b/ghc-events-perf/ghc-events-perf-sync.hs @@ -0,0 +1,186 @@ +{-# 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) + ] diff --git a/ghc-events-perf/ghc-events-perf.hs b/ghc-events-perf/ghc-events-perf.hs new file mode 100644 --- /dev/null +++ b/ghc-events-perf/ghc-events-perf.hs @@ -0,0 +1,102 @@ +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2012 Duncan Coutts, Bernie Pope, Mikolaj Konarski +-- License : BSD-style +-- Maintainer : florbitous@gmail.com +-- Stability : experimental +-- Portability : ghc +-- +-- A tool to help profiling a Haskell program using Linux 'perf', +-- ghc-events and, eventually, Threadscope. +-- +-- The ghc-events-perf tool has a couple of commands +-- for obtaining 'perf' performance data for a Haskell program, +-- translating it to the ghc-events format, synchronizing and merging +-- with the standard ghc-events eventlog for the Haskell program, +-- and so making the data ready for display in Threadscope. +-- +-- Usage: +-- +-- > ghc-events-perf command command-args +-- +-- Getting help: +-- +-- > ghc-events-perf help +-- > ghc-events-perf help command +----------------------------------------------------------------------------- + +module Main where + +import System.Posix.Process +import System.Environment +import System.Exit +import System.FilePath +import System.Process +import System.IO (hPutStrLn, stderr) +import Control.Monad + +main :: IO () +main = getArgs >>= command + +command :: [String] -> IO () +command [helpString] | helpString `elem` ["-h", "--help", "help"] = + putStrLn usage + +command ["help", "help"] = + putStrLn "Helps." + +command ["help", "record"] = do + let args = ["+GhcEventsPerf", "-h"] + executeFile "ghc-events-perf-record" True args Nothing + +command ["help", "convert"] = + putStr $ unlines $ + [ "Usage: ghc-events-perf convert program-name [out-file perf-file eventlog-file]" + , " program-name the name of the profiled Haskell program" + , " out-file where to save the resulting compound eventlog" + , " perf-file path to the perf data file for the Haskell program" + , " eventlog-file path to the GHC RTS eventlog of the Haskell program" + ] + +command ("record" : args) = do + myPath <- getExecutablePath + let commonPath = fst $ splitFileName myPath + -- We assume ghc-events-perf-record is in the same directory + -- as ghc-events-perf. Needed for 'sudo', because root needn't + -- have user's ~/.cabal/bin in his PATH. + recordPath = combine commonPath "ghc-events-perf-record" + recordArgs = "--RTS" : args + executeFile recordPath True recordArgs Nothing + +command ["convert", program_name, out_file, perf_file, eventlog_file] = do + let sync_eventlog_file = program_name ++ ".perf.eventlog" + syncArgs = [ program_name + , perf_file + , sync_eventlog_file + ] + putStrLn "Translating and synchronizing..." + syncHandle <- runProcess "ghc-events-perf-sync" syncArgs + Nothing Nothing Nothing Nothing Nothing + void $ waitForProcess syncHandle + let mergeArgs = [ "merge" + , out_file + , eventlog_file + , sync_eventlog_file + ] + putStrLn "Merging with the standard eventlog..." + executeFile "ghc-events" True mergeArgs Nothing + +command ["convert", program_name] = do + let out_file = program_name ++ ".total.eventlog" + perf_file = "data.perf" -- the same as defaultPerfOutputFile in record + eventlog_file = program_name ++ ".eventlog" + command ["convert", program_name, out_file, perf_file, eventlog_file] + +command _ = putStrLn usage >> die "Unrecognized command" + +usage :: String +usage = "Usage: ghc-events-perf command command-args\n\nThe available commands are: record convert help.\n\nSee 'ghc-events-perf help command' for more information on a specific command." + +-- Exit the program with an error message. +die :: String -> IO a +die s = hPutStrLn stderr s >> exitWith (ExitFailure 1) diff --git a/linux-perf.cabal b/linux-perf.cabal new file mode 100644 --- /dev/null +++ b/linux-perf.cabal @@ -0,0 +1,192 @@ +Name: linux-perf +Version: 0.3 +Synopsis: Read files generated by perf on Linux +Homepage: http://code.haskell.org/linux-perf +License: BSD3 +License-file: LICENSE +Data-files: LICENSE, README.md, README.ghc-events-perf.md, + from_linux-perf-users.md, Profiling/Linux/Perf/perf_file.h +Author: Simon Marlow, Bernie Pope, Mikolaj Konarski, Duncan Coutts +Maintainer: Bernie Pope +Stability: Experimental +homepage: https://github.com/bjpop/haskell-linux-perf +bug-reports: https://github.com/bjpop/haskell-linux-perf/issues +category: Development, GHC, Debug, Profiling, Trace +Build-type: Simple +Cabal-version: >=1.10 +Description: + This library is for parsing, representing in Haskell and pretty printing + the data file output of the Linux @perf@ command. + The @perf@ command provides performance profiling information for + applications running under the Linux operating system. This information + includes hardware performance counters and kernel tracepoints. + . + Modern CPUs can provide information about the runtime behaviour + of software through so-called hardware performance counters + . + Recent versions of + the Linux kernel (since 2.6.31) provide a generic interface + to low-level events for running processes. + This includes access to hardware counters but also a wide array + of software events such as page faults, + scheduling activity and system calls. A userspace tool called 'perf' + is built on top of the kernel interface, + which provides a convenient way to record and view events + for running processes. + . + The @perf@ tool has many sub-commands which do a variety of things, + but in general it has two main purposes: + . + 1. Recording events. + . + 2. Displaying events. + . + The @perf record@ command records information about performance + events in a file called (by default) @perf.data@. + It is a binary file format which is basically a memory dump + of the data structures used to record event information. + The file has two main parts: + . + 1. A header which describes the layout of information + in the file (section sizes, etcetera) and common information + about events in the second part of the file (an encoding + of event types and their names). + . + 2. The payload of the file which is a sequence of event records. + . + Each event field has a header which says what general type of event it is + plus information about the size of its body. + . + There are nine types of event: + . + 1. @PERF_RECORD_MMAP@: memory map event. + . + 2. @PERF_RECORD_LOST@: an unknown event. + . + 3. @PERF_RECORD_COMM@: maps a command name string to a process + and thread ID. + . + 4. @PERF_RECORD_EXIT@: process exit. + . + 5. @PERF_RECORD_THROTTLE@: + . + 6. @PERF_RECORD_UNTHROTTLE@: + . + 7. @PERF_RECORD_FORK@: process creation. + . + 8. @PERF_RECORD_READ@: + . + 9. @PERF_RECORD_SAMPLE@: a sample of an actual hardware counter + or a software event. + . + The @PERF_RECORD_SAMPLE@ events (samples) are the most interesting + ones in terms of program profiling. The other events + seem to be mostly useful for keeping track of process technicalities. + Samples are timestamped with an unsigned 64 bit + word, which records elapsed nanoseconds since some point in time + (system running time, based on the kernel scheduler clock). + Samples have themselves a type which is defined + in the file header and linked to the sample by an integer identifier. + . + Below is an example program which reads a @perf.data@ file and prints out + the number of events that it contains. + . + >module Main where + > + >import Profiling.Linux.Perf (readPerfData) + >import Profiling.Linux.Perf.Types (PerfData (..)) + >import System.Environment (getArgs) + > + >main :: IO () + >main = do + > args <- getArgs + > case args of + > [] -> return () + > (file:_) -> do + > perfData <- readPerfData file + > print $ length $ perfData_events perfData + +source-repository head + type: git + location: git://github.com/bjpop/haskell-linux-perf.git + +Library + -- Modules exported by the library. + Exposed-modules: Profiling.Linux.Perf, + Profiling.Linux.Perf.Types, + Profiling.Linux.Perf.Parse, + Profiling.Linux.Perf.Pretty + + -- Packages needed in order to build this package. + Build-depends: base==4.*, + binary >= 0.5 && < 0.7, + mtl==2.*, + bytestring >= 0.9, + pretty >= 1 && < 2, + containers >= 0.4 && < 0.6 + + include-dirs: Profiling/Linux/Perf + + default-language: Haskell2010 + + -- Modules not exported by this package. + -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: + +Executable dump-perf { + Main-is: dump-perf.hs + hs-source-dirs: dump-perf + Build-depends: linux-perf>=0.2, + base==4.*, + bytestring >= 0.9 + default-language: Haskell2010 + ghc-options: -rtsopts +} + +Executable ghc-events-perf-record { + Main-is: ghc-events-perf-record.hs + hs-source-dirs: ghc-events-perf + Build-depends: base==4.*, + unix >= 2.5 && < 2.7, + directory >= 1.1 && < 2, + filepath >= 1.2 && < 2 + default-language: Haskell2010 + ghc-options: -rtsopts + ghc-options: -Wall -fwarn-orphans -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unrecognised-pragmas + ghc-options: -fno-warn-auto-orphans -fno-warn-implicit-prelude +} + +Executable ghc-events-perf-sync { + Main-is: ghc-events-perf-sync.hs + hs-source-dirs: ghc-events-perf + Build-depends: base==4.*, + ghc-events >= 0.4.2, + containers >= 0.4 && < 0.6, + process==1.1.* + default-language: Haskell2010 + ghc-options: -rtsopts + ghc-options: -Wall -fwarn-orphans -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unrecognised-pragmas + ghc-options: -fno-warn-auto-orphans -fno-warn-implicit-prelude +} + +Executable ghc-events-perf { + Main-is: ghc-events-perf.hs + hs-source-dirs: ghc-events-perf + Build-depends: base==4.*, + filepath >= 1.2 && < 2, + process==1.1.*, + unix >= 2.5 && < 2.7 + default-language: Haskell2010 + ghc-options: -Wall -fwarn-orphans -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unrecognised-pragmas + ghc-options: -fno-warn-auto-orphans -fno-warn-implicit-prelude +} + +Executable count-events { + Main-is: count-events.hs + hs-source-dirs: test + Build-depends: linux-perf>=0.2, + base==4.* + default-language: Haskell2010 +} diff --git a/test/count-events.hs b/test/count-events.hs new file mode 100644 --- /dev/null +++ b/test/count-events.hs @@ -0,0 +1,17 @@ +-- | The example program from the linux-perf.cabal file. +-- Let's run it once in a while to make sure API changes did not break it. + +module Main where + +import Profiling.Linux.Perf (readPerfData) +import Profiling.Linux.Perf.Types (PerfData (..)) +import System.Environment (getArgs) + +main :: IO () +main = do + args <- getArgs + case args of + [] -> return () + (file:_) -> do + perfData <- readPerfData file + print $ length $ perfData_events perfData