threadscope-0.2.1: Events/EventTree.hs
module Events.EventTree (
DurationTree(..),
mkDurationTree,
runTimeOf, gcTimeOf,
reportDurationTree,
durationTreeCountNodes,
durationTreeMaxDepth,
EventTree(..), EventNode(..),
mkEventTree,
reportEventTree, eventTreeMaxDepth,
) where
import Events.EventDuration
import qualified GHC.RTS.Events as GHC
import GHC.RTS.Events hiding (Event)
import Text.Printf
import Control.Exception (assert)
-------------------------------------------------------------------------------
-- We map the events onto a binary search tree, so that we can easily
-- find the events that correspond to a particular view of the
-- timeline. Additionally, each node of the tree contains a summary
-- of the information below it, so that we can render views at various
-- levels of resolution. For example, if a tree node would represent
-- less than one pixel on the display, there is no point is descending
-- the tree further.
-- We only split at event boundaries; we never split an event into
-- multiple pieces. Therefore, the binary tree is only roughly split
-- by time, the actual split depends on the distribution of events
-- below it.
data DurationTree
= DurationSplit
{-#UNPACK#-}!Timestamp -- The start time of this run-span
{-#UNPACK#-}!Timestamp -- The time used to split the events into two parts
{-#UNPACK#-}!Timestamp -- The end time of this run-span
DurationTree -- The LHS split; all events lie completely between
-- start and split
DurationTree -- The RHS split; all events lie completely between
-- split and end
{-#UNPACK#-}!Timestamp -- The total amount of time spent running a thread
{-#UNPACK#-}!Timestamp -- The total amount of time spend in GC
| DurationTreeLeaf
EventDuration
| DurationTreeEmpty
deriving Show
-------------------------------------------------------------------------------
mkDurationTree :: [EventDuration] -> Timestamp -> DurationTree
mkDurationTree es endTime =
-- trace (show tree) $
tree
where
tree = splitDurations es endTime
splitDurations :: [EventDuration] -- events
-> Timestamp -- end time of last event in the list
-> DurationTree
splitDurations [] _endTime =
-- if len /= 0 then error "splitDurations0" else
DurationTreeEmpty -- The case for an empty list of events.
splitDurations [e] _entTime =
DurationTreeLeaf e
splitDurations es endTime
| null rhs
= splitDurations es lhs_end
| null lhs
= error $
printf "splitDurations: null lhs: len = %d, startTime = %d, endTime = %d\n"
(length es) startTime endTime
++ '\n': show es
| otherwise
= -- trace (printf "len = %d, startTime = %d, endTime = %d, lhs_len = %d\n" len startTime endTime lhs_len) $
assert (length lhs + length rhs == length es) $
DurationSplit startTime
lhs_end
endTime
ltree
rtree
runTime
gcTime
where
startTime = startTimeOf (head es)
splitTime = startTime + (endTime - startTime) `div` 2
(lhs, lhs_end, rhs) = splitDurationList es [] splitTime 0
ltree = splitDurations lhs lhs_end
rtree = splitDurations rhs endTime
runTime = runTimeOf ltree + runTimeOf rtree
gcTime = gcTimeOf ltree + gcTimeOf rtree
splitDurationList :: [EventDuration]
-> [EventDuration]
-> Timestamp
-> Timestamp
-> ([EventDuration], Timestamp, [EventDuration])
splitDurationList [] acc !_tsplit !tmax
= (reverse acc, tmax, [])
splitDurationList [e] acc !_tsplit !tmax
-- Just one event left: put it on the right. This ensures that we
-- have at least one event on each side of the split.
= (reverse acc, tmax, [e])
splitDurationList (e:es) acc !tsplit !tmax
| tstart <= tsplit -- pick all events that start at or before the split
= splitDurationList es (e:acc) tsplit (max tmax tend)
| otherwise
= (reverse acc, tmax, e:es)
where
tstart = startTimeOf e
tend = endTimeOf e
-------------------------------------------------------------------------------
runTimeOf :: DurationTree -> Timestamp
runTimeOf (DurationSplit _ _ _ _ _ runTime _) = runTime
runTimeOf (DurationTreeLeaf e) | ThreadRun{} <- e = durationOf e
runTimeOf _ = 0
-------------------------------------------------------------------------------
gcTimeOf :: DurationTree -> Timestamp
gcTimeOf (DurationSplit _ _ _ _ _ _ gcTime) = gcTime
gcTimeOf (DurationTreeLeaf e) | isGCDuration e = durationOf e
gcTimeOf _ = 0
-------------------------------------------------------------------------------
reportDurationTree :: Int -> DurationTree -> IO ()
reportDurationTree hecNumber eventTree
= putStrLn ("HEC " ++ show hecNumber ++ reportText)
where
reportText = " nodes = " ++ show (durationTreeCountNodes eventTree) ++
" max depth = " ++ show (durationTreeMaxDepth eventTree)
-------------------------------------------------------------------------------
durationTreeCountNodes :: DurationTree -> Int
durationTreeCountNodes (DurationSplit _ _ _ lhs rhs _ _)
= 1 + durationTreeCountNodes lhs + durationTreeCountNodes rhs
durationTreeCountNodes _ = 1
-------------------------------------------------------------------------------
durationTreeMaxDepth :: DurationTree -> Int
durationTreeMaxDepth (DurationSplit _ _ _ lhs rhs _ _)
= 1 + durationTreeMaxDepth lhs `max` durationTreeMaxDepth rhs
durationTreeMaxDepth _ = 1
-------------------------------------------------------------------------------
data EventTree
= EventTree
{-#UNPACK#-}!Timestamp -- The start time of this run-span
{-#UNPACK#-}!Timestamp -- The end time of this run-span
EventNode
data EventNode
= EventSplit
{-#UNPACK#-}!Timestamp -- The time used to split the events into two parts
EventNode -- The LHS split; all events lie completely between
-- start and split
EventNode -- The RHS split; all events lie completely between
-- split and end
| EventTreeLeaf [GHC.Event]
-- sometimes events happen "simultaneously" (at the same time
-- given the resolution of our clock source), so we can't
-- separate them.
| EventTreeOne GHC.Event
-- This is a space optimisation for the common case of
-- EventTreeLeaf [e].
mkEventTree :: [GHC.Event] -> Timestamp -> EventTree
mkEventTree es endTime =
EventTree s e $
-- trace (show tree) $
tree
where
tree = splitEvents es endTime
(s,e) = if null es then (0,0) else (time (head es), endTime)
splitEvents :: [GHC.Event] -- events
-> Timestamp -- end time of last event in the list
-> EventNode
splitEvents [] !_endTime =
-- if len /= 0 then error "splitEvents0" else
EventTreeLeaf [] -- The case for an empty list of events
splitEvents [e] !_endTime =
EventTreeOne e
splitEvents es !endTime
| duration == 0
= EventTreeLeaf es
| null rhs
= splitEvents es lhs_end
| null lhs
= error $
printf "splitEvents: null lhs: len = %d, startTime = %d, endTime = %d\n"
(length es) startTime endTime
++ '\n': show es
| otherwise
= -- trace (printf "len = %d, startTime = %d, endTime = %d, lhs_len = %d\n" len startTime endTime lhs_len) $
assert (length lhs + length rhs == length es) $
EventSplit (time (head rhs))
ltree
rtree
where
-- | Integer division, rounding up.
divUp :: Timestamp -> Timestamp -> Timestamp
divUp n k = (n + k - 1) `div` k
startTime = time (head es)
splitTime = startTime + (endTime - startTime) `divUp` 2
duration = endTime - startTime
(lhs, lhs_end, rhs) = splitEventList es [] splitTime 0
ltree = splitEvents lhs lhs_end
rtree = splitEvents rhs endTime
splitEventList :: [GHC.Event]
-> [GHC.Event]
-> Timestamp
-> Timestamp
-> ([GHC.Event], Timestamp, [GHC.Event])
splitEventList [] acc !_tsplit !tmax
= (reverse acc, tmax, [])
splitEventList [e] acc !_tsplit !tmax
-- Just one event left: put it on the right. This ensures that we
-- have at least one event on each side of the split.
= (reverse acc, tmax, [e])
splitEventList (e:es) acc !tsplit !tmax
| t <= tsplit -- pick all events that start at or before the split
= splitEventList es (e:acc) tsplit (max tmax t)
| otherwise
= (reverse acc, tmax, e:es)
where
t = time e
-------------------------------------------------------------------------------
reportEventTree :: Int -> EventTree -> IO ()
reportEventTree hecNumber (EventTree _ _ eventTree)
= putStrLn ("HEC " ++ show hecNumber ++ reportText)
where
reportText = " nodes = " ++ show (eventTreeCountNodes eventTree) ++
" max depth = " ++ show (eventNodeMaxDepth eventTree)
-------------------------------------------------------------------------------
eventTreeCountNodes :: EventNode -> Int
eventTreeCountNodes (EventSplit _ lhs rhs)
= 1 + eventTreeCountNodes lhs + eventTreeCountNodes rhs
eventTreeCountNodes _ = 1
-------------------------------------------------------------------------------
eventTreeMaxDepth :: EventTree -> Int
eventTreeMaxDepth (EventTree _ _ t) = eventNodeMaxDepth t
eventNodeMaxDepth :: EventNode -> Int
eventNodeMaxDepth (EventSplit _ lhs rhs)
= 1 + eventNodeMaxDepth lhs `max` eventNodeMaxDepth rhs
eventNodeMaxDepth _ = 1