module Profiling.Linux.Perf.Types
(
PID (..)
, TID (..)
, EventID (..)
, EventTypeID (..)
, ByteCount64 (..)
, ByteCount32 (..)
, ByteCount16 (..)
, TimeStamp (..)
, FileSection (..)
, FileHeader (..)
, FileAttr (..)
, Event (..)
, EventCPUMode (..)
, EventAttr (..)
, EventHeader (..)
, EventPayload (..)
, EventType (..)
, SampleFormat (..)
, TraceEventType (..)
, EventAttrFlag (..)
, EventSource (..)
, SampleTypeBitMap (..)
, testEventAttrFlag
, 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)
data PerfData =
PerfData
{ perfData_fileHeader :: FileHeader
, perfData_attrs :: [FileAttr]
, perfData_idss :: [[EventID]]
, perfData_types :: [TraceEventType]
, perfData_events :: [Event]
}
newtype PID = PID { pid :: Word32 }
deriving (Eq, Ord, Show, Pretty)
newtype TID = TID { tid :: Word32 }
deriving (Eq, Ord, Show, Pretty)
newtype EventTypeID = EventTypeID { eventTypeID :: Word64 }
deriving (Eq, Ord, Show, Pretty)
newtype EventID = EventID { eventID :: Word64 }
deriving (Eq, Ord, Show, Pretty)
newtype TimeStamp = TimeStamp { timeStamp :: Word64 }
deriving (Eq, Ord, Show, Pretty)
newtype SampleTypeBitMap = SampleTypeBitMap { sampleTypeBitMap :: Word64 }
deriving (Eq, Show, Pretty)
newtype ByteCount64 = ByteCount64 { byteCount64 :: Word64 }
deriving (Eq, Ord, Show, Pretty, Enum, Integral, Real, Num)
newtype ByteCount32 = ByteCount32 { byteCount32 :: Word32 }
deriving (Eq, Ord, Show, Pretty, Enum, Integral, Real, Num)
newtype ByteCount16 = ByteCount16 { byteCount16 :: Word16 }
deriving (Eq, Ord, Show, Pretty, Enum, Integral, Real, Num)
data Event =
Event
{ ev_header :: EventHeader
, ev_payload :: EventPayload
}
instance Pretty Event where
pretty ev@(Event {}) =
text "header: " <+> (pretty $ ev_header ev) $$
text "payload: " <+> (pretty $ ev_payload ev)
data EventType
= PERF_RECORD_MMAP
| PERF_RECORD_LOST
| PERF_RECORD_COMM
| PERF_RECORD_EXIT
| PERF_RECORD_THROTTLE
| PERF_RECORD_UNTHROTTLE
| PERF_RECORD_FORK
| PERF_RECORD_READ
| PERF_RECORD_SAMPLE
| PERF_RECORD_UNKNOWN Int
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
data SampleFormat
= PERF_SAMPLE_IP
| PERF_SAMPLE_TID
| PERF_SAMPLE_TIME
| PERF_SAMPLE_ADDR
| PERF_SAMPLE_READ
| PERF_SAMPLE_CALLCHAIN
| PERF_SAMPLE_ID
| PERF_SAMPLE_CPU
| PERF_SAMPLE_PERIOD
| PERF_SAMPLE_STREAM_ID
| PERF_SAMPLE_RAW
deriving (Eq, Enum, Show)
instance Pretty SampleFormat where
pretty = text . show
data EventCPUMode
= PERF_RECORD_CPUMODE_UNKNOWN
| PERF_RECORD_MISC_KERNEL
| PERF_RECORD_MISC_USER
| PERF_RECORD_MISC_HYPERVISOR
deriving (Eq, Show)
instance Pretty EventCPUMode where
pretty = text . show
data FileSection
= FileSection {
sec_offset :: ByteCount64,
sec_size :: ByteCount64
}
instance Pretty FileSection where
pretty fs = text "offset:" <+> pretty (sec_offset fs) $$
text "size:" <+> pretty (sec_size fs)
data FileHeader
= FileHeader {
fh_size :: ByteCount64,
fh_attr_size :: ByteCount64,
fh_attrs_offset :: ByteCount64,
fh_attrs_size :: ByteCount64,
fh_data_offset :: ByteCount64,
fh_data_size :: ByteCount64,
fh_event_offset :: ByteCount64,
fh_event_size :: ByteCount64,
fh_adds_features :: [Word32]
}
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)
data EventAttrFlag
= Disabled
| Inherit
| Pinned
| Exclusive
| ExcludeUser
| ExcludeKernel
| ExcludeHV
| ExcludeIdle
| Mmap
| Comm
| Freq
| InheritStat
| EnableOnExec
| Task
| WaterMark
| ArbitrarySkid
| ConstantSkid
| RequestedZeroSkid
| CompulsoryZeroSkid
| MmapData
| SampleIdAll
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"
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
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
data EventSource
= PerfTypeHardware
| PerfTypeSoftware
| PerfTypeTracePoint
| PerfTypeHwCache
| PerfTypeRaw
| PerfTypeBreakpoint
| PerfTypeUnknown
deriving (Eq, Ord, Show, Enum)
instance Pretty EventSource where
pretty = text . show
data EventAttr
= EventAttr {
ea_type :: EventSource,
ea_size :: ByteCount32,
ea_config :: EventTypeID,
ea_sample_period_or_freq :: Word64,
ea_sample_type :: SampleTypeBitMap,
ea_read_format :: Word64,
ea_flags :: Word64,
ea_wakeup_events_or_watermark :: Word32,
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)
data FileAttr = FileAttr {
fa_attr :: EventAttr,
fa_ids_offset :: ByteCount64,
fa_ids_size :: ByteCount64
}
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)
data TraceEventType = TraceEventType {
te_event_id :: EventTypeID,
te_name :: ByteString
}
instance Pretty TraceEventType where
pretty te =
text "event id:" <+> pretty (te_event_id te) $$
text "name:" <+> pretty (te_name te)
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 =
CommEvent {
eventPayload_pid :: PID,
eventPayload_tid :: TID,
eventPayload_CommName :: ByteString
}
| MmapEvent {
eventPayload_pid :: PID,
eventPayload_tid :: TID,
eventPayload_MmapStart :: Word64,
eventPayload_MmapLen :: Word64,
eventPayload_MmapPgoff :: Word64,
eventPayload_MmapFilename :: ByteString
}
| ForkEvent {
eventPayload_pid :: PID,
eventPayload_ppid :: PID,
eventPayload_tid :: TID,
eventPayload_ptid :: TID,
eventPayload_time :: TimeStamp
}
| ExitEvent {
eventPayload_pid :: PID,
eventPayload_ppid :: PID,
eventPayload_tid :: TID,
eventPayload_ptid :: TID,
eventPayload_time :: TimeStamp
}
| LostEvent {
eventPayload_id :: EventID,
eventPayload_Lost :: Word64
}
| ReadEvent {
eventPayload_pid :: PID,
eventPayload_tid :: TID,
eventPayload_ReadValue :: Word64,
eventPayload_ReadTimeEnabled :: Word64,
eventPayload_ReadTimeRunning :: Word64,
eventPayload_id :: EventID
}
| SampleEvent {
eventPayload_SampleIP :: Maybe Word64,
eventPayload_SamplePID :: Maybe PID,
eventPayload_SampleTID :: Maybe TID,
eventPayload_SampleTime :: Maybe TimeStamp,
eventPayload_SampleAddr :: Maybe Word64,
eventPayload_SampleID :: Maybe EventID,
eventPayload_SampleStreamID :: Maybe Word64,
eventPayload_SampleCPU :: Maybe Word32,
eventPayload_SamplePeriod :: Maybe Word64
}
| ThrottleEvent {
eventPayload_time :: TimeStamp,
eventPayload_id :: EventID,
eventPayload_stream_id :: Word64
}
| UnThrottleEvent {
eventPayload_time :: TimeStamp,
eventPayload_id :: EventID,
eventPayload_stream_id :: Word64
}
| UnknownEvent
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"