{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module GHC.RTS.EventTypes where
import Control.Monad
import Data.Bits

import Data.Binary
import Data.Text (Text)
import qualified Data.ByteString as B
import qualified Data.Vector.Unboxed as VU

-- EventType.
type EventTypeNum = Word16
type EventTypeDescLen = Word32
type EventTypeDesc = Text
type EventTypeSize = Word16
-- Event.
type Timestamp = Word64
type ThreadId = Word32
type CapNo = Word16
type Marker = Word32
type BlockSize = Word32
type RawThreadStopStatus = Word16
type StringId = Word32
type Capset   = Word32
type PerfEventTypeNum = Word32
type TaskId = Word64
type PID = Word32

newtype KernelThreadId = KernelThreadId { KernelThreadId -> Word64
kernelThreadId :: Word64 }
  deriving (KernelThreadId -> KernelThreadId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KernelThreadId -> KernelThreadId -> Bool
$c/= :: KernelThreadId -> KernelThreadId -> Bool
== :: KernelThreadId -> KernelThreadId -> Bool
$c== :: KernelThreadId -> KernelThreadId -> Bool
Eq, Eq KernelThreadId
KernelThreadId -> KernelThreadId -> Bool
KernelThreadId -> KernelThreadId -> Ordering
KernelThreadId -> KernelThreadId -> KernelThreadId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KernelThreadId -> KernelThreadId -> KernelThreadId
$cmin :: KernelThreadId -> KernelThreadId -> KernelThreadId
max :: KernelThreadId -> KernelThreadId -> KernelThreadId
$cmax :: KernelThreadId -> KernelThreadId -> KernelThreadId
>= :: KernelThreadId -> KernelThreadId -> Bool
$c>= :: KernelThreadId -> KernelThreadId -> Bool
> :: KernelThreadId -> KernelThreadId -> Bool
$c> :: KernelThreadId -> KernelThreadId -> Bool
<= :: KernelThreadId -> KernelThreadId -> Bool
$c<= :: KernelThreadId -> KernelThreadId -> Bool
< :: KernelThreadId -> KernelThreadId -> Bool
$c< :: KernelThreadId -> KernelThreadId -> Bool
compare :: KernelThreadId -> KernelThreadId -> Ordering
$ccompare :: KernelThreadId -> KernelThreadId -> Ordering
Ord, Int -> KernelThreadId -> ShowS
[KernelThreadId] -> ShowS
KernelThreadId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KernelThreadId] -> ShowS
$cshowList :: [KernelThreadId] -> ShowS
show :: KernelThreadId -> String
$cshow :: KernelThreadId -> String
showsPrec :: Int -> KernelThreadId -> ShowS
$cshowsPrec :: Int -> KernelThreadId -> ShowS
Show)
instance Binary KernelThreadId where
  put :: KernelThreadId -> Put
put (KernelThreadId Word64
tid) = forall t. Binary t => t -> Put
put Word64
tid
  get :: Get KernelThreadId
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> KernelThreadId
KernelThreadId forall t. Binary t => Get t
get

-- Types for Parallel-RTS Extension
type ProcessId = Word32
type MachineId = Word16
type PortId = ThreadId
type MessageSize = Word32
type RawMsgTag = Word8

-- These types are used by Mercury events.
type ParConjDynId = Word64
type ParConjStaticId = StringId
type SparkId = Word32
type FutureId = Word64

sz_event_type_num :: EventTypeSize
sz_event_type_num :: Word16
sz_event_type_num = Word16
2
sz_cap :: EventTypeSize
sz_cap :: Word16
sz_cap  = Word16
2
sz_time :: EventTypeSize
sz_time :: Word16
sz_time = Word16
8
sz_tid :: EventTypeSize
sz_tid :: Word16
sz_tid  = Word16
4
sz_old_tid :: EventTypeSize
sz_old_tid :: Word16
sz_old_tid  = Word16
8 -- GHC 6.12 was using 8 for ThreadID when declaring the size
                -- of events, but was actually using 32 bits for ThreadIDs
sz_capset :: EventTypeSize
sz_capset :: Word16
sz_capset = Word16
4
sz_capset_type :: EventTypeSize
sz_capset_type :: Word16
sz_capset_type = Word16
2
sz_block_size :: EventTypeSize
sz_block_size :: Word16
sz_block_size = Word16
4
sz_block_event :: EventTypeSize
sz_block_event :: Word16
sz_block_event = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
sz_event_type_num forall a. Num a => a -> a -> a
+ Word16
sz_time forall a. Num a => a -> a -> a
+ Word16
sz_block_size
    forall a. Num a => a -> a -> a
+ Word16
sz_time forall a. Num a => a -> a -> a
+ Word16
sz_cap)
sz_pid :: EventTypeSize
sz_pid :: Word16
sz_pid = Word16
4
sz_taskid :: EventTypeSize
sz_taskid :: Word16
sz_taskid = Word16
8
sz_kernel_tid :: EventTypeSize
sz_kernel_tid :: Word16
sz_kernel_tid = Word16
8
sz_th_stop_status :: EventTypeSize
sz_th_stop_status :: Word16
sz_th_stop_status = Word16
2
sz_string_id :: EventTypeSize
sz_string_id :: Word16
sz_string_id = Word16
4
sz_perf_num :: EventTypeSize
sz_perf_num :: Word16
sz_perf_num = Word16
4

