1{-# LANGUAGE CPP #-} 2{-# LANGUAGE OverloadedStrings #-} 3{-# LANGUAGE ViewPatterns #-} 4module GHC.RTS.Events.Binary 5 ( -- * Readers 6 getHeader 7 , getEvent 8 , standardParsers 9 , ghc6Parsers 10 , ghc7Parsers 11 , mercuryParsers 12 , perfParsers 13 , heapProfParsers 14 , timeProfParsers 15 , pre77StopParsers 16 , ghc782StopParser 17 , post782StopParser 18 , parRTSParsers 19 , binaryEventParsers 20 , tickyParsers 21 22 -- * Writers 23 , putEventLog 24 , putHeader 25 , putEvent 26 27 -- * Perf events 28 , nEVENT_PERF_NAME 29 , nEVENT_PERF_COUNTER 30 , nEVENT_PERF_TRACEPOINT 31 32 ) where 33import Control.Exception (assert) 34import Control.Monad 35import Data.List (intersperse) 36import Data.Maybe 37import Prelude hiding (gcd, rem, id) 38 39import Data.Array 40import Data.Binary 41import Data.Binary.Put 42import qualified Data.Binary.Get as G 43import qualified Data.ByteString as B 44import qualified Data.Text as T 45import qualified Data.Text.Encoding as TE 46import qualified Data.Vector.Unboxed as VU 47 48import GHC.RTS.EventTypes 49import GHC.RTS.EventParserUtils 50 51#define EVENTLOG_CONSTANTS_ONLY 52#include "EventLogFormat.h" 53 54getEventType :: Get EventType 55getEventType = do 56 etNum <- get 57 size <- get :: Get EventTypeSize 58 let etSize = if size == 0xffff then Nothing else Just size 59 -- 0xffff indicates variable-sized event 60 etDescLen <- get :: Get EventTypeDescLen 61 etDesc <- getText etDescLen 62 etExtraLen <- get :: Get Word32 63 G.skip (fromIntegral etExtraLen) 64 ete <- get :: Get Marker 65 when (ete /= EVENT_ET_END) $ 66 fail "Event Type end marker not found." 67 return (EventType etNum etDesc etSize) 68 69getHeader :: Get Header 70getHeader = do 71 hdrb <- get :: Get Marker 72 when (hdrb /= EVENT_HEADER_BEGIN) $ 73 fail "Header begin marker not found" 74 hetm <- get :: Get Marker 75 when (hetm /= EVENT_HET_BEGIN) $ 76 fail "Header Event Type begin marker not found" 77 ets <- getEventTypes 78 emark <- get :: Get Marker 79 when (emark /= EVENT_HEADER_END) $ 80 fail "Header end marker not found" 81 db <- get :: Get Marker 82 when (db /= EVENT_DATA_BEGIN) $ 83 fail "My Data begin marker not found" 84 return $ Header ets 85 where 86 getEventTypes :: Get [EventType] 87 getEventTypes = do 88 m <- get :: Get Marker 89 case m of 90 EVENT_ET_BEGIN -> do 91 et <- getEventType 92 nextET <- getEventTypes 93 return (et : nextET) 94 EVENT_HET_END -> 95 return [] 96 _ -> 97 fail "Malformed list of Event Types in header" 98 99getEvent :: EventParsers -> Get (Maybe Event) 100getEvent (EventParsers parsers) = do 101 etRef <- get :: Get EventTypeNum 102 if etRef == EVENT_DATA_END 103 then return Nothing 104 else do !evTime <- get 105 evSpec <- parsers ! fromIntegral etRef 106 return $ Just Event { evCap = undefined, .. } 107 108-- 109-- standardEventParsers. 110-- 111standardParsers :: [EventParser EventInfo] 112standardParsers = [ 113 (FixedSizeParser EVENT_STARTUP sz_cap (do -- (n_caps) 114 c <- get :: Get CapNo 115 return Startup{ n_caps = fromIntegral c } 116 )), 117 118 (FixedSizeParser EVENT_BLOCK_MARKER (sz_block_size + sz_time + sz_cap) (do -- (size, end_time, cap) 119 block_size <- get :: Get BlockSize 120 end_time <- get :: Get Timestamp 121 c <- get :: Get CapNo 122 return EventBlock { end_time = end_time, 123 cap = fromIntegral c, 124 block_size = ((fromIntegral block_size) - 125 (fromIntegral sz_block_event)) 126 } 127 )), 128 129 -- EVENT_SHUTDOWN is replaced by EVENT_CAP_DELETE and GHC 7.6+ 130 -- no longer generate the event; should be removed at some point 131 (simpleEvent EVENT_SHUTDOWN Shutdown), 132 133 (simpleEvent EVENT_REQUEST_SEQ_GC RequestSeqGC), 134 135 (simpleEvent EVENT_REQUEST_PAR_GC RequestParGC), 136 137 (simpleEvent EVENT_GC_START StartGC), 138 139 (simpleEvent EVENT_GC_WORK GCWork), 140 141 (simpleEvent EVENT_GC_IDLE GCIdle), 142 143 (simpleEvent EVENT_GC_DONE GCDone), 144 145 (simpleEvent EVENT_GC_END EndGC), 146 147 (simpleEvent EVENT_GC_GLOBAL_SYNC GlobalSyncGC), 148 149 (FixedSizeParser EVENT_GC_STATS_GHC (sz_capset + 2 + 5*8 + 4) (do -- (heap_capset, generation, copied_bytes, slop_bytes, frag_bytes, par_n_threads, par_max_copied, par_tot_copied) 150 heapCapset <- get 151 gen <- get :: Get Word16 152 copied <- get :: Get Word64 153 slop <- get :: Get Word64 154 frag <- get :: Get Word64 155 parNThreads <- get :: Get Word32 156 parMaxCopied <- get :: Get Word64 157 parTotCopied <- get :: Get Word64 158 return GCStatsGHC{ gen = fromIntegral gen 159 , parNThreads = fromIntegral parNThreads 160 , parBalancedCopied = Nothing 161 , ..} 162 )), 163 164 (FixedSizeParser EVENT_GC_STATS_GHC (sz_capset + 2 + 5*8 + 4 + 8) (do -- (heap_capset, generation, copied_bytes, slop_bytes, frag_bytes, par_n_threads, par_max_copied, par_tot_copied, par_balanced_copied) 165 heapCapset <- get 166 gen <- get :: Get Word16 167 copied <- get :: Get Word64 168 slop <- get :: Get Word64 169 frag <- get :: Get Word64 170 parNThreads <- get :: Get Word32 171 parMaxCopied <- get :: Get Word64 172 parTotCopied <- get :: Get Word64 173 parBalancedCopied <- get :: Get Word64 174 return GCStatsGHC{ gen = fromIntegral gen 175 , parNThreads = fromIntegral parNThreads 176 , parBalancedCopied = Just parBalancedCopied 177 , ..} 178 )), 179 180 (FixedSizeParser EVENT_HEAP_ALLOCATED (sz_capset + 8) (do -- (heap_capset, alloc_bytes) 181 heapCapset <- get 182 allocBytes <- get 183 return HeapAllocated{..} 184 )), 185 186 (FixedSizeParser EVENT_HEAP_SIZE (sz_capset + 8) (do -- (heap_capset, size_bytes) 187 heapCapset <- get 188 sizeBytes <- get 189 return HeapSize{..} 190 )), 191 192 (FixedSizeParser EVENT_HEAP_LIVE (sz_capset + 8) (do -- (heap_capset, live_bytes) 193 heapCapset <- get 194 liveBytes <- get 195 return HeapLive{..} 196 )), 197 198 (FixedSizeParser EVENT_HEAP_INFO_GHC (sz_capset + 2 + 4*8) (do -- (heap_capset, n_generations, max_heap_size, alloc_area_size, mblock_size, block_size) 199 heapCapset <- get 200 gens <- get :: Get Word16 201 maxHeapSize <- get :: Get Word64 202 allocAreaSize <- get :: Get Word64 203 mblockSize <- get :: Get Word64 204 blockSize <- get :: Get Word64 205 return HeapInfoGHC{gens = fromIntegral gens, ..} 206 )), 207 208 (FixedSizeParser EVENT_CAP_CREATE (sz_cap) (do -- (cap) 209 cap <- get :: Get CapNo 210 return CapCreate{cap = fromIntegral cap} 211 )), 212 213 (FixedSizeParser EVENT_CAP_DELETE (sz_cap) (do -- (cap) 214 cap <- get :: Get CapNo 215 return CapDelete{cap = fromIntegral cap} 216 )), 217 218 (FixedSizeParser EVENT_CAP_DISABLE (sz_cap) (do -- (cap) 219 cap <- get :: Get CapNo 220 return CapDisable{cap = fromIntegral cap} 221 )), 222 223 (FixedSizeParser EVENT_CAP_ENABLE (sz_cap) (do -- (cap) 224 cap <- get :: Get CapNo 225 return CapEnable{cap = fromIntegral cap} 226 )), 227 228 (FixedSizeParser EVENT_CAPSET_CREATE (sz_capset + sz_capset_type) (do -- (capset, capset_type) 229 cs <- get 230 ct <- fmap mkCapsetType get 231 return CapsetCreate{capset=cs,capsetType=ct} 232 )), 233 234 (FixedSizeParser EVENT_CAPSET_DELETE sz_capset (do -- (capset) 235 cs <- get 236 return CapsetDelete{capset=cs} 237 )), 238 239 (FixedSizeParser EVENT_CAPSET_ASSIGN_CAP (sz_capset + sz_cap) (do -- (capset, cap) 240 cs <- get 241 cp <- get :: Get CapNo 242 return CapsetAssignCap{capset=cs,cap=fromIntegral cp} 243 )), 244 245 (FixedSizeParser EVENT_CAPSET_REMOVE_CAP (sz_capset + sz_cap) (do -- (capset, cap) 246 cs <- get 247 cp <- get :: Get CapNo 248 return CapsetRemoveCap{capset=cs,cap=fromIntegral cp} 249 )), 250 251 (FixedSizeParser EVENT_OSPROCESS_PID (sz_capset + sz_pid) (do -- (capset, pid) 252 cs <- get 253 pd <- get 254 return OsProcessPid{capset=cs,pid=pd} 255 )), 256 257 (FixedSizeParser EVENT_OSPROCESS_PPID (sz_capset + sz_pid) (do -- (capset, ppid) 258 cs <- get 259 pd <- get 260 return OsProcessParentPid{capset=cs,ppid=pd} 261 )), 262 263 (FixedSizeParser EVENT_WALL_CLOCK_TIME (sz_capset + 8 + 4) (do -- (capset, unix_epoch_seconds, nanoseconds) 264 cs <- get 265 s <- get 266 ns <- get 267 return WallClockTime{capset=cs,sec=s,nsec=ns} 268 )), 269 270 (VariableSizeParser EVENT_LOG_MSG (do -- (msg) 271 num <- get :: Get Word16 272 string <- getText num 273 return Message{ msg = string } 274 )), 275 (VariableSizeParser EVENT_USER_MSG (do -- (msg) 276 num <- get :: Get Word16 277 string <- getText num 278 return UserMessage{ msg = string } 279 )), 280 (VariableSizeParser EVENT_USER_MARKER (do -- (markername) 281 num <- get :: Get Word16 282 string <- getText num 283 return UserMarker{ markername = string } 284 )), 285 (VariableSizeParser EVENT_PROGRAM_ARGS (do -- (capset, [arg]) 286 num <- get :: Get Word16 287 cs <- get 288 string <- getText (num - sz_capset) 289 return ProgramArgs 290 { capset = cs 291 , args = T.splitOn "\0" $ T.dropWhileEnd (== '\0') string } 292 )), 293 (VariableSizeParser EVENT_PROGRAM_ENV (do -- (capset, [arg]) 294 num <- get :: Get Word16 295 cs <- get 296 string <- getText (num - sz_capset) 297 return ProgramEnv 298 { capset = cs 299 , env = T.splitOn "\0" $ T.dropWhileEnd (== '\0') string } 300 )), 301 (VariableSizeParser EVENT_RTS_IDENTIFIER (do -- (capset, str) 302 num <- get :: Get Word16 303 cs <- get 304 string <- getText (num - sz_capset) 305 return RtsIdentifier{ capset = cs 306 , rtsident = string } 307 )), 308 309 (VariableSizeParser EVENT_INTERN_STRING (do -- (str, id) 310 num <- get :: Get Word16 311 string <- getString (num - sz_string_id) 312 sId <- get :: Get StringId 313 return (InternString string sId) 314 )), 315 316 (VariableSizeParser EVENT_THREAD_LABEL (do -- (thread, str) 317 num <- get :: Get Word16 318 tid <- get 319 str <- getText (num - sz_tid) 320 return ThreadLabel{ thread = tid 321 , threadlabel = str } 322 )), 323 324 (simpleEvent EVENT_CONC_MARK_BEGIN ConcMarkBegin), 325 (FixedSizeParser EVENT_CONC_MARK_END 4 (do -- (marked_object_count) 326 num <- get :: Get Word32 327 return ConcMarkEnd{ concMarkedObjectCount = num } 328 )), 329 (simpleEvent EVENT_CONC_SYNC_BEGIN ConcSyncBegin), 330 (simpleEvent EVENT_CONC_SYNC_END ConcSyncEnd), 331 (simpleEvent EVENT_CONC_SWEEP_BEGIN ConcSweepBegin), 332 (simpleEvent EVENT_CONC_SWEEP_END ConcSweepEnd), 333 (FixedSizeParser EVENT_CONC_UPD_REM_SET_FLUSH sz_cap (do -- (cap) 334 cap <- get :: Get CapNo 335 return ConcUpdRemSetFlush{ cap = fromIntegral cap } 336 )), 337 (FixedSizeParser EVENT_NONMOVING_HEAP_CENSUS 13 (do -- (blk_size, active_segs, filled_segs, live_blks) 338 nonmovingCensusBlkSize <- get :: Get Word8 339 nonmovingCensusActiveSegs <- get :: Get Word32 340 nonmovingCensusFilledSegs <- get :: Get Word32 341 nonmovingCensusLiveBlocks <- get :: Get Word32 342 return NonmovingHeapCensus{..} 343 )) 344 ] 345 346-- Parsers valid for GHC7 but not GHC6. 347ghc7Parsers :: [EventParser EventInfo] 348ghc7Parsers = [ 349 (FixedSizeParser EVENT_CREATE_THREAD sz_tid (do -- (thread) 350 t <- get 351 return CreateThread{thread=t} 352 )), 353 354 (FixedSizeParser EVENT_RUN_THREAD sz_tid (do -- (thread) 355 t <- get 356 return RunThread{thread=t} 357 )), 358 359 (FixedSizeParser EVENT_THREAD_RUNNABLE sz_tid (do -- (thread) 360 t <- get 361 return ThreadRunnable{thread=t} 362 )), 363 364 (FixedSizeParser EVENT_MIGRATE_THREAD (sz_tid + sz_cap) (do -- (thread, newCap) 365 t <- get 366 nc <- get :: Get CapNo 367 return MigrateThread{thread=t,newCap=fromIntegral nc} 368 )), 369 370 -- Yes, EVENT_RUN/STEAL_SPARK are deprecated, but see the explanation in the 371 -- 'ghc6Parsers' section below. Since we're parsing them anyway, we might 372 -- as well convert them to the new SparkRun/SparkSteal events. 373 (FixedSizeParser EVENT_RUN_SPARK sz_tid (do -- (thread) 374 _ <- get :: Get ThreadId 375 return SparkRun 376 )), 377 378 (FixedSizeParser EVENT_STEAL_SPARK (sz_tid + sz_cap) (do -- (thread, victimCap) 379 _ <- get :: Get ThreadId 380 vc <- get :: Get CapNo 381 return SparkSteal{victimCap=fromIntegral vc} 382 )), 383 384 (FixedSizeParser EVENT_CREATE_SPARK_THREAD sz_tid (do -- (sparkThread) 385 st <- get :: Get ThreadId 386 return CreateSparkThread{sparkThread=st} 387 )), 388 389 (FixedSizeParser EVENT_SPARK_COUNTERS (7*8) (do -- (crt,dud,ovf,cnv,gcd,fiz,rem) 390 crt <- get :: Get Word64 391 dud <- get :: Get Word64 392 ovf <- get :: Get Word64 393 cnv <- get :: Get Word64 394 gcd <- get :: Get Word64 395 fiz <- get :: Get Word64 396 rem <- get :: Get Word64 397 return SparkCounters{sparksCreated = crt, sparksDud = dud, 398 sparksOverflowed = ovf, sparksConverted = cnv, 399 -- Warning: order of fiz and gcd reversed! 400 sparksFizzled = fiz, sparksGCd = gcd, 401 sparksRemaining = rem} 402 )), 403 404 (simpleEvent EVENT_SPARK_CREATE SparkCreate), 405 (simpleEvent EVENT_SPARK_DUD SparkDud), 406 (simpleEvent EVENT_SPARK_OVERFLOW SparkOverflow), 407 (simpleEvent EVENT_SPARK_RUN SparkRun), 408 (FixedSizeParser EVENT_SPARK_STEAL sz_cap (do -- (victimCap) 409 vc <- get :: Get CapNo 410 return SparkSteal{victimCap=fromIntegral vc} 411 )), 412 (simpleEvent EVENT_SPARK_FIZZLE SparkFizzle), 413 (simpleEvent EVENT_SPARK_GC SparkGC), 414 415 (FixedSizeParser EVENT_TASK_CREATE (sz_taskid + sz_cap + sz_kernel_tid) (do -- (taskID, cap, tid) 416 taskId <- get :: Get TaskId 417 cap <- get :: Get CapNo 418 tid <- get :: Get KernelThreadId 419 return TaskCreate{ taskId, cap = fromIntegral cap, tid } 420 )), 421 (FixedSizeParser EVENT_TASK_MIGRATE (sz_taskid + sz_cap*2) (do -- (taskID, cap, new_cap) 422 taskId <- get :: Get TaskId 423 cap <- get :: Get CapNo 424 new_cap <- get :: Get CapNo 425 return TaskMigrate{ taskId, cap = fromIntegral cap 426 , new_cap = fromIntegral new_cap 427 } 428 )), 429 (FixedSizeParser EVENT_TASK_DELETE (sz_taskid) (do -- (taskID) 430 taskId <- get :: Get TaskId 431 return TaskDelete{ taskId } 432 )), 433 434 (FixedSizeParser EVENT_THREAD_WAKEUP (sz_tid + sz_cap) (do -- (thread, other_cap) 435 t <- get 436 oc <- get :: Get CapNo 437 return WakeupThread{thread=t,otherCap=fromIntegral oc} 438 )) 439 ] 440 441-- special thread stop event parsers for GHC version 7.8.2 442-- see [Stop status in GHC-7.8.2] in EventTypes.hs 443ghc782StopParser :: EventParser EventInfo 444ghc782StopParser = 445 (FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status + sz_tid) (do 446 -- (thread, status, info) 447 t <- get 448 s <- get :: Get RawThreadStopStatus 449 i <- get :: Get ThreadId 450 return StopThread{thread = t, 451 status = case () of 452 _ | s > maxThreadStopStatus782 453 -> NoStatus 454 | s == 9 {- XXX yeuch -} 455 -- GHC-7.8.2: 9 == BlockedOnBlackHole 456 -> BlockedOnBlackHoleOwnedBy i 457 | otherwise 458 -> mkStopStatus782 s} 459 )) 460 461-- parsers for GHC < 7.8.2. Older versions do not use block info 462-- (different length). See [Stop status in GHC-7.8.2] in 463-- EventTypes.hs 464pre77StopParsers :: [EventParser EventInfo] 465pre77StopParsers = [ 466 (FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status) (do 467 -- (thread, status) 468 t <- get 469 s <- get :: Get RawThreadStopStatus 470 return StopThread{thread=t, status = if s > maxThreadStopStatusPre77 471 then NoStatus 472 else mkStopStatus s} 473 -- older version of the event, no block info 474 )), 475 476 (FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status + sz_tid) 477 (do 478 -- (thread, status, info) 479 t <- get 480 s <- get :: Get RawThreadStopStatus 481 i <- get :: Get ThreadId 482 return StopThread{thread = t, 483 status = case () of 484 _ | s > maxThreadStopStatusPre77 485 -> NoStatus 486 | s == 8 {- XXX yeuch -} 487 -- pre-7.7: 8==BlockedOnBlackhole 488 -> BlockedOnBlackHoleOwnedBy i 489 | otherwise 490 -> mkStopStatus s} 491 )) 492 ] 493 494-- parsers for GHC >= 7.8.3, always using block info field parser. 495-- See [Stop status in GHC-7.8.2] in EventTypes.hs 496post782StopParser :: EventParser EventInfo 497post782StopParser = 498 (FixedSizeParser EVENT_STOP_THREAD (sz_tid + sz_th_stop_status + sz_tid) 499 (do 500 -- (thread, status, info) 501 t <- get 502 s <- get :: Get RawThreadStopStatus 503 i <- get :: Get ThreadId 504 return StopThread{thread = t, 505 status = case () of 506 _ | s > maxThreadStopStatus 507 -> NoStatus 508 | s == 8 {- XXX yeuch -} 509 -- post-7.8.2: 8==BlockedOnBlackhole 510 -> BlockedOnBlackHoleOwnedBy i 511 | otherwise 512 -> mkStopStatus s} 513 )) 514 515 ----------------------- 516 -- GHC 6.12 compat: GHC 6.12 reported the wrong sizes for some events, 517 -- so we have to recognise those wrong sizes here for backwards 518 -- compatibility. 519ghc6Parsers :: [EventParser EventInfo] 520ghc6Parsers = [ 521 (FixedSizeParser EVENT_STARTUP 0 (do 522 -- BUG in GHC 6.12: the startup event was incorrectly 523 -- declared as size 0, so we accept it here. 524 c <- get :: Get CapNo 525 return Startup{ n_caps = fromIntegral c } 526 )), 527 528 (FixedSizeParser EVENT_CREATE_THREAD sz_old_tid (do -- (thread) 529 t <- get 530 return CreateThread{thread=t} 531 )), 532 533 (FixedSizeParser EVENT_RUN_THREAD sz_old_tid (do -- (thread) 534 t <- get 535 return RunThread{thread=t} 536 )), 537 538 (FixedSizeParser EVENT_STOP_THREAD (sz_old_tid + 2) (do -- (thread, status) 539 t <- get 540 s <- get :: Get RawThreadStopStatus 541 return StopThread{thread=t, status = if s > maxThreadStopStatusPre77 542 then NoStatus 543 else mkStopStatus s} 544 -- older version of the event uses pre-77 encoding 545 -- (actually, it only uses encodings 0 to 5) 546 -- see [Stop status in GHC-7.8.2] in EventTypes.hs 547 )), 548 549 (FixedSizeParser EVENT_THREAD_RUNNABLE sz_old_tid (do -- (thread) 550 t <- get 551 return ThreadRunnable{thread=t} 552 )), 553 554 (FixedSizeParser EVENT_MIGRATE_THREAD (sz_old_tid + sz_cap) (do -- (thread, newCap) 555 t <- get 556 nc <- get :: Get CapNo 557 return MigrateThread{thread=t,newCap=fromIntegral nc} 558 )), 559 560 -- Note: it is vital that these two (EVENT_RUN/STEAL_SPARK) remain here (at 561 -- least in the ghc6Parsers section) even though both events are deprecated. 562 -- The reason is that .eventlog files created by the buggy GHC-6.12 563 -- mis-declare the size of these two events. So we have to handle them 564 -- specially here otherwise we'll get the wrong size, leading to us getting 565 -- out of sync and eventual parse failure. Since we're parsing them anyway, 566 -- we might as well convert them to the new SparkRun/SparkSteal events. 567 (FixedSizeParser EVENT_RUN_SPARK sz_old_tid (do -- (thread) 568 _ <- get :: Get ThreadId 569 return SparkRun 570 )), 571 572 (FixedSizeParser EVENT_STEAL_SPARK (sz_old_tid + sz_cap) (do -- (thread, victimCap) 573 _ <- get :: Get ThreadId 574 vc <- get :: Get CapNo 575 return SparkSteal{victimCap=fromIntegral vc} 576 )), 577 578 (FixedSizeParser EVENT_CREATE_SPARK_THREAD sz_old_tid (do -- (sparkThread) 579 st <- get :: Get ThreadId 580 return CreateSparkThread{sparkThread=st} 581 )), 582 583 (FixedSizeParser EVENT_THREAD_WAKEUP (sz_old_tid + sz_cap) (do -- (thread, other_cap) 584 t <- get 585 oc <- get :: Get CapNo 586 return WakeupThread{thread=t,otherCap=fromIntegral oc} 587 )) 588 ] 589 590-- Parsers for parallel events. Parameter is the thread_id size, to create 591-- ghc6-parsers (using the wrong size) where necessary. 592parRTSParsers :: EventTypeSize -> [EventParser EventInfo] 593parRTSParsers sz_tid' = [ 594 (VariableSizeParser EVENT_VERSION (do -- (version) 595 num <- get :: Get Word16 596 string <- getString num 597 return Version{ version = string } 598 )), 599 600 (VariableSizeParser EVENT_PROGRAM_INVOCATION (do -- (cmd. line) 601 num <- get :: Get Word16 602 string <- getString num 603 return ProgramInvocation{ commandline = string } 604 )), 605 606 (simpleEvent EVENT_EDEN_START_RECEIVE EdenStartReceive), 607 (simpleEvent EVENT_EDEN_END_RECEIVE EdenEndReceive), 608 609 (FixedSizeParser EVENT_CREATE_PROCESS sz_procid 610 (do p <- get 611 return CreateProcess{ process = p }) 612 ), 613 614 (FixedSizeParser EVENT_KILL_PROCESS sz_procid 615 (do p <- get 616 return KillProcess{ process = p }) 617 ), 618 619 (FixedSizeParser EVENT_ASSIGN_THREAD_TO_PROCESS (sz_tid' + sz_procid) 620 (do t <- get 621 p <- get 622 return AssignThreadToProcess { thread = t, process = p }) 623 ), 624 625 (FixedSizeParser EVENT_CREATE_MACHINE (sz_mid + sz_realtime) 626 (do m <- get 627 t <- get 628 return CreateMachine { machine = m, realtime = t }) 629 ), 630 631 (FixedSizeParser EVENT_KILL_MACHINE sz_mid 632 (do m <- get :: Get MachineId 633 return KillMachine { machine = m }) 634 ), 635 636 (FixedSizeParser EVENT_SEND_MESSAGE 637 (sz_msgtag + 2*sz_procid + 2*sz_tid' + sz_mid) 638 (do tag <- get :: Get RawMsgTag 639 sP <- get :: Get ProcessId 640 sT <- get :: Get ThreadId 641 rM <- get :: Get MachineId 642 rP <- get :: Get ProcessId 643 rIP <- get :: Get PortId 644 return SendMessage { mesTag = toMsgTag tag, 645 senderProcess = sP, 646 senderThread = sT, 647 receiverMachine = rM, 648 receiverProcess = rP, 649 receiverInport = rIP 650 }) 651 ), 652 653 (FixedSizeParser EVENT_RECEIVE_MESSAGE 654 (sz_msgtag + 2*sz_procid + 2*sz_tid' + sz_mid + sz_mes) 655 (do tag <- get :: Get Word8 656 rP <- get :: Get ProcessId 657 rIP <- get :: Get PortId 658 sM <- get :: Get MachineId 659 sP <- get :: Get ProcessId 660 sT <- get :: Get ThreadId 661 mS <- get :: Get MessageSize 662 return ReceiveMessage { mesTag = toMsgTag tag, 663 receiverProcess = rP, 664 receiverInport = rIP, 665 senderMachine = sM, 666 senderProcess = sP, 667 senderThread= sT, 668 messageSize = mS 669 }) 670 ), 671 672 (FixedSizeParser EVENT_SEND_RECEIVE_LOCAL_MESSAGE 673 (sz_msgtag + 2*sz_procid + 2*sz_tid') 674 (do tag <- get :: Get Word8 675 sP <- get :: Get ProcessId 676 sT <- get :: Get ThreadId 677 rP <- get :: Get ProcessId 678 rIP <- get :: Get PortId 679 return SendReceiveLocalMessage { mesTag = toMsgTag tag, 680 senderProcess = sP, 681 senderThread = sT, 682 receiverProcess = rP, 683 receiverInport = rIP 684 }) 685 )] 686 687mercuryParsers :: [EventParser EventInfo] 688mercuryParsers = [ 689 (FixedSizeParser EVENT_MER_START_PAR_CONJUNCTION 690 (sz_par_conj_dyn_id + sz_par_conj_static_id) 691 (do dyn_id <- get 692 static_id <- get 693 return (MerStartParConjunction dyn_id static_id)) 694 ), 695 696 (FixedSizeParser EVENT_MER_STOP_PAR_CONJUNCTION sz_par_conj_dyn_id 697 (do dyn_id <- get 698 return (MerEndParConjunction dyn_id)) 699 ), 700 701 (FixedSizeParser EVENT_MER_STOP_PAR_CONJUNCT sz_par_conj_dyn_id 702 (do dyn_id <- get 703 return (MerEndParConjunct dyn_id)) 704 ), 705 706 (FixedSizeParser EVENT_MER_CREATE_SPARK (sz_par_conj_dyn_id + sz_spark_id) 707 (do dyn_id <- get 708 spark_id <- get 709 return (MerCreateSpark dyn_id spark_id)) 710 ), 711 712 (FixedSizeParser EVENT_MER_FUT_CREATE (sz_future_id + sz_string_id) 713 (do future_id <- get 714 name_id <- get 715 return (MerFutureCreate future_id name_id)) 716 ), 717 718 (FixedSizeParser EVENT_MER_FUT_WAIT_NOSUSPEND (sz_future_id) 719 (do future_id <- get 720 return (MerFutureWaitNosuspend future_id)) 721 ), 722 723 (FixedSizeParser EVENT_MER_FUT_WAIT_SUSPENDED (sz_future_id) 724 (do future_id <- get 725 return (MerFutureWaitSuspended future_id)) 726 ), 727 728 (FixedSizeParser EVENT_MER_FUT_SIGNAL (sz_future_id) 729 (do future_id <- get 730 return (MerFutureSignal future_id)) 731 ), 732 733 (simpleEvent EVENT_MER_LOOKING_FOR_GLOBAL_CONTEXT MerLookingForGlobalThread), 734 (simpleEvent EVENT_MER_WORK_STEALING MerWorkStealing), 735 (simpleEvent EVENT_MER_LOOKING_FOR_LOCAL_SPARK MerLookingForLocalSpark), 736 737 (FixedSizeParser EVENT_MER_RELEASE_CONTEXT sz_tid 738 (do thread_id <- get 739 return (MerReleaseThread thread_id)) 740 ), 741 742 (simpleEvent EVENT_MER_ENGINE_SLEEPING MerCapSleeping), 743 (simpleEvent EVENT_MER_CALLING_MAIN MerCallingMain) 744 745 ] 746 747perfParsers :: [EventParser EventInfo] 748perfParsers = [ 749 (VariableSizeParser EVENT_PERF_NAME (do -- (perf_num, name) 750 num <- get :: Get Word16 751 perfNum <- get 752 name <- getText (num - sz_perf_num) 753 return PerfName{perfNum, name} 754 )), 755 756 (FixedSizeParser EVENT_PERF_COUNTER (sz_perf_num + sz_kernel_tid + 8) (do -- (perf_num, tid, period) 757 perfNum <- get 758 tid <- get 759 period <- get 760 return PerfCounter{perfNum, tid, period} 761 )), 762 763 (FixedSizeParser EVENT_PERF_TRACEPOINT (sz_perf_num + sz_kernel_tid) (do -- (perf_num, tid) 764 perfNum <- get 765 tid <- get 766 return PerfTracepoint{perfNum, tid} 767 )) 768 ] 769 770heapProfParsers :: [EventParser EventInfo] 771heapProfParsers = 772 [ VariableSizeParser EVENT_HEAP_PROF_BEGIN $ do 773 payloadLen <- get :: Get Word16 774 heapProfId <- get 775 heapProfSamplingPeriod <- get 776 heapProfBreakdown <- get 777 heapProfModuleFilter <- getTextNul 778 heapProfClosureDescrFilter <- getTextNul 779 heapProfTypeDescrFilter <- getTextNul 780 heapProfCostCentreFilter <- getTextNul 781 heapProfCostCentreStackFilter <- getTextNul 782 heapProfRetainerFilter <- getTextNul 783 heapProfBiographyFilter <- getTextNul 784 assert 785 (fromIntegral payloadLen == sum 786 [ 1 -- heapProfId 787 , 8 -- heapProfSamplingPeriod 788 , 4 -- heapProfBreakdown 789 , textByteLen heapProfModuleFilter 790 , textByteLen heapProfClosureDescrFilter 791 , textByteLen heapProfTypeDescrFilter 792 , textByteLen heapProfCostCentreFilter 793 , textByteLen heapProfCostCentreStackFilter 794 , textByteLen heapProfRetainerFilter 795 , textByteLen heapProfBiographyFilter 796 ]) 797 (return ()) 798 return $! HeapProfBegin {..} 799 , VariableSizeParser EVENT_HEAP_PROF_COST_CENTRE $ do 800 payloadLen <- get :: Get Word16 801 heapProfCostCentreId <- get 802 heapProfLabel <- getTextNul 803 heapProfModule <- getTextNul 804 heapProfSrcLoc <- getTextNul 805 heapProfFlags <- get 806 assert 807 (fromIntegral payloadLen == sum 808 [ 4 -- heapProfCostCentreId 809 , textByteLen heapProfLabel 810 , textByteLen heapProfModule 811 , textByteLen heapProfSrcLoc 812 , 1 -- heapProfFlags 813 ]) 814 (return ()) 815 return $! HeapProfCostCentre {..} 816 , FixedSizeParser EVENT_HEAP_PROF_SAMPLE_BEGIN 8 $ do 817 heapProfSampleEra <- get 818 return $! HeapProfSampleBegin {..} 819 , FixedSizeParser EVENT_HEAP_PROF_SAMPLE_END 8 $ do 820 heapProfSampleEra <- get 821 return $! HeapProfSampleEnd {..} 822 , FixedSizeParser EVENT_HEAP_BIO_PROF_SAMPLE_BEGIN 16 $ do 823 heapProfSampleEra <- get 824 heapProfSampleTime <- get 825 return $! HeapBioProfSampleBegin {..} 826 , VariableSizeParser EVENT_HEAP_PROF_SAMPLE_COST_CENTRE $ do 827 payloadLen <- get :: Get Word16 828 heapProfId <- get 829 heapProfResidency <- get 830 heapProfStackDepth <- get 831 heapProfStack <- VU.replicateM (fromIntegral heapProfStackDepth) get 832 assert 833 ((fromIntegral payloadLen :: Int) == sum 834 [ 1 -- heapProfId 835 , 8 -- heapProfResidency 836 , 1 -- heapProfStackDepth 837 , fromIntegral heapProfStackDepth * 4 838 ]) 839 (return ()) 840 return $! HeapProfSampleCostCentre {..} 841 , VariableSizeParser EVENT_HEAP_PROF_SAMPLE_STRING $ do 842 payloadLen <- get :: Get Word16 843 heapProfId <- get 844 heapProfResidency <- get 845 heapProfLabel <- getTextNul 846 assert 847 (fromIntegral payloadLen == sum 848 [ 1 -- heapProfId 849 , 8 -- heapProfResidency 850 , textByteLen heapProfLabel 851 ]) 852 (return ()) 853 return $! HeapProfSampleString {..} 854 ] 855 856timeProfParsers :: [EventParser EventInfo] 857timeProfParsers = [ 858 FixedSizeParser EVENT_PROF_BEGIN 8 $ do 859 profTickInterval <- get 860 return $! ProfBegin{..} 861 , VariableSizeParser EVENT_PROF_SAMPLE_COST_CENTRE $ do 862 payloadLen <- get :: Get Word16 863 profCapset <- get 864 profTicks <- get 865 profStackDepth <- get 866 profCcsStack <- VU.replicateM (fromIntegral profStackDepth) get 867 assert 868 ((fromIntegral payloadLen :: Int) == sum 869 [ 4 870 , 8 -- ticks 871 , 1 -- stack depth 872 , fromIntegral profStackDepth * 4 873 ]) 874 (return ()) 875 return $! ProfSampleCostCentre {..} ] 876 877binaryEventParsers :: [EventParser EventInfo] 878binaryEventParsers = 879 [ VariableSizeParser EVENT_USER_BINARY_MSG $ do 880 payloadLen <- get :: Get Word16 881 payload <- G.getByteString $ fromIntegral payloadLen 882 return $! UserBinaryMessage { payload } 883 ] 884 885tickyParsers :: [EventParser EventInfo] 886tickyParsers = 887 [ VariableSizeParser EVENT_TICKY_COUNTER_DEF $ do 888 payloadLen <- get :: Get Word16 889 tickyCtrDefId <- get 890 tickyCtrDefArity <- get 891 tickyCtrDefKinds <- getTextNul 892 tickyCtrDefName <- getTextNul 893 assert 894 (fromIntegral payloadLen == sum 895 [ 8 -- tickyCtrDefId 896 , 2 -- tickyCtrDefArity 897 , textByteLen tickyCtrDefKinds 898 , textByteLen tickyCtrDefName 899 ]) 900 (return ()) 901 return $! TickyCounterDef{..} 902 , FixedSizeParser EVENT_TICKY_COUNTER_SAMPLE (8*4) $ do 903 tickyCtrSampleId <- get 904 tickyCtrSampleEntryCount <- get 905 tickyCtrSampleAllocs <- get 906 tickyCtrSampleAllocd <- get 907 return $! TickyCounterSample{..} 908 ] 909 910-- | String byte length in the eventlog format. It includes 911-- 1 byte for NUL. 912textByteLen :: T.Text -> Int 913textByteLen = (+1) . B.length . TE.encodeUtf8 914 915----------------------------------------------------------- 916 917putE :: Binary a => a -> PutM () 918putE = put 919 920putType :: EventTypeNum -> PutM () 921putType = putE 922 923putCap :: Int -> PutM () 924putCap c = putE (fromIntegral c :: CapNo) 925 926putMarker :: Word32 -> PutM () 927putMarker = putE 928 929putEventLog :: EventLog -> PutM () 930putEventLog (EventLog hdr es) = do 931 putHeader hdr 932 putData es 933 934putHeader :: Header -> PutM () 935putHeader (Header ets) = do 936 putMarker EVENT_HEADER_BEGIN 937 putMarker EVENT_HET_BEGIN 938 mapM_ putEventType ets 939 putMarker EVENT_HET_END 940 putMarker EVENT_HEADER_END 941 where 942 putEventType (EventType n (TE.encodeUtf8 -> d) msz) = do 943 putMarker EVENT_ET_BEGIN 944 putType n 945 putE $ fromMaybe 0xffff msz 946 putE (fromIntegral $ B.length d :: EventTypeDescLen) 947 putByteString d 948 -- the event type header allows for extra data, which we don't use: 949 putE (0 :: Word32) 950 putMarker EVENT_ET_END 951 952putData :: Data -> PutM () 953putData (Data es) = do 954 putMarker EVENT_DATA_BEGIN -- Word32 955 mapM_ putEvent es 956 putType EVENT_DATA_END -- Word16 957 958eventTypeNum :: EventInfo -> EventTypeNum 959eventTypeNum e = case e of 960 CreateThread {} -> EVENT_CREATE_THREAD 961 RunThread {} -> EVENT_RUN_THREAD 962 StopThread {} -> EVENT_STOP_THREAD 963 ThreadRunnable {} -> EVENT_THREAD_RUNNABLE 964 MigrateThread {} -> EVENT_MIGRATE_THREAD 965 Shutdown {} -> EVENT_SHUTDOWN 966 WakeupThread {} -> EVENT_THREAD_WAKEUP 967 ThreadLabel {} -> EVENT_THREAD_LABEL 968 StartGC {} -> EVENT_GC_START 969 EndGC {} -> EVENT_GC_END 970 GlobalSyncGC {} -> EVENT_GC_GLOBAL_SYNC 971 RequestSeqGC {} -> EVENT_REQUEST_SEQ_GC 972 RequestParGC {} -> EVENT_REQUEST_PAR_GC 973 CreateSparkThread {} -> EVENT_CREATE_SPARK_THREAD 974 SparkCounters {} -> EVENT_SPARK_COUNTERS 975 SparkCreate {} -> EVENT_SPARK_CREATE 976 SparkDud {} -> EVENT_SPARK_DUD 977 SparkOverflow {} -> EVENT_SPARK_OVERFLOW 978 SparkRun {} -> EVENT_SPARK_RUN 979 SparkSteal {} -> EVENT_SPARK_STEAL 980 SparkFizzle {} -> EVENT_SPARK_FIZZLE 981 SparkGC {} -> EVENT_SPARK_GC 982 TaskCreate {} -> EVENT_TASK_CREATE 983 TaskMigrate {} -> EVENT_TASK_MIGRATE 984 TaskDelete {} -> EVENT_TASK_DELETE 985 Message {} -> EVENT_LOG_MSG 986 Startup {} -> EVENT_STARTUP 987 EventBlock {} -> EVENT_BLOCK_MARKER 988 UserMessage {} -> EVENT_USER_MSG 989 UserMarker {} -> EVENT_USER_MARKER 990 GCIdle {} -> EVENT_GC_IDLE 991 GCWork {} -> EVENT_GC_WORK 992 GCDone {} -> EVENT_GC_DONE 993 GCStatsGHC{} -> EVENT_GC_STATS_GHC 994 HeapAllocated{} -> EVENT_HEAP_ALLOCATED 995 HeapSize{} -> EVENT_HEAP_SIZE 996 HeapLive{} -> EVENT_HEAP_LIVE 997 HeapInfoGHC{} -> EVENT_HEAP_INFO_GHC 998 CapCreate{} -> EVENT_CAP_CREATE 999 CapDelete{} -> EVENT_CAP_DELETE 1000 CapDisable{} -> EVENT_CAP_DISABLE 1001 CapEnable{} -> EVENT_CAP_ENABLE 1002 CapsetCreate {} -> EVENT_CAPSET_CREATE 1003 CapsetDelete {} -> EVENT_CAPSET_DELETE 1004 CapsetAssignCap {} -> EVENT_CAPSET_ASSIGN_CAP 1005 CapsetRemoveCap {} -> EVENT_CAPSET_REMOVE_CAP 1006 RtsIdentifier {} -> EVENT_RTS_IDENTIFIER 1007 ProgramArgs {} -> EVENT_PROGRAM_ARGS 1008 ProgramEnv {} -> EVENT_PROGRAM_ENV 1009 OsProcessPid {} -> EVENT_OSPROCESS_PID 1010 OsProcessParentPid{} -> EVENT_OSPROCESS_PPID 1011 WallClockTime{} -> EVENT_WALL_CLOCK_TIME 1012 UnknownEvent {} -> error "eventTypeNum UnknownEvent" 1013 InternString {} -> EVENT_INTERN_STRING 1014 Version {} -> EVENT_VERSION 1015 ProgramInvocation {} -> EVENT_PROGRAM_INVOCATION 1016 EdenStartReceive {} -> EVENT_EDEN_START_RECEIVE 1017 EdenEndReceive {} -> EVENT_EDEN_END_RECEIVE 1018 CreateProcess {} -> EVENT_CREATE_PROCESS 1019 KillProcess {} -> EVENT_KILL_PROCESS 1020 AssignThreadToProcess {} -> EVENT_ASSIGN_THREAD_TO_PROCESS 1021 CreateMachine {} -> EVENT_CREATE_MACHINE 1022 KillMachine {} -> EVENT_KILL_MACHINE 1023 SendMessage {} -> EVENT_SEND_MESSAGE 1024 ReceiveMessage {} -> EVENT_RECEIVE_MESSAGE 1025 SendReceiveLocalMessage {} -> EVENT_SEND_RECEIVE_LOCAL_MESSAGE 1026 MerStartParConjunction {} -> EVENT_MER_START_PAR_CONJUNCTION 1027 MerEndParConjunction _ -> EVENT_MER_STOP_PAR_CONJUNCTION 1028 MerEndParConjunct _ -> EVENT_MER_STOP_PAR_CONJUNCT 1029 MerCreateSpark {} -> EVENT_MER_CREATE_SPARK 1030 MerFutureCreate {} -> EVENT_MER_FUT_CREATE 1031 MerFutureWaitNosuspend _ -> EVENT_MER_FUT_WAIT_NOSUSPEND 1032 MerFutureWaitSuspended _ -> EVENT_MER_FUT_WAIT_SUSPENDED 1033 MerFutureSignal _ -> EVENT_MER_FUT_SIGNAL 1034 MerLookingForGlobalThread -> EVENT_MER_LOOKING_FOR_GLOBAL_CONTEXT 1035 MerWorkStealing -> EVENT_MER_WORK_STEALING 1036 MerLookingForLocalSpark -> EVENT_MER_LOOKING_FOR_LOCAL_SPARK 1037 MerReleaseThread _ -> EVENT_MER_RELEASE_CONTEXT 1038 MerCapSleeping -> EVENT_MER_ENGINE_SLEEPING 1039 MerCallingMain -> EVENT_MER_CALLING_MAIN 1040 PerfName {} -> nEVENT_PERF_NAME 1041 PerfCounter {} -> nEVENT_PERF_COUNTER 1042 PerfTracepoint {} -> nEVENT_PERF_TRACEPOINT 1043 HeapProfBegin {} -> EVENT_HEAP_PROF_BEGIN 1044 HeapProfCostCentre {} -> EVENT_HEAP_PROF_COST_CENTRE 1045 HeapProfSampleBegin {} -> EVENT_HEAP_PROF_SAMPLE_BEGIN 1046 HeapProfSampleEnd {} -> EVENT_HEAP_PROF_SAMPLE_END 1047 HeapBioProfSampleBegin {} -> EVENT_HEAP_BIO_PROF_SAMPLE_BEGIN 1048 HeapProfSampleCostCentre {} -> EVENT_HEAP_PROF_SAMPLE_COST_CENTRE 1049 HeapProfSampleString {} -> EVENT_HEAP_PROF_SAMPLE_STRING 1050 ProfSampleCostCentre {} -> EVENT_PROF_SAMPLE_COST_CENTRE 1051 ProfBegin {} -> EVENT_PROF_BEGIN 1052 UserBinaryMessage {} -> EVENT_USER_BINARY_MSG 1053 ConcMarkBegin {} -> EVENT_CONC_MARK_BEGIN 1054 ConcMarkEnd {} -> EVENT_CONC_MARK_END 1055 ConcSyncBegin {} -> EVENT_CONC_SYNC_BEGIN 1056 ConcSyncEnd {} -> EVENT_CONC_SYNC_END 1057 ConcSweepBegin {} -> EVENT_CONC_SWEEP_BEGIN 1058 ConcSweepEnd {} -> EVENT_CONC_SWEEP_END 1059 ConcUpdRemSetFlush {} -> EVENT_CONC_UPD_REM_SET_FLUSH 1060 NonmovingHeapCensus {} -> EVENT_NONMOVING_HEAP_CENSUS 1061 TickyCounterDef {} -> EVENT_TICKY_COUNTER_DEF 1062 TickyCounterSample {} -> EVENT_TICKY_COUNTER_SAMPLE 1063 1064nEVENT_PERF_NAME, nEVENT_PERF_COUNTER, nEVENT_PERF_TRACEPOINT :: EventTypeNum 1065nEVENT_PERF_NAME = EVENT_PERF_NAME 1066nEVENT_PERF_COUNTER = EVENT_PERF_COUNTER 1067nEVENT_PERF_TRACEPOINT = EVENT_PERF_TRACEPOINT 1068 1069putEvent :: Event -> PutM () 1070putEvent Event {..} = do 1071 putType (eventTypeNum evSpec) 1072 put evTime 1073 putEventSpec evSpec 1074 1075putEventSpec :: EventInfo -> PutM () 1076putEventSpec (Startup caps) = do 1077 putCap (fromIntegral caps) 1078 1079putEventSpec (EventBlock end cap sz) = do 1080 putE (fromIntegral (sz+24) :: BlockSize) 1081 putE end 1082 putE (fromIntegral cap :: CapNo) 1083 1084putEventSpec (CreateThread t) = 1085 putE t 1086 1087putEventSpec (RunThread t) = 1088 putE t 1089 1090-- here we assume that ThreadStopStatus fromEnum matches the definitions in 1091-- EventLogFormat.h 1092-- The standard encoding is used here, which is wrong for eventlogs 1093-- produced by GHC-7.8.2 ([Stop status in GHC-7.8.2] in EventTypes.hs 1094putEventSpec (StopThread t s) = do 1095 putE t 1096 putE $ case s of 1097 NoStatus -> 0 :: Word16 1098 HeapOverflow -> 1 1099 StackOverflow -> 2 1100 ThreadYielding -> 3 1101 ThreadBlocked -> 4 1102 ThreadFinished -> 5 1103 ForeignCall -> 6 1104 BlockedOnMVar -> 7 1105 BlockedOnMVarRead -> 20 -- since GHC-7.8.3 1106 BlockedOnBlackHole -> 8 1107 BlockedOnBlackHoleOwnedBy _ -> 8 1108 BlockedOnRead -> 9 1109 BlockedOnWrite -> 10 1110 BlockedOnDelay -> 11 1111 BlockedOnSTM -> 12 1112 BlockedOnDoProc -> 13 1113 BlockedOnCCall -> 14 1114 BlockedOnCCall_NoUnblockExc -> 15 1115 BlockedOnMsgThrowTo -> 16 1116 ThreadMigrating -> 17 1117 BlockedOnMsgGlobalise -> 18 1118 putE $ case s of 1119 BlockedOnBlackHoleOwnedBy i -> i 1120 _ -> 0 1121 1122putEventSpec (ThreadRunnable t) = 1123 putE t 1124 1125putEventSpec (MigrateThread t c) = do 1126 putE t 1127 putCap c 1128 1129putEventSpec (CreateSparkThread t) = 1130 putE t 1131 1132putEventSpec (SparkCounters crt dud ovf cnv fiz gcd rem) = do 1133 putE crt 1134 putE dud 1135 putE ovf 1136 putE cnv 1137 -- Warning: order of fiz and gcd reversed! 1138 putE gcd 1139 putE fiz 1140 putE rem 1141 1142putEventSpec SparkCreate = 1143 return () 1144 1145putEventSpec SparkDud = 1146 return () 1147 1148putEventSpec SparkOverflow = 1149 return () 1150 1151putEventSpec SparkRun = 1152 return () 1153 1154putEventSpec (SparkSteal c) = 1155 putCap c 1156 1157putEventSpec SparkFizzle = 1158 return () 1159 1160putEventSpec SparkGC = 1161 return () 1162 1163putEventSpec (WakeupThread t c) = do 1164 putE t 1165 putCap c 1166 1167putEventSpec (ThreadLabel t (TE.encodeUtf8 -> l)) = do 1168 putE (fromIntegral (B.length l) + sz_tid :: Word16) 1169 putE t 1170 putByteString l 1171 1172putEventSpec Shutdown = 1173 return () 1174 1175putEventSpec RequestSeqGC = 1176 return () 1177 1178putEventSpec RequestParGC = 1179 return () 1180 1181putEventSpec StartGC = 1182 return () 1183 1184putEventSpec GCWork = 1185 return () 1186 1187putEventSpec GCIdle = 1188 return () 1189 1190putEventSpec GCDone = 1191 return () 1192 1193putEventSpec EndGC = 1194 return () 1195 1196putEventSpec GlobalSyncGC = 1197 return () 1198 1199putEventSpec (TaskCreate taskId cap tid) = do 1200 putE taskId 1201 putCap cap 1202 putE tid 1203 1204putEventSpec (TaskMigrate taskId cap new_cap) = do 1205 putE taskId 1206 putCap cap 1207 putCap new_cap 1208 1209putEventSpec (TaskDelete taskId) = 1210 putE taskId 1211 1212putEventSpec GCStatsGHC{..} = do 1213 putE heapCapset 1214 putE (fromIntegral gen :: Word16) 1215 putE copied 1216 putE slop 1217 putE frag 1218 putE (fromIntegral parNThreads :: Word32) 1219 putE parMaxCopied 1220 putE parTotCopied 1221 case parBalancedCopied of 1222 Nothing -> return () 1223 Just v -> putE v 1224 1225putEventSpec HeapAllocated{..} = do 1226 putE heapCapset 1227 putE allocBytes 1228 1229putEventSpec HeapSize{..} = do 1230 putE heapCapset 1231 putE sizeBytes 1232 1233putEventSpec HeapLive{..} = do 1234 putE heapCapset 1235 putE liveBytes 1236 1237putEventSpec HeapInfoGHC{..} = do 1238 putE heapCapset 1239 putE (fromIntegral gens :: Word16) 1240 putE maxHeapSize 1241 putE allocAreaSize 1242 putE mblockSize 1243 putE blockSize 1244 1245putEventSpec CapCreate{cap} = 1246 putCap cap 1247 1248putEventSpec CapDelete{cap} = 1249 putCap cap 1250 1251putEventSpec CapDisable{cap} = 1252 putCap cap 1253 1254putEventSpec CapEnable{cap} = 1255 putCap cap 1256 1257putEventSpec (CapsetCreate cs ct) = do 1258 putE cs 1259 putE $ case ct of 1260 CapsetCustom -> 1 :: Word16 1261 CapsetOsProcess -> 2 1262 CapsetClockDomain -> 3 1263 CapsetUnknown -> 0 1264 1265putEventSpec (CapsetDelete cs) = 1266 putE cs 1267 1268putEventSpec (CapsetAssignCap cs cp) = do 1269 putE cs 1270 putCap cp 1271 1272putEventSpec (CapsetRemoveCap cs cp) = do 1273 putE cs 1274 putCap cp 1275 1276putEventSpec (RtsIdentifier cs (TE.encodeUtf8 -> rts)) = do 1277 putE (fromIntegral (B.length rts) + sz_capset :: Word16) 1278 putE cs 1279 putByteString rts 1280 1281putEventSpec (ProgramArgs cs (map TE.encodeUtf8 -> as)) = do 1282 let sz_args = sum (map ((+ 1) {- for \0 -} . B.length) as) - 1 1283 putE (fromIntegral sz_args + sz_capset :: Word16) 1284 putE cs 1285 mapM_ putByteString (intersperse "\0" as) 1286 1287putEventSpec (ProgramEnv cs (map TE.encodeUtf8 -> es)) = do 1288 let sz_env = sum (map ((+ 1) {- for \0 -} . B.length) es) - 1 1289 putE (fromIntegral sz_env + sz_capset :: Word16) 1290 putE cs 1291 mapM_ putByteString $ intersperse "\0" es 1292 1293putEventSpec (OsProcessPid cs pid) = do 1294 putE cs 1295 putE pid 1296 1297putEventSpec (OsProcessParentPid cs ppid) = do 1298 putE cs 1299 putE ppid 1300 1301putEventSpec (WallClockTime cs sec nsec) = do 1302 putE cs 1303 putE sec 1304 putE nsec 1305 1306putEventSpec (Message (TE.encodeUtf8 -> s)) = do 1307 putE (fromIntegral (B.length s) :: Word16) 1308 putByteString s 1309 1310putEventSpec (UserMessage (TE.encodeUtf8 -> s)) = do 1311 putE (fromIntegral (B.length s) :: Word16) 1312 putByteString s 1313 1314putEventSpec (UserMarker (TE.encodeUtf8 -> s)) = do 1315 putE (fromIntegral (B.length s) :: Word16) 1316 putByteString s 1317 1318putEventSpec (UnknownEvent {}) = error "putEventSpec UnknownEvent" 1319 1320putEventSpec (InternString str id) = do 1321 putE len 1322 mapM_ putE str 1323 putE id 1324 where len = (fromIntegral (length str) :: Word16) + sz_string_id 1325 1326putEventSpec (Version s) = do 1327 putE (fromIntegral (length s) :: Word16) 1328 mapM_ putE s 1329 1330putEventSpec (ProgramInvocation s) = do 1331 putE (fromIntegral (length s) :: Word16) 1332 mapM_ putE s 1333 1334putEventSpec ( EdenStartReceive ) = return () 1335 1336putEventSpec ( EdenEndReceive ) = return () 1337 1338putEventSpec ( CreateProcess process ) = do 1339 putE process 1340 1341putEventSpec ( KillProcess process ) = do 1342 putE process 1343 1344putEventSpec ( AssignThreadToProcess thread process ) = do 1345 putE thread 1346 putE process 1347 1348putEventSpec ( CreateMachine machine realtime ) = do 1349 putE machine 1350 putE realtime 1351 1352putEventSpec ( KillMachine machine ) = do 1353 putE machine 1354 1355putEventSpec ( SendMessage mesTag senderProcess senderThread 1356 receiverMachine receiverProcess receiverInport ) = do 1357 putE (fromMsgTag mesTag) 1358 putE senderProcess 1359 putE senderThread 1360 putE receiverMachine 1361 putE receiverProcess 1362 putE receiverInport 1363 1364putEventSpec ( ReceiveMessage mesTag receiverProcess receiverInport 1365 senderMachine senderProcess senderThread messageSize ) = do 1366 putE (fromMsgTag mesTag) 1367 putE receiverProcess 1368 putE receiverInport 1369 putE senderMachine 1370 putE senderProcess 1371 putE senderThread 1372 putE messageSize 1373 1374putEventSpec ( SendReceiveLocalMessage mesTag senderProcess senderThread 1375 receiverProcess receiverInport ) = do 1376 putE (fromMsgTag mesTag) 1377 putE senderProcess 1378 putE senderThread 1379 putE receiverProcess 1380 putE receiverInport 1381 1382putEventSpec (MerStartParConjunction dyn_id static_id) = do 1383 putE dyn_id 1384 putE static_id 1385 1386putEventSpec (MerEndParConjunction dyn_id) = 1387 putE dyn_id 1388 1389putEventSpec (MerEndParConjunct dyn_id) = 1390 putE dyn_id 1391 1392putEventSpec (MerCreateSpark dyn_id spark_id) = do 1393 putE dyn_id 1394 putE spark_id 1395 1396putEventSpec (MerFutureCreate future_id name_id) = do 1397 putE future_id 1398 putE name_id 1399 1400putEventSpec (MerFutureWaitNosuspend future_id) = 1401 putE future_id 1402 1403putEventSpec (MerFutureWaitSuspended future_id) = 1404 putE future_id 1405 1406putEventSpec (MerFutureSignal future_id) = 1407 putE future_id 1408 1409putEventSpec MerLookingForGlobalThread = return () 1410putEventSpec MerWorkStealing = return () 1411putEventSpec MerLookingForLocalSpark = return () 1412 1413putEventSpec (MerReleaseThread thread_id) = 1414 putE thread_id 1415 1416putEventSpec MerCapSleeping = return () 1417putEventSpec MerCallingMain = return () 1418 1419putEventSpec PerfName{name = (TE.encodeUtf8 -> name), ..} = do 1420 putE (fromIntegral (B.length name) + sz_perf_num :: Word16) 1421 putE perfNum 1422 putByteString name 1423 1424putEventSpec PerfCounter{..} = do 1425 putE perfNum 1426 putE tid 1427 putE period 1428 1429putEventSpec PerfTracepoint{..} = do 1430 putE perfNum 1431 putE tid 1432 1433putEventSpec HeapProfBegin {..} = do 1434 putE heapProfId 1435 putE heapProfSamplingPeriod 1436 putE heapProfBreakdown 1437 mapM_ (putE . T.unpack) 1438 [ heapProfModuleFilter 1439 , heapProfClosureDescrFilter 1440 , heapProfTypeDescrFilter 1441 , heapProfCostCentreFilter 1442 , heapProfCostCentreStackFilter 1443 , heapProfRetainerFilter 1444 , heapProfBiographyFilter 1445 ] 1446 1447putEventSpec HeapProfCostCentre {..} = do 1448 putE heapProfCostCentreId 1449 putE $ T.unpack heapProfLabel 1450 putE $ T.unpack heapProfModule 1451 putE $ T.unpack heapProfSrcLoc 1452 putE heapProfFlags 1453 1454putEventSpec HeapProfSampleBegin {..} = 1455 putE heapProfSampleEra 1456 1457putEventSpec HeapProfSampleEnd {..} = 1458 putE heapProfSampleEra 1459 1460putEventSpec HeapBioProfSampleBegin {..} = do 1461 putE heapProfSampleEra 1462 putE heapProfSampleTime 1463 1464 1465putEventSpec HeapProfSampleCostCentre {..} = do 1466 putE heapProfId 1467 putE heapProfResidency 1468 putE heapProfStackDepth 1469 VU.mapM_ putE heapProfStack 1470 1471putEventSpec HeapProfSampleString {..} = do 1472 putE heapProfId 1473 putE heapProfResidency 1474 putE $ T.unpack heapProfLabel 1475 1476putEventSpec ProfSampleCostCentre {..} = do 1477 putE profCapset 1478 putE profTicks 1479 putE profStackDepth 1480 VU.mapM_ putE profCcsStack 1481 1482putEventSpec ProfBegin {..} = do 1483 putE profTickInterval 1484 1485putEventSpec UserBinaryMessage {..} = do 1486 putE (fromIntegral (B.length payload) :: Word16) 1487 putByteString payload 1488 1489putEventSpec ConcMarkBegin = return () 1490putEventSpec ConcMarkEnd {..} = do 1491 putE concMarkedObjectCount 1492putEventSpec ConcSyncBegin = return () 1493putEventSpec ConcSyncEnd = return () 1494putEventSpec ConcSweepBegin = return () 1495putEventSpec ConcSweepEnd = return () 1496putEventSpec ConcUpdRemSetFlush {..} = do 1497 putCap cap 1498putEventSpec NonmovingHeapCensus {..} = do 1499 putE nonmovingCensusBlkSize 1500 putE nonmovingCensusActiveSegs 1501 putE nonmovingCensusFilledSegs 1502 putE nonmovingCensusLiveBlocks 1503putEventSpec TickyCounterDef {..} = do 1504 putE tickyCtrDefId 1505 putE tickyCtrDefArity 1506 putE (T.unpack tickyCtrDefKinds) 1507 putE (T.unpack tickyCtrDefName) 1508putEventSpec TickyCounterSample {..} = do 1509 putE tickyCtrSampleId 1510 putE tickyCtrSampleEntryCount 1511 putE tickyCtrSampleAllocs 1512 putE tickyCtrSampleAllocd 1513