@@ -9,6 +9,9 @@ module Events.EventDuration (
99 isDiscreteEvent
1010 ) where
1111
12+ import System.IO
13+ import System.IO.Unsafe
14+
1215-- Imports for GHC Events
1316import GHC.RTS.Events hiding (Event , GCIdle , GCWork )
1417import qualified GHC.RTS.Events as GHC
@@ -87,18 +90,20 @@ eventsToDurations :: [GHC.Event] -> [EventDuration]
8790eventsToDurations [] = []
8891eventsToDurations (event : events) =
8992 case evSpec event of
90- RunThread {thread= t} -> runDuration t : rest
93+ RunThread {thread= t}
94+ | Just ev <- runDuration t -> ev : rest
95+ | otherwise -> rest
9196 StopThread {} -> rest
9297 StartGC -> gcStart (evTime event) events
9398 EndGC {} -> rest
9499 _otherEvent -> rest
95100 where
96101 rest = eventsToDurations events
97102
98- runDuration t = ThreadRun t s (evTime event) endTime
99- where (endTime, s) = case findRunThreadTime events of
100- Nothing -> error $ " findRunThreadTime for " ++ ( show event)
101- Just x -> x
103+ runDuration :: ThreadId -> Maybe EventDuration
104+ runDuration t = do
105+ (endTime, s) <- findRunThreadTime events
106+ return $ ThreadRun t s (evTime event) endTime
102107
103108isDiscreteEvent :: GHC. Event -> Bool
104109isDiscreteEvent e =
@@ -172,6 +177,11 @@ findRunThreadTime [] = Nothing
172177findRunThreadTime (e : es)
173178 = case evSpec e of
174179 StopThread {status= s} -> Just (evTime e, s)
175- _ -> findRunThreadTime es
180+ _ | [] <- es -> unsafePerformIO $ do
181+ hPutStrLn stderr " warning: failed to find stop event for thread; eventlog truncated?"
182+ return $ Just (evTime e, NoStatus )
183+ -- the eventlog abruptly ended; presumably the
184+ -- thread was still running.
185+ | otherwise -> findRunThreadTime es
176186
177187-------------------------------------------------------------------------------
0 commit comments