module GHC.RTS.EventTypes where
import Control.Monad
import Data.Bits
import Data.Binary
import Data.Text (Text)
import qualified Data.Vector.Unboxed as VU
type EventTypeNum = Word16
type EventTypeDescLen = Word32
type EventTypeDesc = String
type EventTypeSize = Word16
type EventDescription = String
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 }
deriving (Eq, Ord, Show)
instance Binary KernelThreadId where
put (KernelThreadId tid) = put tid
get = fmap KernelThreadId get
type ProcessId = Word32
type MachineId = Word16
type PortId = ThreadId
type MessageSize = Word32
type RawMsgTag = Word8
type ParConjDynId = Word64
type ParConjStaticId = StringId
type SparkId = Word32
type FutureId = Word64
sz_event_type_num :: EventTypeSize
sz_event_type_num = 2
sz_cap :: EventTypeSize
sz_cap = 2
sz_time :: EventTypeSize
sz_time = 8
sz_tid :: EventTypeSize
sz_tid = 4
sz_old_tid :: EventTypeSize
sz_old_tid = 8
sz_capset :: EventTypeSize
sz_capset = 4
sz_capset_type :: EventTypeSize
sz_capset_type = 2
sz_block_size :: EventTypeSize
sz_block_size = 4
sz_block_event :: EventTypeSize
sz_block_event = fromIntegral (sz_event_type_num + sz_time + sz_block_size
+ sz_time + sz_cap)
sz_pid :: EventTypeSize
sz_pid = 4
sz_taskid :: EventTypeSize
sz_taskid = 8
sz_kernel_tid :: EventTypeSize
sz_kernel_tid = 8
sz_th_stop_status :: EventTypeSize
sz_th_stop_status = 2
sz_string_id :: EventTypeSize
sz_string_id = 4
sz_perf_num :: EventTypeSize
sz_perf_num = 4
sz_procid, sz_mid, sz_mes, sz_realtime, sz_msgtag :: EventTypeSize
sz_procid = 4
sz_mid = 2
sz_mes = 4
sz_realtime = 8
sz_msgtag = 1
sz_par_conj_dyn_id :: EventTypeSize
sz_par_conj_dyn_id = 8
sz_par_conj_static_id :: EventTypeSize
sz_par_conj_static_id = sz_string_id
sz_spark_id :: EventTypeSize
sz_spark_id = 4
sz_future_id :: EventTypeSize
sz_future_id = 8
data EventLog =
EventLog {
header :: Header,
dat :: Data
} deriving Show
newtype Header = Header {
eventTypes :: [EventType]
} deriving (Show, Eq)
data Data = Data {
events :: [Event]
} deriving Show
data EventType =
EventType {
num :: EventTypeNum,
desc :: EventTypeDesc,
size :: Maybe EventTypeSize
} deriving (Show, Eq)
data Event =
Event {
evTime :: !Timestamp,
evSpec :: EventInfo,
evCap :: Maybe Int
} deriving Show
time :: Event -> Timestamp
time = evTime
spec :: Event -> EventInfo
spec = evSpec
data EventInfo
= EventBlock { end_time :: Timestamp,
cap :: Int,
block_size :: BlockSize
}
| UnknownEvent { ref :: !EventTypeNum }
| Startup { n_caps :: Int
}
| Shutdown { }
| CreateThread { thread :: !ThreadId
}
| RunThread { thread :: !ThreadId
}
| StopThread { thread :: !ThreadId,
status :: !ThreadStopStatus
}
| ThreadRunnable { thread :: !ThreadId
}
| MigrateThread { thread :: !ThreadId,
newCap :: !Int
}
| WakeupThread { thread :: !ThreadId,
otherCap :: !Int
}
| ThreadLabel { thread :: !ThreadId,
threadlabel :: String
}
| CreateSparkThread { sparkThread :: !ThreadId
}
| SparkCounters { sparksCreated, sparksDud, sparksOverflowed,
sparksConverted, sparksFizzled, sparksGCd,
sparksRemaining :: ! Word64
}
| SparkCreate { }
| SparkDud { }
| SparkOverflow { }
| SparkRun { }
| SparkSteal { victimCap :: !Int }
| SparkFizzle { }
| SparkGC { }
| TaskCreate { taskId :: TaskId,
cap :: !Int,
tid :: !KernelThreadId
}
| TaskMigrate { taskId :: TaskId,
cap :: !Int,
new_cap :: !Int
}
| TaskDelete { taskId :: TaskId }
| RequestSeqGC { }
| RequestParGC { }
| StartGC { }
| GCWork { }
| GCIdle { }
| GCDone { }
| EndGC { }
| GlobalSyncGC { }
| GCStatsGHC { heapCapset :: !Capset
, gen :: !Int
, copied :: !Word64
, slop, frag :: !Word64
, parNThreads :: !Int
, parMaxCopied :: !Word64
, parTotCopied :: !Word64
}
| HeapAllocated { heapCapset :: !Capset
, allocBytes :: !Word64
}
| HeapSize { heapCapset :: !Capset
, sizeBytes :: !Word64
}
| HeapLive { heapCapset :: !Capset
, liveBytes :: !Word64
}
| HeapInfoGHC { heapCapset :: !Capset
, gens :: !Int
, maxHeapSize :: !Word64
, allocAreaSize :: !Word64
, mblockSize :: !Word64
, blockSize :: !Word64
}
| CapCreate { cap :: !Int
}
| CapDelete { cap :: !Int
}
| CapDisable { cap :: !Int
}
| CapEnable { cap :: !Int
}
| CapsetCreate { capset :: !Capset
, capsetType :: CapsetType
}
| CapsetDelete { capset :: !Capset
}
| CapsetAssignCap { capset :: !Capset
, cap :: !Int
}
| CapsetRemoveCap { capset :: !Capset
, cap :: !Int
}
| RtsIdentifier { capset :: !Capset
, rtsident :: String
}
| ProgramArgs { capset :: !Capset
, args :: [String]
}
| ProgramEnv { capset :: !Capset
, env :: [String]
}
| OsProcessPid { capset :: !Capset
, pid :: !PID
}
| OsProcessParentPid { capset :: !Capset
, ppid :: !PID
}
| WallClockTime { capset :: !Capset
, sec :: !Word64
, nsec :: !Word32
}
| Message { msg :: String }
| UserMessage { msg :: String }
| UserMarker { markername :: String }
| Version { version :: String }
| ProgramInvocation { commandline :: String }
| CreateMachine { machine :: !MachineId,
realtime :: !Timestamp}
| KillMachine { machine :: !MachineId }
| CreateProcess { process :: !ProcessId }
| KillProcess { process :: !ProcessId }
| AssignThreadToProcess { thread :: !ThreadId,
process :: !ProcessId
}
| EdenStartReceive { }
| EdenEndReceive { }
| SendMessage { mesTag :: !MessageTag,
senderProcess :: !ProcessId,
senderThread :: !ThreadId,
receiverMachine :: !MachineId,
receiverProcess :: !ProcessId,
receiverInport :: !PortId
}
| ReceiveMessage { mesTag :: !MessageTag,
receiverProcess :: !ProcessId,
receiverInport :: !PortId,
senderMachine :: !MachineId,
senderProcess :: !ProcessId,
senderThread :: !ThreadId,
messageSize :: !MessageSize
}
| SendReceiveLocalMessage { mesTag :: !MessageTag,
senderProcess :: !ProcessId,
senderThread :: !ThreadId,
receiverProcess :: !ProcessId,
receiverInport :: !PortId
}
| InternString { str :: String, sId :: !StringId }
| MerStartParConjunction {
dyn_id :: !ParConjDynId,
static_id :: !ParConjStaticId
}
| MerEndParConjunction {
dyn_id :: !ParConjDynId
}
| MerEndParConjunct {
dyn_id :: !ParConjDynId
}
| MerCreateSpark {
dyn_id :: !ParConjDynId,
spark_id :: !SparkId
}
| MerFutureCreate {
future_id :: !FutureId,
name_id :: !StringId
}
| MerFutureWaitNosuspend {
future_id :: !FutureId
}
| MerFutureWaitSuspended {
future_id :: !FutureId
}
| MerFutureSignal {
future_id :: !FutureId
}
| MerLookingForGlobalThread
| MerWorkStealing
| MerLookingForLocalSpark
| MerReleaseThread {
thread_id :: !ThreadId
}
| MerCapSleeping
| MerCallingMain
| PerfName { perfNum :: !PerfEventTypeNum
, name :: String
}
| PerfCounter { perfNum :: !PerfEventTypeNum
, tid :: !KernelThreadId
, period :: !Word64
}
| PerfTracepoint { perfNum :: !PerfEventTypeNum
, tid :: !KernelThreadId
}
| HeapProfBegin { heapProfId :: !Word8
, heapProfSamplingPeriod :: !Word64
, heapProfBreakdown :: !HeapProfBreakdown
, heapProfModuleFilter :: !Text
, heapProfClosureDescrFilter :: !Text
, heapProfTypeDescrFilter :: !Text
, heapProfCostCentreFilter :: !Text
, heapProfCostCentreStackFilter :: !Text
, heapProfRetainerFilter :: !Text
, heapProfBiographyFilter :: !Text
}
| HeapProfCostCentre { heapProfCostCentreId :: !Word32
, heapProfLabel :: !Text
, heapProfModule :: !Text
, heapProfSrcLoc :: !Text
, heapProfFlags :: !HeapProfFlags
}
| HeapProfSampleBegin
{ heapProfSampleEra :: !Word64
}
| HeapProfSampleCostCentre
{ heapProfId :: !Word8
, heapProfResidency :: !Word64
, heapProfStackDepth :: !Word8
, heapProfStack :: !(VU.Vector Word32)
}
| HeapProfSampleString
{ heapProfId :: !Word8
, heapProfResidency :: !Word64
, heapProfLabel :: !Text
}
deriving Show
data ThreadStopStatus
= NoStatus
| HeapOverflow
| StackOverflow
| ThreadYielding
| ThreadBlocked
| ThreadFinished
| ForeignCall
| BlockedOnMVar
| BlockedOnMVarRead
| BlockedOnBlackHole
| BlockedOnRead
| BlockedOnWrite
| BlockedOnDelay
| BlockedOnSTM
| BlockedOnDoProc
| BlockedOnCCall
| BlockedOnCCall_NoUnblockExc
| BlockedOnMsgThrowTo
| ThreadMigrating
| BlockedOnMsgGlobalise
| BlockedOnBlackHoleOwnedBy !ThreadId
deriving (Show)
mkStopStatus :: RawThreadStopStatus -> ThreadStopStatus
mkStopStatus n = case n of
0 -> NoStatus
1 -> HeapOverflow
2 -> StackOverflow
3 -> ThreadYielding
4 -> ThreadBlocked
5 -> ThreadFinished
6 -> ForeignCall
7 -> BlockedOnMVar
8 -> BlockedOnBlackHole
9 -> BlockedOnRead
10 -> BlockedOnWrite
11 -> BlockedOnDelay
12 -> BlockedOnSTM
13 -> BlockedOnDoProc
14 -> BlockedOnCCall
15 -> BlockedOnCCall_NoUnblockExc
16 -> BlockedOnMsgThrowTo
17 -> ThreadMigrating
18 -> BlockedOnMsgGlobalise
19 -> NoStatus
20 -> BlockedOnMVarRead
_ -> error "mkStat"
mkStopStatus782 :: RawThreadStopStatus -> ThreadStopStatus
mkStopStatus782 n = case n of
0 -> NoStatus
1 -> HeapOverflow
2 -> StackOverflow
3 -> ThreadYielding
4 -> ThreadBlocked
5 -> ThreadFinished
6 -> ForeignCall
7 -> BlockedOnMVar
8 -> BlockedOnMVarRead
9 -> BlockedOnBlackHole
10 -> BlockedOnRead
11 -> BlockedOnWrite
12 -> BlockedOnDelay
13 -> BlockedOnSTM
14 -> BlockedOnDoProc
15 -> BlockedOnCCall
16 -> BlockedOnCCall_NoUnblockExc
17 -> BlockedOnMsgThrowTo
18 -> ThreadMigrating
19 -> BlockedOnMsgGlobalise
_ -> error "mkStat"
maxThreadStopStatusPre77, maxThreadStopStatus782, maxThreadStopStatus
:: RawThreadStopStatus
maxThreadStopStatusPre77 = 18
maxThreadStopStatus782 = 19
maxThreadStopStatus = 20
data CapsetType
= CapsetCustom
| CapsetOsProcess
| CapsetClockDomain
| CapsetUnknown
deriving Show
mkCapsetType :: Word16 -> CapsetType
mkCapsetType n = case n of
1 -> CapsetCustom
2 -> CapsetOsProcess
3 -> CapsetClockDomain
_ -> CapsetUnknown
data CapEvent
= CapEvent { ce_cap :: Maybe Int,
ce_event :: Event
} deriving Show
data MessageTag
= Ready | NewPE | PETIDS | Finish
| FailPE | RFork | Connect | DataMes
| Head | Constr | Part | Terminate
| Packet
deriving (Enum, Show)
offset :: RawMsgTag
offset = 0x50
toMsgTag :: RawMsgTag -> MessageTag
toMsgTag = toEnum . fromIntegral . (\n -> n offset)
fromMsgTag :: MessageTag -> RawMsgTag
fromMsgTag = (+ offset) . fromIntegral . fromEnum
data HeapProfBreakdown
= HeapProfBreakdownCostCentre
| HeapProfBreakdownModule
| HeapProfBreakdownClosureDescr
| HeapProfBreakdownTypeDescr
| HeapProfBreakdownRetainer
| HeapProfBreakdownBiography
deriving Show
instance Binary HeapProfBreakdown where
get = do
n <- get :: Get Word32
case n of
1 -> return HeapProfBreakdownCostCentre
2 -> return HeapProfBreakdownModule
3 -> return HeapProfBreakdownClosureDescr
4 -> return HeapProfBreakdownTypeDescr
5 -> return HeapProfBreakdownRetainer
6 -> return HeapProfBreakdownBiography
_ -> fail $ "Unknown HeapProfBreakdown: " ++ show n
put breakdown = put $ case breakdown of
HeapProfBreakdownCostCentre -> (1 :: Word32)
HeapProfBreakdownModule -> 2
HeapProfBreakdownClosureDescr -> 3
HeapProfBreakdownTypeDescr -> 4
HeapProfBreakdownRetainer -> 5
HeapProfBreakdownBiography -> 6
newtype HeapProfFlags = HeapProfFlags Word8
deriving (Show, Binary)
isCaf :: HeapProfFlags -> Bool
isCaf (HeapProfFlags w8) = testBit w8 0
mkCap :: Int -> Maybe Int
mkCap cap = do
guard $ fromIntegral cap /= (maxBound :: Word16)
return cap