packages feed

linux-perf (empty) → 0.3

raw patch · 16 files changed

+3042/−0 lines, 16 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, containers, directory, filepath, ghc-events, linux-perf, mtl, pretty, process, unix

Files

+ LICENSE view
@@ -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.
+ Profiling/Linux/Perf.hs view
@@ -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 <unknown source>"+   prettyPayload _typeMap other = []
+ Profiling/Linux/Perf/Parse.hsc view
@@ -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 <linux/perf_event.h>+#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 <perf source>/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 <perf source>/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 <system include directory>/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 <system include directory>/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 <perf source>/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 <perf source>/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 <system include directory>/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 <perf source>/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 <perf source>/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 <perf source>/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 <perf source>/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 <system include directory>/linux/perf_event.h+-- Note: cannnot find corresponding entry in <perf source>/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 <perf source>/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
+ Profiling/Linux/Perf/Pretty.hs view
@@ -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'
+ Profiling/Linux/Perf/Types.hs view
@@ -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 @\<perf source\>\/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 @\<perf source\>\/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 @\<perf source\>\/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 @\<perf source\>\/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 @\<perf source\>\/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 @\<perf source\>\/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 @\<perf source\>\/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 @\<perf source\>\/util\/event.h@ (without the header)+   | LostEvent {+      eventPayload_id :: EventID,+      eventPayload_Lost :: Word64+   }+   -- Corresponds with the @read_event@ struct in @\<perf source\>\/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+   -- @\<system include directory\>\/linux\/perf_event.h@+   -- but does not appear in @\<perf source\>\/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"
+ Profiling/Linux/Perf/perf_file.h view
@@ -0,0 +1,39 @@+#include "HsFFI.h"+#include <linux/perf_event.h>++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];+};
+ README.ghc-events-perf.md view
@@ -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.
+ README.md view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ dump-perf/dump-perf.hs view
@@ -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
+ from_linux-perf-users.md view
@@ -0,0 +1,72 @@+We greatly benefited from the help of the perf mailing list+<linux-perf-users@vger.kernel.org>. 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.
+ ghc-events-perf/ghc-events-perf-record.hs view
@@ -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
+ ghc-events-perf/ghc-events-perf-sync.hs view
@@ -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)+  ]
+ ghc-events-perf/ghc-events-perf.hs view
@@ -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)
+ linux-perf.cabal view
@@ -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 <florbitous@gmail.com>+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+ <http://en.wikipedia.org/wiki/Hardware_performance_counter>.+ 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+}
+ test/count-events.hs view
@@ -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