1module Events.EventTree ( 2 DurationTree(..), 3 mkDurationTree, 4 5 runTimeOf, gcTimeOf, 6 reportDurationTree, 7 durationTreeCountNodes, 8 durationTreeMaxDepth, 9 10 EventTree(..), EventNode(..), 11 mkEventTree, 12 reportEventTree, eventTreeMaxDepth, 13 ) where 14 15import Events.EventDuration 16 17import GHC.RTS.Events hiding (Event) 18import qualified GHC.RTS.Events as GHC 19 20import Control.Exception (assert) 21import Text.Printf 22 23------------------------------------------------------------------------------- 24 25-- We map the events onto a binary search tree, so that we can easily 26-- find the events that correspond to a particular view of the 27-- timeline. Additionally, each node of the tree contains a summary 28-- of the information below it, so that we can render views at various 29-- levels of resolution. For example, if a tree node would represent 30-- less than one pixel on the display, there is no point is descending 31-- the tree further. 32 33-- We only split at event boundaries; we never split an event into 34-- multiple pieces. Therefore, the binary tree is only roughly split 35-- by time, the actual split depends on the distribution of events 36-- below it. 37 38data DurationTree 39 = DurationSplit 40 {-#UNPACK#-}!Timestamp -- The start time of this run-span 41 {-#UNPACK#-}!Timestamp -- The time used to split the events into two parts 42 {-#UNPACK#-}!Timestamp -- The end time of this run-span 43 DurationTree -- The LHS split; all events lie completely between 44 -- start and split 45 DurationTree -- The RHS split; all events lie completely between 46 -- split and end 47 {-#UNPACK#-}!Timestamp -- The total amount of time spent running a thread 48 {-#UNPACK#-}!Timestamp -- The total amount of time spend in GC 49 50 | DurationTreeLeaf 51 EventDuration 52 53 | DurationTreeEmpty 54 55 deriving Show 56 57------------------------------------------------------------------------------- 58 59mkDurationTree :: [EventDuration] -> Timestamp -> DurationTree 60mkDurationTree es endTime = 61 -- trace (show tree) $ 62 tree 63 where 64 tree = splitDurations es endTime 65 66splitDurations :: [EventDuration] -- events 67 -> Timestamp -- end time of last event in the list 68 -> DurationTree 69splitDurations [] _endTime = 70 -- if len /= 0 then error "splitDurations0" else 71 DurationTreeEmpty -- The case for an empty list of events. 72 73splitDurations [e] _entTime = 74 DurationTreeLeaf e 75 76splitDurations es endTime 77 | null rhs 78 = splitDurations es lhs_end 79 80 | null lhs 81 = error $ 82 printf "splitDurations: null lhs: len = %d, startTime = %d, endTime = %d\n" 83 (length es) startTime endTime 84 ++ '\n': show es 85 86 | otherwise 87 = -- trace (printf "len = %d, startTime = %d, endTime = %d, lhs_len = %d\n" len startTime endTime lhs_len) $ 88 assert (length lhs + length rhs == length es) $ 89 DurationSplit startTime 90 lhs_end 91 endTime 92 ltree 93 rtree 94 runTime 95 gcTime 96 where 97 startTime = startTimeOf (head es) 98 splitTime = startTime + (endTime - startTime) `div` 2 99 100 (lhs, lhs_end, rhs) = splitDurationList es [] splitTime 0 101 102 ltree = splitDurations lhs lhs_end 103 rtree = splitDurations rhs endTime 104 105 runTime = runTimeOf ltree + runTimeOf rtree 106 gcTime = gcTimeOf ltree + gcTimeOf rtree 107 108 109splitDurationList :: [EventDuration] 110 -> [EventDuration] 111 -> Timestamp 112 -> Timestamp 113 -> ([EventDuration], Timestamp, [EventDuration]) 114splitDurationList [] acc !_tsplit !tmax 115 = (reverse acc, tmax, []) 116splitDurationList [e] acc !_tsplit !tmax 117 -- Just one event left: put it on the right. This ensures that we 118 -- have at least one event on each side of the split. 119 = (reverse acc, tmax, [e]) 120splitDurationList (e:es) acc !tsplit !tmax 121 | tstart <= tsplit -- pick all events that start at or before the split 122 = splitDurationList es (e:acc) tsplit (max tmax tend) 123 | otherwise 124 = (reverse acc, tmax, e:es) 125 where 126 tstart = startTimeOf e 127 tend = endTimeOf e 128 129------------------------------------------------------------------------------- 130 131runTimeOf :: DurationTree -> Timestamp 132runTimeOf (DurationSplit _ _ _ _ _ runTime _) = runTime 133runTimeOf (DurationTreeLeaf e) | ThreadRun{} <- e = durationOf e 134runTimeOf _ = 0 135 136------------------------------------------------------------------------------- 137 138gcTimeOf :: DurationTree -> Timestamp 139gcTimeOf (DurationSplit _ _ _ _ _ _ gcTime) = gcTime 140gcTimeOf (DurationTreeLeaf e) | isGCDuration e = durationOf e 141gcTimeOf _ = 0 142 143------------------------------------------------------------------------------- 144 145reportDurationTree :: Int -> DurationTree -> IO () 146reportDurationTree hecNumber eventTree 147 = putStrLn ("HEC " ++ show hecNumber ++ reportText) 148 where 149 reportText = " nodes = " ++ show (durationTreeCountNodes eventTree) ++ 150 " max depth = " ++ show (durationTreeMaxDepth eventTree) 151 152------------------------------------------------------------------------------- 153 154durationTreeCountNodes :: DurationTree -> Int 155durationTreeCountNodes (DurationSplit _ _ _ lhs rhs _ _) 156 = 1 + durationTreeCountNodes lhs + durationTreeCountNodes rhs 157durationTreeCountNodes _ = 1 158 159------------------------------------------------------------------------------- 160 161durationTreeMaxDepth :: DurationTree -> Int 162durationTreeMaxDepth (DurationSplit _ _ _ lhs rhs _ _) 163 = 1 + durationTreeMaxDepth lhs `max` durationTreeMaxDepth rhs 164durationTreeMaxDepth _ = 1 165 166------------------------------------------------------------------------------- 167 168data EventTree 169 = EventTree 170 {-#UNPACK#-}!Timestamp -- The start time of this run-span 171 {-#UNPACK#-}!Timestamp -- The end time of this run-span 172 EventNode 173 174data EventNode 175 = EventSplit 176 {-#UNPACK#-}!Timestamp -- The time used to split the events into two parts 177 EventNode -- The LHS split; all events lie completely between 178 -- start and split 179 EventNode -- The RHS split; all events lie completely between 180 -- split and end 181 182 | EventTreeLeaf [GHC.Event] 183 -- sometimes events happen "simultaneously" (at the same time 184 -- given the resolution of our clock source), so we can't 185 -- separate them. 186 187 | EventTreeOne GHC.Event 188 -- This is a space optimisation for the common case of 189 -- EventTreeLeaf [e]. 190 191mkEventTree :: [GHC.Event] -> Timestamp -> EventTree 192mkEventTree es endTime = 193 EventTree s e $ 194 -- trace (show tree) $ 195 tree 196 where 197 tree = splitEvents es endTime 198 (s,e) = if null es then (0,0) else (evTime (head es), endTime) 199 200splitEvents :: [GHC.Event] -- events 201 -> Timestamp -- end time of last event in the list 202 -> EventNode 203splitEvents [] !_endTime = 204 -- if len /= 0 then error "splitEvents0" else 205 EventTreeLeaf [] -- The case for an empty list of events 206 207splitEvents [e] !_endTime = 208 EventTreeOne e 209 210splitEvents es !endTime 211 | duration == 0 212 = EventTreeLeaf es 213 214 | null rhs 215 = splitEvents es lhs_end 216 217 | null lhs 218 = error $ 219 printf "splitEvents: null lhs: len = %d, startTime = %d, endTime = %d\n" 220 (length es) startTime endTime 221 ++ '\n': show es 222 223 | otherwise 224 = -- trace (printf "len = %d, startTime = %d, endTime = %d, lhs_len = %d\n" len startTime endTime lhs_len) $ 225 assert (length lhs + length rhs == length es) $ 226 EventSplit (evTime (head rhs)) 227 ltree 228 rtree 229 where 230 -- | Integer division, rounding up. 231 divUp :: Timestamp -> Timestamp -> Timestamp 232 divUp n k = (n + k - 1) `div` k 233 startTime = evTime (head es) 234 splitTime = startTime + (endTime - startTime) `divUp` 2 235 duration = endTime - startTime 236 237 (lhs, lhs_end, rhs) = splitEventList es [] splitTime 0 238 239 ltree = splitEvents lhs lhs_end 240 rtree = splitEvents rhs endTime 241 242 243splitEventList :: [GHC.Event] 244 -> [GHC.Event] 245 -> Timestamp 246 -> Timestamp 247 -> ([GHC.Event], Timestamp, [GHC.Event]) 248splitEventList [] acc !_tsplit !tmax 249 = (reverse acc, tmax, []) 250splitEventList [e] acc !_tsplit !tmax 251 -- Just one event left: put it on the right. This ensures that we 252 -- have at least one event on each side of the split. 253 = (reverse acc, tmax, [e]) 254splitEventList (e:es) acc !tsplit !tmax 255 | t <= tsplit -- pick all events that start at or before the split 256 = splitEventList es (e:acc) tsplit (max tmax t) 257 | otherwise 258 = (reverse acc, tmax, e:es) 259 where 260 t = evTime e 261 262------------------------------------------------------------------------------- 263 264reportEventTree :: Int -> EventTree -> IO () 265reportEventTree hecNumber (EventTree _ _ eventTree) 266 = putStrLn ("HEC " ++ show hecNumber ++ reportText) 267 where 268 reportText = " nodes = " ++ show (eventTreeCountNodes eventTree) ++ 269 " max depth = " ++ show (eventNodeMaxDepth eventTree) 270 271------------------------------------------------------------------------------- 272 273eventTreeCountNodes :: EventNode -> Int 274eventTreeCountNodes (EventSplit _ lhs rhs) 275 = 1 + eventTreeCountNodes lhs + eventTreeCountNodes rhs 276eventTreeCountNodes _ = 1 277 278------------------------------------------------------------------------------- 279 280eventTreeMaxDepth :: EventTree -> Int 281eventTreeMaxDepth (EventTree _ _ t) = eventNodeMaxDepth t 282 283eventNodeMaxDepth :: EventNode -> Int 284eventNodeMaxDepth (EventSplit _ lhs rhs) 285 = 1 + eventNodeMaxDepth lhs `max` eventNodeMaxDepth rhs 286eventNodeMaxDepth _ = 1 287