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