ghc-events 0.0.1 → 0.1
raw patch · 3 files changed
+75/−50 lines, 3 files
Files
- GHC/RTS/Events.hs +71/−6
- ShowGhcEvents.hs +3/−43
- ghc-events.cabal +1/−1
GHC/RTS/Events.hs view
@@ -17,10 +17,15 @@ Data(..), Timestamp, ThreadId,+ -- * Reading an event log from a file readEventLogFromFile,+ -- * Utilities- CapEvent(..), sortEvents, groupEvents+ CapEvent(..), sortEvents, groupEvents, sortGroups,++ -- * Printing+ showEventTypeSpecificInfo, showThreadStopStatus ) where {- Libraries. -}@@ -37,6 +42,7 @@ import Data.Function import Data.List import Data.Either+import Text.Printf #define EVENTLOG_CONSTANTS_ONLY #include "EventLogFormat.h"@@ -126,6 +132,7 @@ | StartGC { } | EndGC { } | Message { msg :: String }+ | UserMessage { msg :: String } | UnknownEvent deriving Show @@ -283,6 +290,11 @@ bytes <- replicateM (fromIntegral num) getE return Message{ msg = map (chr . fromIntegral) (bytes :: [Word8]) } + EVENT_USER_MSG -> do -- (msg)+ num <- getE :: GetEvents Word16+ bytes <- replicateM (fromIntegral num) getE + return UserMessage{ msg = map (chr . fromIntegral) (bytes :: [Word8]) }+ other -> do -- unrecognised event, just skip it etypes <- ask case M.lookup (fromIntegral other) etypes of@@ -305,7 +317,7 @@ getEvents events = do mb_e <- getEvent case mb_e of- Nothing -> return (Data events)+ Nothing -> return (Data (reverse events)) Just e -> getEvents (e:events) getEventBlock :: GetEvents [Event]@@ -342,11 +354,15 @@ ce_event :: Event } +sortEvents :: [Event] -> [CapEvent]+sortEvents = sortGroups . groupEvents+ -- | Sort the raw event stream by time, annotating each event with the -- capability that generated it.-sortEvents :: [Event] -> [CapEvent]-sortEvents raw = mergesort' (compare `on` (time . ce_event)) $- [ map (CapEvent cap) es | (cap, es) <- groupEvents raw ]+sortGroups :: [(Maybe Int, [Event])] -> [CapEvent]+sortGroups groups = mergesort' (compare `on` (time . ce_event)) $+ [ [ CapEvent cap e | e <- es ] + | (cap, es) <- groups ] -- sorting is made much faster by the way that the event stream is -- divided into blocks of events. -- - All events in a block belong to a particular capability@@ -360,7 +376,7 @@ groupEvents :: [Event] -> [(Maybe Int, [Event])] groupEvents es = (Nothing, n_events) : - [ (Just (cap (head blocks)), concat (map block_events blocks))+ [ (Just (cap (head blocks)), concatMap block_events blocks) | blocks <- groups ] where (blocks, anon_events) = partitionEithers (map separate es)@@ -396,3 +412,52 @@ GT -> y : merge cmp (x:xs) ys _ -> x : merge cmp xs (y:ys) +-----------------------------------------------------------------------------+-- Some pretty-printing support++showEventTypeSpecificInfo :: EventTypeSpecificInfo -> String+showEventTypeSpecificInfo spec =+ case spec of+ Startup n_caps ->+ printf "startup: %d capabilities" n_caps+ EventBlock end_time cap _block_events ->+ printf "event block: cap %d, end time: %d\n" cap end_time+ CreateThread thread ->+ printf "creating thread %d" thread+ RunThread thread ->+ printf "running thread %d" thread+ StopThread thread status ->+ printf "stopping thread %d (%s)" thread (showThreadStopStatus status)+ ThreadRunnable thread ->+ printf "thread %d is runnable" thread+ MigrateThread thread newCap ->+ printf "migrating thread %d to cap %d" thread newCap+ RunSpark thread ->+ printf "running a local spark (thread %d)" thread+ StealSpark thread victimCap ->+ printf "thread %d stealing a spark from cap %d" thread victimCap+ CreateSparkThread sparkThread ->+ printf "creating spark thread %d" sparkThread+ Shutdown ->+ printf "shutting down"+ WakeupThread thread otherCap ->+ printf "waking up thread %d on cap %d" thread otherCap+ RequestSeqGC ->+ printf "requesting sequential GC"+ RequestParGC ->+ printf "requesting parallel GC"+ StartGC ->+ printf "starting GC"+ EndGC ->+ printf "finished GC"+ _ ->+ printf "unknown event type"+++showThreadStopStatus :: ThreadStopStatus -> String+showThreadStopStatus HeapOverflow = "heap overflow"+showThreadStopStatus StackOverflow = "stack overflow"+showThreadStopStatus ThreadYielding = "thread yielding"+showThreadStopStatus ThreadBlocked = "thread blocked"+showThreadStopStatus ThreadFinished = "thread finished"+showThreadStopStatus ForeignCall = "making a foreign call"
ShowGhcEvents.hs view
@@ -27,7 +27,7 @@ let imap = M.fromList [ (fromIntegral (Log.num t),t) | t <- etypes ] let pes = Log.events (Log.dat log)- sorted = sortEvents (reverse pes)+ sorted = sortEvents pes -- the events come out reversed, and we want a stable sort printf "Events:\n"@@ -57,46 +57,6 @@ printf (Log.desc (fromJust (M.lookup (fromIntegral ref) imap))) Message msg -> msg-- other ->- case spec of- Startup n_caps ->- printf "startup: %d capabilities" n_caps- EventBlock end_time cap block_events ->- printf "event block: cap %d, end time: %d\n" cap end_time- CreateThread thread -> - printf "creating thread %d" thread- RunThread thread -> - printf "running thread %d" thread- StopThread thread status -> - printf "stopping thread %d (%s)" thread (showThreadStopStatus status)- ThreadRunnable thread -> - printf "thread %d is runnable" thread- MigrateThread thread newCap -> - printf "migrating thread %d to cap %d" thread newCap- RunSpark thread -> - printf "running a local spark (thread %d)" thread- StealSpark thread victimCap -> - printf "thread %d stealing a spark from cap %d" thread victimCap - CreateSparkThread sparkThread -> - printf "creating spark thread %d" sparkThread- Shutdown -> - printf "shutting down"- WakeupThread thread otherCap -> - printf "waking up thread %d on cap %d" thread otherCap- RequestSeqGC -> - printf "requesting sequential GC"- RequestParGC -> - printf "requesting parallel GC"- StartGC -> - printf "starting GC"- EndGC -> - printf "finished GC"+ UserMessage msg -> msg -showThreadStopStatus :: ThreadStopStatus -> String-showThreadStopStatus HeapOverflow = "heap overflow"-showThreadStopStatus StackOverflow = "stack overflow"-showThreadStopStatus ThreadYielding = "thread yielding"-showThreadStopStatus ThreadBlocked = "thread blocked"-showThreadStopStatus ThreadFinished = "thread finished"-showThreadStopStatus ForeignCall = "making a foreign call"+ other -> showEventTypeSpecificInfo spec
ghc-events.cabal view
@@ -1,5 +1,5 @@ name: ghc-events-version: 0.0.1+version: 0.1 synopsis: Library and tool for parsing .eventlog files from GHC description: Parses .eventlog files emitted by GHC 6.12.1 and later. Includes the show-ghc-events tool to dump an event