-- Sizes for Parallel-RTS event fields
sz_procid, sz_mid, sz_mes, sz_realtime, sz_msgtag :: EventTypeSize
sz_procid :: Word16
sz_procid  = Word16
4
sz_mid :: Word16
sz_mid  = Word16
2
sz_mes :: Word16
sz_mes  = Word16
4
sz_realtime :: Word16
sz_realtime = Word16
8
sz_msgtag :: Word16
sz_msgtag  = Word16
1

-- Sizes for Mercury event fields.
sz_par_conj_dyn_id :: EventTypeSize
sz_par_conj_dyn_id :: Word16
sz_par_conj_dyn_id = Word16
8
sz_par_conj_static_id :: EventTypeSize
sz_par_conj_static_id :: Word16
sz_par_conj_static_id = Word16
sz_string_id
sz_spark_id :: EventTypeSize
sz_spark_id :: Word16
sz_spark_id = Word16
4
sz_future_id :: EventTypeSize
sz_future_id :: Word16
sz_future_id = Word16
8

{-
 - Data type delcarations to build the GHC RTS data format,
 - which is a (header, data) pair.
 -
 - Header contains EventTypes.
 - Data contains Events.
 -}
data EventLog =
  EventLog {
    EventLog -> Header
header :: Header,
    EventLog -> Data
dat    :: Data
  } deriving Int -> EventLog -> ShowS
[EventLog] -> ShowS
EventLog -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventLog] -> ShowS
$cshowList :: [EventLog] -> ShowS
show :: EventLog -> String
$cshow :: EventLog -> String
showsPrec :: Int -> EventLog -> ShowS
$cshowsPrec :: Int -> EventLog -> ShowS
Show

newtype Header = Header {
     Header -> [EventType]
eventTypes :: [EventType]
  } deriving (Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show, Header -> Header -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq)

data Data = Data {
     Data -> [Event]
events :: [Event]
  } deriving Int -> Data -> ShowS
[Data] -> ShowS
Data -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Data] -> ShowS
$cshowList :: [Data] -> ShowS
show :: Data -> String
$cshow :: Data -> String
showsPrec :: Int -> Data -> ShowS
$cshowsPrec :: Int -> Data -> ShowS
Show

data EventType =
  EventType {
    EventType -> Word16
num  :: EventTypeNum,
    EventType -> EventTypeDesc
desc :: EventTypeDesc,
    EventType -> Maybe Word16
size :: Maybe EventTypeSize -- ^ 'Nothing' indicates variable size
  } deriving (Int -> EventType -> ShowS
[EventType] -> ShowS
EventType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventType] -> ShowS
$cshowList :: [EventType] -> ShowS
show :: EventType -> String
$cshow :: EventType -> String
showsPrec :: Int -> EventType -> ShowS
$cshowsPrec :: Int -> EventType -> ShowS
Show, EventType -> EventType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventType -> EventType -> Bool
$c/= :: EventType -> EventType -> Bool
== :: EventType -> EventType -> Bool
$c== :: EventType -> EventType -> Bool
Eq)

