1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2module GHC.RTS.EventTypes where
3import Control.Monad
4import Data.Bits
5
6import Data.Binary
7import Data.Text (Text)
8import qualified Data.ByteString as B
9import qualified Data.Vector.Unboxed as VU
10
11-- EventType.
12type EventTypeNum = Word16
13type EventTypeDescLen = Word32
14type EventTypeDesc = Text
15type EventTypeSize = Word16
16-- Event.
17type Timestamp = Word64
18type ThreadId = Word32
19type CapNo = Word16
20type Marker = Word32
21type BlockSize = Word32
22type RawThreadStopStatus = Word16
23type StringId = Word32
24type Capset   = Word32
25type PerfEventTypeNum = Word32
26type TaskId = Word64
27type PID = Word32
28
29newtype KernelThreadId = KernelThreadId { kernelThreadId :: Word64 }
30  deriving (Eq, Ord, Show)
31instance Binary KernelThreadId where
32  put (KernelThreadId tid) = put tid
33  get = fmap KernelThreadId get
34
35-- Types for Parallel-RTS Extension
36type ProcessId = Word32
37type MachineId = Word16
38type PortId = ThreadId
39type MessageSize = Word32
40type RawMsgTag = Word8
41
42-- These types are used by Mercury events.
43type ParConjDynId = Word64
44type ParConjStaticId = StringId
45type SparkId = Word32
46type FutureId = Word64
47
48sz_event_type_num :: EventTypeSize
49sz_event_type_num = 2
50sz_cap :: EventTypeSize
51sz_cap  = 2
52sz_time :: EventTypeSize
53sz_time = 8
54sz_tid :: EventTypeSize
55sz_tid  = 4
56sz_old_tid :: EventTypeSize
57sz_old_tid  = 8 -- GHC 6.12 was using 8 for ThreadID when declaring the size
58                -- of events, but was actually using 32 bits for ThreadIDs
59sz_capset :: EventTypeSize
60sz_capset = 4
61sz_capset_type :: EventTypeSize
62sz_capset_type = 2
63sz_block_size :: EventTypeSize
64sz_block_size = 4
65sz_block_event :: EventTypeSize
66sz_block_event = fromIntegral (sz_event_type_num + sz_time + sz_block_size
67    + sz_time + sz_cap)
68sz_pid :: EventTypeSize
69sz_pid = 4
70sz_taskid :: EventTypeSize
71sz_taskid = 8
72sz_kernel_tid :: EventTypeSize
73sz_kernel_tid = 8
74sz_th_stop_status :: EventTypeSize
75sz_th_stop_status = 2
76sz_string_id :: EventTypeSize
77sz_string_id = 4
78sz_perf_num :: EventTypeSize
79sz_perf_num = 4
80
81-- Sizes for Parallel-RTS event fields
82sz_procid, sz_mid, sz_mes, sz_realtime, sz_msgtag :: EventTypeSize
83sz_procid  = 4
84sz_mid  = 2
85sz_mes  = 4
86sz_realtime = 8
87sz_msgtag  = 1
88
89-- Sizes for Mercury event fields.
90sz_par_conj_dyn_id :: EventTypeSize
91sz_par_conj_dyn_id = 8
92sz_par_conj_static_id :: EventTypeSize
93sz_par_conj_static_id = sz_string_id
94sz_spark_id :: EventTypeSize
95sz_spark_id = 4
96sz_future_id :: EventTypeSize
97sz_future_id = 8
98
99{-
100 - Data type delcarations to build the GHC RTS data format,
101 - which is a (header, data) pair.
102 -
103 - Header contains EventTypes.
104 - Data contains Events.
105 -}
106data EventLog =
107  EventLog {
108    header :: Header,
109    dat    :: Data
110  } deriving Show
111
112newtype Header = Header {
113     eventTypes :: [EventType]
114  } deriving (Show, Eq)
115
116data Data = Data {
117     events :: [Event]
118  } deriving Show
119
120data EventType =
121  EventType {
122    num  :: EventTypeNum,
123    desc :: EventTypeDesc,
124    size :: Maybe EventTypeSize -- ^ 'Nothing' indicates variable size
125  } deriving (Show, Eq)
126
127data Event =
128  Event {
129    evTime  :: {-# UNPACK #-}!Timestamp,
130    evSpec  :: EventInfo,
131    evCap :: Maybe Int
132  } deriving Show
133
134{-# DEPRECATED time "The field is now called evTime" #-}
135time :: Event -> Timestamp
136time = evTime
137
138{-# DEPRECATED spec "The field is now called evSpec" #-}
139spec :: Event -> EventInfo
140spec = evSpec
141
142data EventInfo
143
144  -- pseudo events
145  = EventBlock         { end_time   :: Timestamp,
146                         cap        :: Int,
147                         block_size :: BlockSize
148                       }
149  | UnknownEvent       { ref  :: {-# UNPACK #-}!EventTypeNum }
150
151  -- init and shutdown
152  | Startup            { n_caps :: Int
153                       }
154  -- EVENT_SHUTDOWN is replaced by EVENT_CAP_DELETE and GHC 7.6+
155  -- no longer generate the event; should be removed at some point
156  | Shutdown           { }
157
158  -- thread scheduling
159  | CreateThread       { thread :: {-# UNPACK #-}!ThreadId
160                       }
161  | RunThread          { thread :: {-# UNPACK #-}!ThreadId
162                       }
163  | StopThread         { thread :: {-# UNPACK #-}!ThreadId,
164                         status :: !ThreadStopStatus
165                       }
166  | ThreadRunnable     { thread :: {-# UNPACK #-}!ThreadId
167                       }
168  | MigrateThread      { thread :: {-# UNPACK #-}!ThreadId,
169                         newCap :: {-# UNPACK #-}!Int
170                       }
171  | WakeupThread       { thread :: {-# UNPACK #-}!ThreadId,
172                         otherCap :: {-# UNPACK #-}!Int
173                       }
174  | ThreadLabel        { thread :: {-# UNPACK #-}!ThreadId,
175                         threadlabel :: !Text
176                       }
177
178  -- par sparks
179  | CreateSparkThread  { sparkThread :: {-# UNPACK #-}!ThreadId
180                       }
181  | SparkCounters      { sparksCreated, sparksDud, sparksOverflowed,
182                         sparksConverted, sparksFizzled, sparksGCd,
183                         sparksRemaining :: {-# UNPACK #-} !Word64
184                       }
185  | SparkCreate        { }
186  | SparkDud           { }
187  | SparkOverflow      { }
188  | SparkRun           { }
189  | SparkSteal         { victimCap :: {-# UNPACK #-}!Int }
190  | SparkFizzle        { }
191  | SparkGC            { }
192
193  -- tasks
194  | TaskCreate         { taskId :: TaskId,
195                         cap :: {-# UNPACK #-}!Int,
196                         tid :: {-# UNPACK #-}!KernelThreadId
197                       }
198  | TaskMigrate        { taskId :: TaskId,
199                         cap :: {-# UNPACK #-}!Int,
200                         new_cap :: {-# UNPACK #-}!Int
201                       }
202  | TaskDelete         { taskId :: TaskId }
203
204  -- garbage collection
205  | RequestSeqGC       { }
206  | RequestParGC       { }
207  | StartGC            { }
208  | GCWork             { }
209  | GCIdle             { }
210  | GCDone             { }
211  | EndGC              { }
212  | GlobalSyncGC       { }
213  | GCStatsGHC         { heapCapset   :: {-# UNPACK #-}!Capset
214                       , gen          :: {-# UNPACK #-}!Int
215                       , copied       :: {-# UNPACK #-}!Word64
216                       , slop         :: {-# UNPACK #-}!Word64
217                       , frag         :: {-# UNPACK #-}!Word64
218                       , parNThreads  :: {-# UNPACK #-}!Int
219                       , parMaxCopied :: {-# UNPACK #-}!Word64
220                       , parTotCopied :: {-# UNPACK #-}!Word64
221                       , parBalancedCopied :: !(Maybe Word64)
222                       }
223
224  -- heap statistics
225  | HeapAllocated      { heapCapset  :: {-# UNPACK #-}!Capset
226                       , allocBytes  :: {-# UNPACK #-}!Word64
227                       }
228  | HeapSize           { heapCapset  :: {-# UNPACK #-}!Capset
229                       , sizeBytes   :: {-# UNPACK #-}!Word64
230                       }
231  | HeapLive           { heapCapset  :: {-# UNPACK #-}!Capset
232                       , liveBytes   :: {-# UNPACK #-}!Word64
233                       }
234  | HeapInfoGHC        { heapCapset    :: {-# UNPACK #-}!Capset
235                       , gens          :: {-# UNPACK #-}!Int
236                       , maxHeapSize   :: {-# UNPACK #-}!Word64
237                       , allocAreaSize :: {-# UNPACK #-}!Word64
238                       , mblockSize    :: {-# UNPACK #-}!Word64
239                       , blockSize     :: {-# UNPACK #-}!Word64
240                       }
241
242  -- adjusting the number of capabilities on the fly
243  | CapCreate          { cap :: {-# UNPACK #-}!Int
244                       }
245  | CapDelete          { cap :: {-# UNPACK #-}!Int
246                       }
247  | CapDisable         { cap :: {-# UNPACK #-}!Int
248                       }
249  | CapEnable          { cap :: {-# UNPACK #-}!Int
250                       }
251
252  -- capability sets
253  | CapsetCreate       { capset     :: {-# UNPACK #-}!Capset
254                       , capsetType :: CapsetType
255                       }
256  | CapsetDelete       { capset :: {-# UNPACK #-}!Capset
257                       }
258  | CapsetAssignCap    { capset :: {-# UNPACK #-}!Capset
259                       , cap    :: {-# UNPACK #-}!Int
260                       }
261  | CapsetRemoveCap    { capset :: {-# UNPACK #-}!Capset
262                       , cap    :: {-# UNPACK #-}!Int
263                       }
264
265  -- program/process info
266  | RtsIdentifier      { capset :: {-# UNPACK #-}!Capset
267                       , rtsident :: !Text
268                       }
269  | ProgramArgs        { capset :: {-# UNPACK #-}!Capset
270                       , args   :: [Text]
271                       }
272  | ProgramEnv         { capset :: {-# UNPACK #-}!Capset
273                       , env    :: [Text]
274                       }
275  | OsProcessPid       { capset :: {-# UNPACK #-}!Capset
276                       , pid    :: {-# UNPACK #-}!PID
277                       }
278  | OsProcessParentPid { capset :: {-# UNPACK #-}!Capset
279                       , ppid   :: {-# UNPACK #-}!PID
280                       }
281  | WallClockTime      { capset :: {-# UNPACK #-}!Capset
282                       , sec    :: {-# UNPACK #-}!Word64
283                       , nsec   :: {-# UNPACK #-}!Word32
284                       }
285
286  -- messages
287  | Message            { msg :: !Text }
288  | UserMessage        { msg :: !Text }
289  | UserMarker         { markername :: !Text }
290
291  -- Events emitted by a parallel RTS
292   -- Program /process info (tools might prefer newer variants above)
293  | Version            { version :: String }
294  | ProgramInvocation  { commandline :: String }
295   -- startup and shutdown (incl. real start time, not first log entry)
296  | CreateMachine      { machine :: {-# UNPACK #-} !MachineId,
297                         realtime    :: {-# UNPACK #-} !Timestamp}
298  | KillMachine        { machine ::  {-# UNPACK #-} !MachineId }
299   -- Haskell processes mgmt (thread groups that share heap and communicate)
300  | CreateProcess      { process :: {-# UNPACK #-} !ProcessId }
301  | KillProcess        { process :: {-# UNPACK #-} !ProcessId }
302  | AssignThreadToProcess { thread :: {-# UNPACK #-} !ThreadId,
303                            process :: {-# UNPACK #-} !ProcessId
304                          }
305   -- communication between processes
306  | EdenStartReceive   { }
307  | EdenEndReceive     { }
308  | SendMessage        { mesTag :: !MessageTag,
309                         senderProcess :: {-# UNPACK #-} !ProcessId,
310                         senderThread :: {-# UNPACK #-} !ThreadId,
311                         receiverMachine ::  {-# UNPACK #-} !MachineId,
312                         receiverProcess :: {-# UNPACK #-} !ProcessId,
313                         receiverInport :: {-# UNPACK #-} !PortId
314                       }
315  | ReceiveMessage     { mesTag :: !MessageTag,
316                         receiverProcess :: {-# UNPACK #-} !ProcessId,
317                         receiverInport :: {-# UNPACK #-} !PortId,
318                         senderMachine ::  {-# UNPACK #-} !MachineId,
319                         senderProcess :: {-# UNPACK #-} !ProcessId,
320                         senderThread :: {-# UNPACK #-} !ThreadId,
321                         messageSize :: {-# UNPACK #-} !MessageSize
322                       }
323  | SendReceiveLocalMessage { mesTag :: !MessageTag,
324                              senderProcess :: {-# UNPACK #-} !ProcessId,
325                              senderThread :: {-# UNPACK #-} !ThreadId,
326                              receiverProcess :: {-# UNPACK #-} !ProcessId,
327                              receiverInport :: {-# UNPACK #-} !PortId
328                            }
329
330  -- These events have been added for Mercury's benifit but are generally
331  -- useful.
332  | InternString       { str :: String, sId :: {-# UNPACK #-}!StringId }
333
334  -- Mercury specific events.
335  | MerStartParConjunction {
336        dyn_id      :: {-# UNPACK #-}!ParConjDynId,
337        static_id   :: {-# UNPACK #-}!ParConjStaticId
338    }
339  | MerEndParConjunction {
340        dyn_id      :: {-# UNPACK #-}!ParConjDynId
341    }
342  | MerEndParConjunct {
343        dyn_id      :: {-# UNPACK #-}!ParConjDynId
344    }
345  | MerCreateSpark {
346        dyn_id      :: {-# UNPACK #-}!ParConjDynId,
347        spark_id    :: {-# UNPACK #-}!SparkId
348    }
349  | MerFutureCreate {
350        future_id   :: {-# UNPACK #-}!FutureId,
351        name_id     :: {-# UNPACK #-}!StringId
352    }
353  | MerFutureWaitNosuspend {
354        future_id   :: {-# UNPACK #-}!FutureId
355    }
356  | MerFutureWaitSuspended {
357        future_id   :: {-# UNPACK #-}!FutureId
358    }
359  | MerFutureSignal {
360        future_id   :: {-# UNPACK #-}!FutureId
361    }
362  | MerLookingForGlobalThread
363  | MerWorkStealing
364  | MerLookingForLocalSpark
365  | MerReleaseThread {
366        thread_id   :: {-# UNPACK #-}!ThreadId
367    }
368  | MerCapSleeping
369  | MerCallingMain
370
371  -- perf events
372  | PerfName           { perfNum :: {-# UNPACK #-}!PerfEventTypeNum
373                       , name    :: !Text
374                       }
375  | PerfCounter        { perfNum :: {-# UNPACK #-}!PerfEventTypeNum
376                       , tid     :: {-# UNPACK #-}!KernelThreadId
377                       , period  :: {-# UNPACK #-}!Word64
378                       }
379  | PerfTracepoint     { perfNum :: {-# UNPACK #-}!PerfEventTypeNum
380                       , tid     :: {-# UNPACK #-}!KernelThreadId
381                       }
382  | HeapProfBegin      { heapProfId :: !Word8
383                       , heapProfSamplingPeriod :: !Word64
384                       , heapProfBreakdown :: !HeapProfBreakdown
385                       , heapProfModuleFilter :: !Text
386                       , heapProfClosureDescrFilter :: !Text
387                       , heapProfTypeDescrFilter :: !Text
388                       , heapProfCostCentreFilter :: !Text
389                       , heapProfCostCentreStackFilter :: !Text
390                       , heapProfRetainerFilter :: !Text
391                       , heapProfBiographyFilter :: !Text
392                       }
393  | HeapProfCostCentre { heapProfCostCentreId :: !Word32
394                       , heapProfLabel :: !Text
395                       , heapProfModule :: !Text
396                       , heapProfSrcLoc :: !Text
397                       , heapProfFlags :: !HeapProfFlags
398                       }
399  | HeapProfSampleBegin
400                       { heapProfSampleEra :: !Word64
401                       }
402  | HeapProfSampleEnd
403                       { heapProfSampleEra :: !Word64
404                       }
405
406  | HeapBioProfSampleBegin
407                       { heapProfSampleEra :: !Word64
408                       , heapProfSampleTime :: !Word64
409                       }
410  | HeapProfSampleCostCentre
411                       { heapProfId :: !Word8
412                       , heapProfResidency :: !Word64
413                       , heapProfStackDepth :: !Word8
414                       , heapProfStack :: !(VU.Vector Word32)
415                       }
416  | HeapProfSampleString
417                       { heapProfId :: !Word8
418                       , heapProfResidency :: !Word64
419                       , heapProfLabel :: !Text
420                       }
421
422  | ProfSampleCostCentre
423                       { profCapset :: !Capset
424                       , profTicks :: !Word64
425                       , profStackDepth :: !Word8
426                       , profCcsStack :: !(VU.Vector Word32)
427                       }
428  | ProfBegin
429                       { profTickInterval :: !Word64
430                       }
431
432  | UserBinaryMessage  { payload :: !B.ByteString
433                       }
434
435  | ConcMarkBegin
436  | ConcMarkEnd        { concMarkedObjectCount :: !Word32
437                       }
438  | ConcSyncBegin
439  | ConcSyncEnd
440  | ConcSweepBegin
441  | ConcSweepEnd
442  | ConcUpdRemSetFlush { cap    :: {-# UNPACK #-}!Int
443                       }
444  | NonmovingHeapCensus
445                       { nonmovingCensusBlkSize :: !Word8
446                       , nonmovingCensusActiveSegs :: !Word32
447                       , nonmovingCensusFilledSegs :: !Word32
448                       , nonmovingCensusLiveBlocks :: !Word32
449                       }
450  | TickyCounterDef
451                       { tickyCtrDefId      :: !Word64
452                       , tickyCtrDefArity   :: !Word16
453                       , tickyCtrDefKinds   :: !Text
454                       , tickyCtrDefName    :: !Text
455                       }
456  | TickyCounterSample
457                       { tickyCtrSampleId         :: !Word64
458                       , tickyCtrSampleEntryCount :: !Word64
459                       , tickyCtrSampleAllocs     :: !Word64
460                       , tickyCtrSampleAllocd     :: !Word64
461                       }
462  deriving Show
463
464{- [Note: Stop status in GHC-7.8.2]
465
466In GHC-7.7, a new thread block reason "BlockedOnMVarRead" was
467introduced, and placed adjacent to BlockedOnMVar (7). Therefore, event
468logs produced by GHC pre-7.8.2 encode BlockedOnBlackHole and following
469as 8..18, whereas GHC-7.8.2 event logs encode them as 9..19.
470Later, the prior event numbering was restored for GHC-7.8.3.
471See GHC bug #9003 for a discussion.
472
473The parsers in Events.hs have to be adapted accordingly, providing
474special ghc-7.8.2 parsers for the thread-stop event if GHC-7.8.2
475produced the eventlog.
476The EVENT_USER_MARKER was not present in GHC-7.6.3, and a new event
477EVENT_HACK_BUG_T9003 was added in GHC-7.8.3, so we take presence of
478USER_MARKER and absence of HACK_BUG_T9003 as an indication that
479ghc-7.8.2 parsers should be used.
480-}
481
482--sync with ghc/includes/Constants.h
483data ThreadStopStatus
484 = NoStatus
485 | HeapOverflow
486 | StackOverflow
487 | ThreadYielding
488 | ThreadBlocked
489 | ThreadFinished
490 | ForeignCall
491 | BlockedOnMVar
492 | BlockedOnMVarRead   -- since GHC-7.8, see [Stop status since GHC-7.7]
493 | BlockedOnBlackHole
494 | BlockedOnRead
495 | BlockedOnWrite
496 | BlockedOnDelay
497 | BlockedOnSTM
498 | BlockedOnDoProc
499 | BlockedOnCCall
500 | BlockedOnCCall_NoUnblockExc
501 | BlockedOnMsgThrowTo
502 | ThreadMigrating
503 | BlockedOnMsgGlobalise
504 | BlockedOnBlackHoleOwnedBy {-# UNPACK #-}!ThreadId
505 deriving (Show)
506
507-- normal GHC encoding, see [Stop status in GHC-7.8.2]
508mkStopStatus :: RawThreadStopStatus -> ThreadStopStatus
509mkStopStatus n = case n of
510 0  ->  NoStatus
511 1  ->  HeapOverflow
512 2  ->  StackOverflow
513 3  ->  ThreadYielding
514 4  ->  ThreadBlocked
515 5  ->  ThreadFinished
516 6  ->  ForeignCall
517 7  ->  BlockedOnMVar
518 8  ->  BlockedOnBlackHole
519 9  ->  BlockedOnRead
520 10 ->  BlockedOnWrite
521 11 ->  BlockedOnDelay
522 12 ->  BlockedOnSTM
523 13 ->  BlockedOnDoProc
524 14 ->  BlockedOnCCall
525 15 ->  BlockedOnCCall_NoUnblockExc
526 16 ->  BlockedOnMsgThrowTo
527 17 ->  ThreadMigrating
528 18 ->  BlockedOnMsgGlobalise
529 19 ->  NoStatus -- yeuch... this one does not actually exist in GHC eventlogs
530 20 ->  BlockedOnMVarRead -- since GHC-7.8.3
531 _  ->  error "mkStat"
532
533-- GHC 7.8.2 encoding, see [Stop status in GHC-7.8.2]
534mkStopStatus782 :: RawThreadStopStatus -> ThreadStopStatus
535mkStopStatus782 n = case n of
536 0  ->  NoStatus
537 1  ->  HeapOverflow
538 2  ->  StackOverflow
539 3  ->  ThreadYielding
540 4  ->  ThreadBlocked
541 5  ->  ThreadFinished
542 6  ->  ForeignCall
543 7  ->  BlockedOnMVar
544 8  ->  BlockedOnMVarRead -- in GHC-7.8.2
545 9  ->  BlockedOnBlackHole
546 10 ->  BlockedOnRead
547 11 ->  BlockedOnWrite
548 12 ->  BlockedOnDelay
549 13 ->  BlockedOnSTM
550 14 ->  BlockedOnDoProc
551 15 ->  BlockedOnCCall
552 16 ->  BlockedOnCCall_NoUnblockExc
553 17 ->  BlockedOnMsgThrowTo
554 18 ->  ThreadMigrating
555 19 ->  BlockedOnMsgGlobalise
556 _  ->  error "mkStat"
557
558maxThreadStopStatusPre77, maxThreadStopStatus782, maxThreadStopStatus
559    :: RawThreadStopStatus
560maxThreadStopStatusPre77  = 18 -- see [Stop status in GHC-7.8.2]
561maxThreadStopStatus782    = 19 -- need to distinguish three cases
562maxThreadStopStatus = 20
563
564data CapsetType
565 = CapsetCustom
566 | CapsetOsProcess
567 | CapsetClockDomain
568 | CapsetUnknown
569 deriving Show
570
571mkCapsetType :: Word16 -> CapsetType
572mkCapsetType n = case n of
573 1 -> CapsetCustom
574 2 -> CapsetOsProcess
575 3 -> CapsetClockDomain
576 _ -> CapsetUnknown
577
578-- | An event annotated with the Capability that generated it, if any
579{-# DEPRECATED CapEvent "CapEvents will be removed soon, now Event has a field evCap" #-}
580data CapEvent
581  = CapEvent { ce_cap   :: Maybe Int,
582               ce_event :: Event
583               -- we could UNPACK ce_event, but the Event constructor
584               -- might be shared, in which case we could end up
585               -- increasing the space usage.
586             } deriving Show
587
588--sync with ghc/parallel/PEOpCodes.h
589data MessageTag
590  = Ready | NewPE | PETIDS | Finish
591  | FailPE | RFork | Connect | DataMes
592  | Head | Constr | Part | Terminate
593  | Packet
594  -- with GUM and its variants, add:
595  -- ...| Fetch | Resume | Ack
596  -- ...| Fish | Schedule | Free | Reval | Shark
597  deriving (Enum, Show)
598offset :: RawMsgTag
599offset = 0x50
600
601-- decoder and encoder
602toMsgTag :: RawMsgTag -> MessageTag
603toMsgTag = toEnum . fromIntegral . (\n -> n - offset)
604
605fromMsgTag :: MessageTag -> RawMsgTag
606fromMsgTag = (+ offset) . fromIntegral . fromEnum
607
608-- | Sample break-down types in heap profiling
609data HeapProfBreakdown
610  = HeapProfBreakdownCostCentre
611  | HeapProfBreakdownModule
612  | HeapProfBreakdownClosureDescr
613  | HeapProfBreakdownTypeDescr
614  | HeapProfBreakdownRetainer
615  | HeapProfBreakdownBiography
616  | HeapProfBreakdownClosureType
617  deriving Show
618
619instance Binary HeapProfBreakdown where
620  get = do
621    n <- get :: Get Word32
622    case n of
623      1 -> return HeapProfBreakdownCostCentre
624      2 -> return HeapProfBreakdownModule
625      3 -> return HeapProfBreakdownClosureDescr
626      4 -> return HeapProfBreakdownTypeDescr
627      5 -> return HeapProfBreakdownRetainer
628      6 -> return HeapProfBreakdownBiography
629      7 -> return HeapProfBreakdownClosureType
630      _ -> fail $ "Unknown HeapProfBreakdown: " ++ show n
631  put breakdown = put $ case breakdown of
632    HeapProfBreakdownCostCentre -> (1 :: Word32)
633    HeapProfBreakdownModule -> 2
634    HeapProfBreakdownClosureDescr -> 3
635    HeapProfBreakdownTypeDescr -> 4
636    HeapProfBreakdownRetainer -> 5
637    HeapProfBreakdownBiography -> 6
638    HeapProfBreakdownClosureType -> 7
639
640newtype HeapProfFlags = HeapProfFlags Word8
641  deriving (Show, Binary)
642
643isCaf :: HeapProfFlags -> Bool
644isCaf (HeapProfFlags w8) = testBit w8 0
645
646-- Checks if the capability is not -1 (which indicates a global eventblock), so
647-- has no associated capability
648mkCap :: Int -> Maybe Int
649mkCap cap = do
650  guard $ fromIntegral cap /= (maxBound :: Word16)
651  return cap
652