data Event =
  Event {
    Event -> Word64
evTime  :: {-# UNPACK #-}!Timestamp,
    Event -> EventInfo
evSpec  :: EventInfo,
    Event -> Maybe Int
evCap :: Maybe Int
  } deriving Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show

{-# DEPRECATED time "The field is now called evTime" #-}
time :: Event -> Timestamp
time :: Event -> Word64
time = Event -> Word64
evTime

{-# DEPRECATED spec "The field is now called evSpec" #-}
spec :: Event -> EventInfo
spec :: Event -> EventInfo
spec = Event -> EventInfo
evSpec

data EventInfo

  -- pseudo events
  = EventBlock         { EventInfo -> Word64
end_time   :: Timestamp,
                         EventInfo -> Int
cap        :: Int,
                         EventInfo -> BlockSize
block_size :: BlockSize
                       }
  | UnknownEvent       { EventInfo -> Word16
ref  :: {-# UNPACK #-}!EventTypeNum }

  -- init and shutdown
  | Startup            { EventInfo -> Int
n_caps :: Int
                       }
  -- EVENT_SHUTDOWN is replaced by EVENT_CAP_DELETE and GHC 7.6+
  -- no longer generate the event; should be removed at some point
  | Shutdown           { }

  -- thread scheduling
  | CreateThread       { EventInfo -> BlockSize
thread :: {-# UNPACK #-}!ThreadId
                       }
  | RunThread          { thread :: {-# UNPACK #-}!ThreadId
                       }
  | StopThread         { thread :: {-# UNPACK #-}!ThreadId,
                         EventInfo -> ThreadStopStatus
status :: !ThreadStopStatus
                       }
  | ThreadRunnable     { thread :: {-# UNPACK #-}!ThreadId
                       }
  | MigrateThread      { thread :: {-# UNPACK #-}!ThreadId,
                         EventInfo -> Int
newCap :: {-# UNPACK #-}!Int
                       }
  | WakeupThread       { thread :: {-# UNPACK #-}!ThreadId,
                         EventInfo -> Int
otherCap :: {-# UNPACK #-}!Int
                       }
  | ThreadLabel        { thread :: {-# UNPACK #-}!ThreadId,
                         EventInfo -> EventTypeDesc
threadlabel :: !Text
                       }

  -- par sparks
  | CreateSparkThread  { EventInfo -> BlockSize
sparkThread :: {-# UNPACK #-}!ThreadId
                       }
  | SparkCounters      { EventInfo -> Word64
sparksCreated, EventInfo -> Word64
sparksDud, EventInfo -> Word64
sparksOverflowed,
                         EventInfo -> Word64
sparksConverted, EventInfo -> Word64
sparksFizzled, EventInfo -> Word64
sparksGCd,
                         EventInfo -> Word64
sparksRemaining :: {-# UNPACK #-} !Word64
                       }
  | SparkCreate        { }
  | SparkDud           { }
  | SparkOverflow      { }
  | SparkRun           { }
  | SparkSteal         { EventInfo -> Int
victimCap :: {-# UNPACK #-}!Int }
  | SparkFizzle        { }
  | SparkGC            { }

  -- tasks
  | TaskCreate         { EventInfo -> Word64
taskId :: TaskId,
                         cap :: {-# UNPACK #-}!Int,
                         EventInfo -> KernelThreadId
tid :: {-# UNPACK #-}!KernelThreadId
                       }
  | TaskMigrate        { taskId :: TaskId,
                         cap :: {-# UNPACK #-}!Int,
                         EventInfo -> Int
new_cap :: {-# UNPACK #-}!Int
                       }
  | TaskDelete         { taskId :: TaskId }

  -- garbage collection
  | RequestSeqGC       { }
  | RequestParGC       { }
  | StartGC            { }
  | GCWork             { }
  | GCIdle             { }
  | GCDone             { }
  | EndGC              { }
  | GlobalSyncGC       { }
  | GCStatsGHC         { EventInfo -> BlockSize
heapCapset   :: {-# UNPACK #-}!Capset
                       , EventInfo -> Int
gen          :: {-# UNPACK #-}!Int
                       , EventInfo -> Word64
copied       :: {-# UNPACK #-}!Word64
                       , EventInfo -> Word64
slop         :: {-# UNPACK #-}!Word64
                       , EventInfo -> Word64
frag         :: {-# UNPACK #-}!Word64
                       , EventInfo -> Int
parNThreads  :: {-# UNPACK #-}!Int
                       , EventInfo -> Word64
parMaxCopied :: {-# UNPACK #-}!Word64
                       , EventInfo -> Word64
parTotCopied :: {-# UNPACK #-}!Word64
                       , EventInfo -> Maybe Word64
parBalancedCopied :: !(Maybe Word64)
                       }
  | MemReturn          { heapCapset :: !Capset
                       , EventInfo -> BlockSize
current :: !Word32
                       , EventInfo -> BlockSize
needed :: !Word32
                       , EventInfo -> BlockSize
returned :: !Word32
                       }

  -- heap statistics
  | HeapAllocated      { heapCapset  :: {-# UNPACK #-}!Capset
                       , EventInfo -> Word64
allocBytes  :: {-# UNPACK #-}!Word64
                       }
  | HeapSize           { heapCapset  :: {-# UNPACK #-}!Capset
                       , EventInfo -> Word64
sizeBytes   :: {-# UNPACK #-}!Word64
                       }
  | BlocksSize         { heapCapset  :: {-# UNPACK #-}!Capset
                       , EventInfo -> Word64
blocksSize  :: {-# UNPACK #-}!Word64
                       }
  | HeapLive           { heapCapset  :: {-# UNPACK #-}!Capset
                       , EventInfo -> Word64
liveBytes   :: {-# UNPACK #-}!Word64
                       }
  | HeapInfoGHC        { heapCapset    :: {-# UNPACK #-}!Capset
                       , EventInfo -> Int
gens          :: {-# UNPACK #-}!Int
                       , EventInfo -> Word64
maxHeapSize   :: {-# UNPACK #-}!Word64
                       , EventInfo -> Word64
allocAreaSize :: {-# UNPACK #-}!Word64
                       , EventInfo -> Word64
mblockSize    :: {-# UNPACK #-}!Word64
                       , EventInfo -> Word64
blockSize     :: {-# UNPACK #-}!Word64
                       }

  -- adjusting the number of capabilities on the fly
  | CapCreate          { cap :: {-# UNPACK #-}!Int
                       }
  | CapDelete          { cap :: {-# UNPACK #-}!Int
                       }
  | CapDisable         { cap :: {-# UNPACK #-}!Int
                       }
  | CapEnable          { cap :: {-# UNPACK #-}!Int
                       }

  -- capability sets
  | CapsetCreate       { EventInfo -> BlockSize
capset     :: {-# UNPACK #-}!Capset
                       , EventInfo -> CapsetType
capsetType :: CapsetType
                       }
  | CapsetDelete       { capset :: {-# UNPACK #-}!Capset
                       }
  | CapsetAssignCap    { capset :: {-# UNPACK #-}!Capset
                       , cap    :: {-# UNPACK #-}!Int
                       }
  | CapsetRemoveCap    { capset :: {-# UNPACK #-}!Capset
                       , cap    :: {-# UNPACK #-}!Int
                       }

  -- program/process info
  | RtsIdentifier      { capset :: {-# UNPACK #-}!Capset
                       , EventInfo -> EventTypeDesc
rtsident :: !Text
                       }
  | ProgramArgs        { capset :: {-# UNPACK #-}!Capset
                       , EventInfo -> [EventTypeDesc]
args   :: [Text]
                       }
  | ProgramEnv         { capset :: {-# UNPACK #-}!Capset
                       , EventInfo -> [EventTypeDesc]
env    :: [Text]
                       }
  | OsProcessPid       { capset :: {-# UNPACK #-}!Capset
                       , EventInfo -> BlockSize
pid    :: {-# UNPACK #-}!PID
                       }
  | OsProcessParentPid { capset :: {-# UNPACK #-}!Capset
                       , EventInfo -> BlockSize
ppid   :: {-# UNPACK #-}!PID
                       }
  | WallClockTime      { capset :: {-# UNPACK #-}!Capset
                       , EventInfo -> Word64
sec    :: {-# UNPACK #-}!Word64
                       , EventInfo -> BlockSize
nsec   :: {-# UNPACK #-}!Word32
                       }

  -- messages
  | Message            { EventInfo -> EventTypeDesc
msg :: !Text }
  | UserMessage        { msg :: !Text }
  | UserMarker         { EventInfo -> EventTypeDesc
markername :: !Text }

  -- Events emitted by a parallel RTS
   -- Program /process info (tools might prefer newer variants above)
  | Version            { EventInfo -> String
version :: String }
  | ProgramInvocation  { EventInfo -> String
commandline :: String }
   -- startup and shutdown (incl. real start time, not first log entry)
  | CreateMachine      { EventInfo -> Word16
machine :: {-# UNPACK #-} !MachineId,
                         EventInfo -> Word64
realtime    :: {-# UNPACK #-} !Timestamp}
  | KillMachine        { machine ::  {-# UNPACK #-} !MachineId }
   -- Haskell processes mgmt (thread groups that share heap and communicate)
  | CreateProcess      { EventInfo -> BlockSize
process :: {-# UNPACK #-} !ProcessId }
  | KillProcess        { process :: {-# UNPACK #-} !ProcessId }
  | AssignThreadToProcess { thread :: {-# UNPACK #-} !ThreadId,
                            process :: {-# UNPACK #-} !ProcessId
                          }
   -- communication between processes
  | EdenStartReceive   { }
  | EdenEndReceive     { }
  | SendMessage        { EventInfo -> MessageTag
mesTag :: !MessageTag,
                         EventInfo -> BlockSize
senderProcess :: {-# UNPACK #-} !ProcessId,
                         EventInfo -> BlockSize
senderThread :: {-# UNPACK #-} !ThreadId,
                         EventInfo -> Word16
receiverMachine ::  {-# UNPACK #-} !MachineId,
                         EventInfo -> BlockSize
receiverProcess :: {-# UNPACK #-} !ProcessId,
                         EventInfo -> BlockSize
receiverInport :: {-# UNPACK #-} !PortId
                       }
  | ReceiveMessage     { mesTag :: !MessageTag,
                         receiverProcess :: {-# UNPACK #-} !ProcessId,
                         receiverInport :: {-# UNPACK #-} !PortId,
                         EventInfo -> Word16
senderMachine ::  {-# UNPACK #-} !MachineId,
                         senderProcess :: {-# UNPACK #-} !ProcessId,
                         senderThread :: {-# UNPACK #-} !ThreadId,
                         EventInfo -> BlockSize
messageSize :: {-# UNPACK #-} !MessageSize
                       }
  | SendReceiveLocalMessage { mesTag :: !MessageTag,
                              senderProcess :: {-# UNPACK #-} !ProcessId,
                              senderThread :: {-# UNPACK #-} !ThreadId,
                              receiverProcess :: {-# UNPACK #-} !ProcessId,
                              receiverInport :: {-# UNPACK #-} !PortId
                            }

  -- These events have been added for Mercury's benefit but are generally
  -- useful.
  | InternString       { EventInfo -> String
str :: String, EventInfo -> BlockSize
sId :: {-# UNPACK #-}!StringId }

  -- Mercury specific events.
  | MerStartParConjunction {
        EventInfo -> Word64
dyn_id      :: {-# UNPACK #-}!ParConjDynId,
        EventInfo -> BlockSize
static_id   :: {-# UNPACK #-}!ParConjStaticId
    }
  | MerEndParConjunction {
        dyn_id      :: {-# UNPACK #-}!ParConjDynId
    }
  | MerEndParConjunct {
        dyn_id      :: {-# UNPACK #-}!ParConjDynId
    }
  | MerCreateSpark {
        dyn_id      :: {-# UNPACK #-}!ParConjDynId,
        EventInfo -> BlockSize
spark_id    :: {-# UNPACK #-}!SparkId
    }
  | MerFutureCreate {
        EventInfo -> Word64
future_id   :: {-# UNPACK #-}!FutureId,
        EventInfo -> BlockSize
name_id     :: {-# UNPACK #-}!StringId
    }
  | MerFutureWaitNosuspend {
        future_id   :: {-# UNPACK #-}!FutureId
    }
  | MerFutureWaitSuspended {
        future_id   :: {-# UNPACK #-}!FutureId
    }
  | MerFutureSignal {
        future_id   :: {-# UNPACK #-}!FutureId
    }
  | MerLookingForGlobalThread
  | MerWorkStealing
  | MerLookingForLocalSpark
  | MerReleaseThread {
        EventInfo -> BlockSize
thread_id   :: {-# UNPACK #-}!ThreadId
    }
  | MerCapSleeping
  | MerCallingMain

  -- perf events
  | PerfName           { EventInfo -> BlockSize
perfNum :: {-# UNPACK #-}!PerfEventTypeNum
                       , EventInfo -> EventTypeDesc
name    :: !Text
                       }
  | PerfCounter        { perfNum :: {-# UNPACK #-}!PerfEventTypeNum
                       , tid     :: {-# UNPACK #-}!KernelThreadId
                       , EventInfo -> Word64
period  :: {-# UNPACK #-}!Word64
                       }
  | PerfTracepoint     { perfNum :: {-# UNPACK #-}!PerfEventTypeNum
                       , tid     :: {-# UNPACK #-}!KernelThreadId
                       }
  | HeapProfBegin      { EventInfo -> Word8
heapProfId :: !Word8
                       , EventInfo -> Word64
heapProfSamplingPeriod :: !Word64
                       , EventInfo -> HeapProfBreakdown
heapProfBreakdown :: !HeapProfBreakdown
                       , EventInfo -> EventTypeDesc
heapProfModuleFilter :: !Text
                       , EventInfo -> EventTypeDesc
heapProfClosureDescrFilter :: !Text
                       , EventInfo -> EventTypeDesc
heapProfTypeDescrFilter :: !Text
                       , EventInfo -> EventTypeDesc
heapProfCostCentreFilter :: !Text
                       , EventInfo -> EventTypeDesc
heapProfCostCentreStackFilter :: !Text
                       , EventInfo -> EventTypeDesc
heapProfRetainerFilter :: !Text
                       , EventInfo -> EventTypeDesc
heapProfBiographyFilter :: !Text
                       }
  | HeapProfCostCentre { EventInfo -> BlockSize
heapProfCostCentreId :: !Word32
                       , EventInfo -> EventTypeDesc
heapProfLabel :: !Text
                       , EventInfo -> EventTypeDesc
heapProfModule :: !Text
                       , EventInfo -> EventTypeDesc
heapProfSrcLoc :: !Text
                       , EventInfo -> HeapProfFlags
heapProfFlags :: !HeapProfFlags
                       }
  | InfoTableProv      { EventInfo -> Word64
itInfo :: !Word64
                       , EventInfo -> EventTypeDesc
itTableName :: !Text
                       , EventInfo -> Int
itClosureDesc :: !Int
                       , EventInfo -> EventTypeDesc
itTyDesc :: !Text
                       , EventInfo -> EventTypeDesc
itLabel :: !Text
                       , EventInfo -> EventTypeDesc
itModule :: !Text
                       , EventInfo -> EventTypeDesc
itSrcLoc :: !Text }
  | HeapProfSampleBegin
                       { EventInfo -> Word64
heapProfSampleEra :: !Word64
                       }
  | HeapProfSampleEnd
                       { heapProfSampleEra :: !Word64
                       }

  | HeapBioProfSampleBegin
                       { heapProfSampleEra :: !Word64
                       , EventInfo -> Word64
heapProfSampleTime :: !Word64
                       }
  | HeapProfSampleCostCentre
                       { heapProfId :: !Word8
                       , EventInfo -> Word64
heapProfResidency :: !Word64
                       , EventInfo -> Word8
heapProfStackDepth :: !Word8
                       , EventInfo -> Vector BlockSize
heapProfStack :: !(VU.Vector Word32)
                       }
  | HeapProfSampleString
                       { heapProfId :: !Word8
                       , heapProfResidency :: !Word64
                       , heapProfLabel :: !Text
                       }

  | ProfSampleCostCentre
                       { EventInfo -> BlockSize
profCapset :: !Capset
                       , EventInfo -> Word64
profTicks :: !Word64
                       , EventInfo -> Word8
profStackDepth :: !Word8
                       , EventInfo -> Vector BlockSize
profCcsStack :: !(VU.Vector Word32)
                       }
  | ProfBegin
                       { EventInfo -> Word64
profTickInterval :: !Word64
                       }

  | UserBinaryMessage  { EventInfo -> ByteString
payload :: !B.ByteString
                       }

  | ConcMarkBegin
  | ConcMarkEnd        { EventInfo -> BlockSize
concMarkedObjectCount :: !Word32
                       }
  | ConcSyncBegin
  | ConcSyncEnd
  | ConcSweepBegin
  | ConcSweepEnd
  | ConcUpdRemSetFlush { cap    :: {-# UNPACK #-}!Int
                       }
  | NonmovingHeapCensus
                       { EventInfo -> Word8
nonmovingCensusBlkSize :: !Word8
                       , EventInfo -> BlockSize
nonmovingCensusActiveSegs :: !Word32
                       , EventInfo -> BlockSize
nonmovingCensusFilledSegs :: !Word32
                       , EventInfo -> BlockSize
nonmovingCensusLiveBlocks :: !Word32
                       }
  | TickyCounterDef
                       { EventInfo -> Word64
tickyCtrDefId      :: !Word64
                       , EventInfo -> Word16
tickyCtrDefArity   :: !Word16
                       , EventInfo -> EventTypeDesc
tickyCtrDefKinds   :: !Text
                       , EventInfo -> EventTypeDesc
tickyCtrDefName    :: !Text
                       }
  | TickyCounterSample
                       { EventInfo -> Word64
tickyCtrSampleId         :: !Word64
                       , EventInfo -> Word64
tickyCtrSampleEntryCount :: !Word64
                       , EventInfo -> Word64
tickyCtrSampleAllocs     :: !Word64
                       , EventInfo -> Word64
tickyCtrSampleAllocd     :: !Word64
                       }
  | TickyBeginSample
  deriving Int -> EventInfo -> ShowS
[EventInfo] -> ShowS
EventInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventInfo] -> ShowS
$cshowList :: [EventInfo] -> ShowS
show :: EventInfo -> String
$cshow :: EventInfo -> String
showsPrec :: Int -> EventInfo -> ShowS
$cshowsPrec :: Int -> EventInfo -> ShowS
Show

{- [Note: Stop status in GHC-7.8.2]

In GHC-7.7, a new thread block reason "BlockedOnMVarRead" was
introduced, and placed adjacent to BlockedOnMVar (7). Therefore, event
logs produced by GHC pre-7.8.2 encode BlockedOnBlackHole and following
as 8..18, whereas GHC-7.8.2 event logs encode them as 9..19.
Later, the prior event numbering was restored for GHC-7.8.3.
See GHC bug #9003 for a discussion.

The parsers in Events.hs have to be adapted accordingly, providing
special ghc-7.8.2 parsers for the thread-stop event if GHC-7.8.2
produced the event log.
The EVENT_USER_MARKER was not present in GHC-7.6.3, and a new event
EVENT_HACK_BUG_T9003 was added in GHC-7.8.3, so we take presence of
USER_MARKER and absence of HACK_BUG_T9003 as an indication that
ghc-7.8.2 parsers should be used.
-}

--sync with ghc/includes/Constants.h
data ThreadStopStatus
 = NoStatus
 | HeapOverflow
 | StackOverflow
 | ThreadYielding
 | ThreadBlocked
 | ThreadFinished
 | ForeignCall
 | BlockedOnMVar
 | BlockedOnMVarRead   -- since GHC-7.8, see [Stop status since GHC-7.7]
 | BlockedOnBlackHole
 | BlockedOnRead
 | BlockedOnWrite
 | BlockedOnDelay
 | BlockedOnSTM
 | BlockedOnDoProc
 | BlockedOnCCall
 | BlockedOnCCall_NoUnblockExc
 | BlockedOnMsgThrowTo
 | ThreadMigrating
 | BlockedOnMsgGlobalise
 | BlockedOnBlackHoleOwnedBy {-# UNPACK #-}!ThreadId
 deriving (Int -> ThreadStopStatus -> ShowS
[ThreadStopStatus] -> ShowS
ThreadStopStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadStopStatus] -> ShowS
$cshowList :: [ThreadStopStatus] -> ShowS
show :: ThreadStopStatus -> String
$cshow :: ThreadStopStatus -> String
showsPrec :: Int -> ThreadStopStatus -> ShowS
$cshowsPrec :: Int -> ThreadStopStatus -> ShowS
Show)

-- normal GHC encoding, see [Stop status in GHC-7.8.2]
mkStopStatus :: RawThreadStopStatus -> ThreadStopStatus
mkStopStatus :: Word16 -> ThreadStopStatus
mkStopStatus Word16
n = case Word16
n of
 Word16
0  ->  ThreadStopStatus
NoStatus
 Word16
1  ->  ThreadStopStatus
HeapOverflow
 Word16
2  ->  ThreadStopStatus
StackOverflow
 Word16
3  ->  ThreadStopStatus
ThreadYielding
 Word16
4  ->  ThreadStopStatus
ThreadBlocked
 Word16
5  ->  ThreadStopStatus
ThreadFinished
 Word16
6  ->  ThreadStopStatus
ForeignCall
 Word16
7  ->  ThreadStopStatus
BlockedOnMVar
 Word16
8  ->  ThreadStopStatus
BlockedOnBlackHole
 Word16
9  ->  ThreadStopStatus
BlockedOnRead
 Word16
10 ->  ThreadStopStatus
BlockedOnWrite
 Word16
11 ->  ThreadStopStatus
BlockedOnDelay
 Word16
12 ->  ThreadStopStatus
BlockedOnSTM
 Word16
13 ->  ThreadStopStatus
BlockedOnDoProc
 Word16
14 ->  ThreadStopStatus
BlockedOnCCall
 Word16
15 ->  ThreadStopStatus
BlockedOnCCall_NoUnblockExc
 Word16
16 ->  ThreadStopStatus
BlockedOnMsgThrowTo
 Word16
17 ->  ThreadStopStatus
ThreadMigrating
 Word16
18 ->  ThreadStopStatus
BlockedOnMsgGlobalise
 Word16
19 ->  ThreadStopStatus
NoStatus -- yeuch... this one does not actually exist in GHC event logs
 Word16
20 ->  ThreadStopStatus
BlockedOnMVarRead -- since GHC-7.8.3
 Word16
_  ->  forall a. HasCallStack => String -> a
error String
"mkStat"

-- GHC 7.8.2 encoding, see [Stop status in GHC-7.8.2]
mkStopStatus782 :: RawThreadStopStatus -> ThreadStopStatus
mkStopStatus782 :: Word16 -> ThreadStopStatus
mkStopStatus782 Word16
n = case Word16
n of
 Word16
0  ->  ThreadStopStatus
NoStatus
 Word16
1  ->  ThreadStopStatus
HeapOverflow
 Word16
2  ->  ThreadStopStatus
StackOverflow
 Word16
3  ->  ThreadStopStatus
ThreadYielding
 Word16
4  ->  ThreadStopStatus
ThreadBlocked
 Word16
5  ->  ThreadStopStatus
ThreadFinished
 Word16
6  ->  ThreadStopStatus
ForeignCall
 Word16
7  ->  ThreadStopStatus
BlockedOnMVar
 Word16
8  ->  ThreadStopStatus
BlockedOnMVarRead -- in GHC-7.8.2
 Word16
9  ->  ThreadStopStatus
BlockedOnBlackHole
 Word16
10 ->  ThreadStopStatus
BlockedOnRead
 Word16
11 ->  ThreadStopStatus
BlockedOnWrite
 Word16
12 ->  ThreadStopStatus
BlockedOnDelay
 Word16
13 ->  ThreadStopStatus
BlockedOnSTM
 Word16
14 ->  ThreadStopStatus
BlockedOnDoProc
 Word16
15 ->  ThreadStopStatus
BlockedOnCCall
 Word16
16 ->  ThreadStopStatus
BlockedOnCCall_NoUnblockExc
 Word16
17 ->  ThreadStopStatus
BlockedOnMsgThrowTo
 Word16
18 ->  ThreadStopStatus
ThreadMigrating
 Word16
19 ->  ThreadStopStatus
BlockedOnMsgGlobalise
 Word16
_  ->  forall a. HasCallStack => String -> a
error String
"mkStat"

maxThreadStopStatusPre77, maxThreadStopStatus782, maxThreadStopStatus
    :: RawThreadStopStatus
maxThreadStopStatusPre77 :: Word16
maxThreadStopStatusPre77  = Word16
18 -- see [Stop status in GHC-7.8.2]
maxThreadStopStatus782 :: Word16
maxThreadStopStatus782    = Word16
19 -- need to distinguish three cases
maxThreadStopStatus :: Word16
maxThreadStopStatus = Word16
20

data CapsetType
 = CapsetCustom
 | CapsetOsProcess
 | CapsetClockDomain
 | CapsetUnknown
 deriving Int -> CapsetType -> ShowS
[CapsetType] -> ShowS
CapsetType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapsetType] -> ShowS
$cshowList :: [CapsetType] -> ShowS
show :: CapsetType -> String
$cshow :: CapsetType -> String
showsPrec :: Int -> CapsetType -> ShowS
$cshowsPrec :: Int -> CapsetType -> ShowS
Show

mkCapsetType :: Word16 -> CapsetType
mkCapsetType :: Word16 -> CapsetType
mkCapsetType Word16
n = case Word16
n of
 Word16
1 -> CapsetType
CapsetCustom
 Word16
2 -> CapsetType
CapsetOsProcess
 Word16
3 -> CapsetType
CapsetClockDomain
 Word16
_ -> CapsetType
CapsetUnknown

-- | An event annotated with the Capability that generated it, if any
{-# DEPRECATED CapEvent "CapEvents will be removed soon, now Event has a field evCap" #-}
data CapEvent
  = CapEvent { CapEvent -> Maybe Int
ce_cap   :: Maybe Int,
               CapEvent -> Event
ce_event :: Event
               -- we could UNPACK ce_event, but the Event constructor
               -- might be shared, in which case we could end up
               -- increasing the space usage.
             } deriving Int -> CapEvent -> ShowS
[CapEvent] -> ShowS
CapEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapEvent] -> ShowS
$cshowList :: [CapEvent] -> ShowS
show :: CapEvent -> String
$cshow :: CapEvent -> String
showsPrec :: Int -> CapEvent -> ShowS
$cshowsPrec :: Int -> CapEvent -> ShowS
Show

--sync with ghc/parallel/PEOpCodes.h
data MessageTag
  = Ready | NewPE | PETIDS | Finish
  | FailPE | RFork | Connect | DataMes
  | Head | Constr | Part | Terminate
  | Packet
  -- with GUM and its variants, add:
  -- ...| Fetch | Resume | Ack
  -- ...| Fish | Schedule | Free | Reval | Shark
  deriving (Int -> MessageTag
MessageTag -> Int
MessageTag -> [MessageTag]
MessageTag -> MessageTag
MessageTag -> MessageTag -> [MessageTag]
MessageTag -> MessageTag -> MessageTag -> [MessageTag]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MessageTag -> MessageTag -> MessageTag -> [MessageTag]
$cenumFromThenTo :: MessageTag -> MessageTag -> MessageTag -> [MessageTag]
enumFromTo :: MessageTag -> MessageTag -> [MessageTag]
$cenumFromTo :: MessageTag -> MessageTag -> [MessageTag]
enumFromThen :: MessageTag -> MessageTag -> [MessageTag]
$cenumFromThen :: MessageTag -> MessageTag -> [MessageTag]
enumFrom :: MessageTag -> [MessageTag]
$cenumFrom :: MessageTag -> [MessageTag]
fromEnum :: MessageTag -> Int
$cfromEnum :: MessageTag -> Int
toEnum :: Int -> MessageTag
$ctoEnum :: Int -> MessageTag
pred :: MessageTag -> MessageTag
$cpred :: MessageTag -> MessageTag
succ :: MessageTag -> MessageTag
$csucc :: MessageTag -> MessageTag
Enum, Int -> MessageTag -> ShowS
[MessageTag] -> ShowS
MessageTag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageTag] -> ShowS
$cshowList :: [MessageTag] -> ShowS
show :: MessageTag -> String
$cshow :: MessageTag -> String
showsPrec :: Int -> MessageTag -> ShowS
$cshowsPrec :: Int -> MessageTag -> ShowS
Show)
offset :: RawMsgTag
offset :: Word8
offset = Word8
0x50

-- decoder and encoder
toMsgTag :: RawMsgTag -> MessageTag
toMsgTag :: Word8 -> MessageTag
toMsgTag = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Word8
n -> Word8
n forall a. Num a => a -> a -> a
- Word8
offset)

fromMsgTag :: MessageTag -> RawMsgTag
fromMsgTag :: MessageTag -> Word8
fromMsgTag = (forall a. Num a => a -> a -> a
+ Word8
offset) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

-- | Sample break-down types in heap profiling
data HeapProfBreakdown
  = HeapProfBreakdownCostCentre
  | HeapProfBreakdownModule
  | HeapProfBreakdownClosureDescr
  | HeapProfBreakdownTypeDescr
  | HeapProfBreakdownRetainer
  | HeapProfBreakdownBiography
  | HeapProfBreakdownClosureType
  | HeapProfBreakdownInfoTable
  deriving Int -> HeapProfBreakdown -> ShowS
[HeapProfBreakdown] -> ShowS
HeapProfBreakdown -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfBreakdown] -> ShowS
$cshowList :: [HeapProfBreakdown] -> ShowS
show :: HeapProfBreakdown -> String
$cshow :: HeapProfBreakdown -> String
showsPrec :: Int -> HeapProfBreakdown -> ShowS
$cshowsPrec :: Int -> HeapProfBreakdown -> ShowS
Show

instance Binary HeapProfBreakdown where
  get :: Get HeapProfBreakdown
get = do
    BlockSize
n <- forall t. Binary t => Get t
get :: Get Word32
    case BlockSize
n of
      BlockSize
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return HeapProfBreakdown
HeapProfBreakdownCostCentre
      BlockSize
2 -> forall (m :: * -> *) a. Monad m => a -> m a
return HeapProfBreakdown
HeapProfBreakdownModule
      BlockSize
3 -> forall (m :: * -> *) a. Monad m => a -> m a
return HeapProfBreakdown
HeapProfBreakdownClosureDescr
      BlockSize
4 -> forall (m :: * -> *) a. Monad m => a -> m a
return HeapProfBreakdown
HeapProfBreakdownTypeDescr
      BlockSize
5 -> forall (m :: * -> *) a. Monad m => a -> m a
return HeapProfBreakdown
HeapProfBreakdownRetainer
      BlockSize
6 -> forall (m :: * -> *) a. Monad m => a -> m a
return HeapProfBreakdown
HeapProfBreakdownBiography
      BlockSize
7 -> forall (m :: * -> *) a. Monad m => a -> m a
return HeapProfBreakdown
HeapProfBreakdownClosureType
      BlockSize
8 -> forall (m :: * -> *) a. Monad m => a -> m a
return HeapProfBreakdown
HeapProfBreakdownInfoTable
      BlockSize
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown HeapProfBreakdown: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BlockSize
n
  put :: HeapProfBreakdown -> Put
put HeapProfBreakdown
breakdown = forall t. Binary t => t -> Put
put forall a b. (a -> b) -> a -> b
$ case HeapProfBreakdown
breakdown of
    HeapProfBreakdown
HeapProfBreakdownCostCentre -> (BlockSize
1 :: Word32)
    HeapProfBreakdown
HeapProfBreakdownModule -> BlockSize
2
    HeapProfBreakdown
HeapProfBreakdownClosureDescr -> BlockSize
3
    HeapProfBreakdown
HeapProfBreakdownTypeDescr -> BlockSize
4
    HeapProfBreakdown
HeapProfBreakdownRetainer -> BlockSize
5
    HeapProfBreakdown
HeapProfBreakdownBiography -> BlockSize
6
    HeapProfBreakdown
HeapProfBreakdownClosureType -> BlockSize
7
    HeapProfBreakdown
HeapProfBreakdownInfoTable -> BlockSize
8

newtype HeapProfFlags = HeapProfFlags Word8
  deriving (Int -> HeapProfFlags -> ShowS
[HeapProfFlags] -> ShowS
HeapProfFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfFlags] -> ShowS
$cshowList :: [HeapProfFlags] -> ShowS
show :: HeapProfFlags -> String
$cshow :: HeapProfFlags -> String
showsPrec :: Int -> HeapProfFlags -> ShowS
$cshowsPrec :: Int -> HeapProfFlags -> ShowS
Show, Get HeapProfFlags
[HeapProfFlags] -> Put
HeapProfFlags -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [HeapProfFlags] -> Put
$cputList :: [HeapProfFlags] -> Put
get :: Get HeapProfFlags
$cget :: Get HeapProfFlags
put :: HeapProfFlags -> Put
$cput :: HeapProfFlags -> Put
Binary)

isCaf :: HeapProfFlags -> Bool
isCaf :: HeapProfFlags -> Bool
isCaf (HeapProfFlags Word8
w8) = forall a. Bits a => a -> Int -> Bool
testBit Word8
w8 Int
0

-- Checks if the capability is not -1 (which indicates a global eventblock), so
-- has no associated capability
mkCap :: Int -> Maybe Int
mkCap :: Int -> Maybe Int
mkCap Int
cap = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cap forall a. Eq a => a -> a -> Bool
/= (forall a. Bounded a => a
maxBound :: Word16)
  forall (m :: * -> *) a. Monad m => a -> m a
return Int
cap