diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2020-11-13 16:14:56 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-11-29 15:33:18 -0500 |
| commit | 1bc104b029b4f043cac42253ee2387f4d574abca (patch) | |
| tree | c9adc9c06f430752882a59f4ee4ee68519bce01e /compiler/GHC/Utils | |
| parent | ae14f160c64d20880486ba365348ef3900c84a60 (diff) | |
| download | haskell-1bc104b029b4f043cac42253ee2387f4d574abca.tar.gz | |
withTimings: Emit allocations counter
This will allow us to back out the allocations per compiler pass from
the eventlog. Note that we dump the allocation counter rather than the
difference since this will allow us to determine how much work is done
*between* `withTiming` blocks.
Diffstat (limited to 'compiler/GHC/Utils')
| -rw-r--r-- | compiler/GHC/Utils/Error.hs | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs index 25da8be3de..43c2cae4ad 100644 --- a/compiler/GHC/Utils/Error.hs +++ b/compiler/GHC/Utils/Error.hs @@ -536,14 +536,16 @@ withTiming' dflags what force_result prtimings action logInfo dflags $ withPprStyle defaultUserStyle $ text "***" <+> what <> colon let ctx = initDefaultSDocContext dflags - eventBegins ctx what alloc0 <- liftIO getAllocationCounter start <- liftIO getCPUTime + eventBegins ctx what + recordAllocs alloc0 !r <- action () <- pure $ force_result r eventEnds ctx what end <- liftIO getCPUTime alloc1 <- liftIO getAllocationCounter + recordAllocs alloc1 -- recall that allocation counter counts down let alloc = alloc0 - alloc1 time = realToFrac (end - start) * 1e-9 @@ -569,12 +571,19 @@ withTiming' dflags what force_result prtimings action else action where whenPrintTimings = liftIO . when (prtimings == PrintTimings) + + recordAllocs alloc = do + liftIO $ traceMarkerIO $ "GHC:allocs:" ++ show alloc + eventBegins ctx w = do - whenPrintTimings $ traceMarkerIO (eventBeginsDoc ctx w) - liftIO $ traceEventIO (eventBeginsDoc ctx w) + let doc = eventBeginsDoc ctx w + whenPrintTimings $ traceMarkerIO doc + liftIO $ traceEventIO doc + eventEnds ctx w = do - whenPrintTimings $ traceMarkerIO (eventEndsDoc ctx w) - liftIO $ traceEventIO (eventEndsDoc ctx w) + let doc = eventEndsDoc ctx w + whenPrintTimings $ traceMarkerIO doc + liftIO $ traceEventIO doc eventBeginsDoc ctx w = showSDocOneLine ctx $ text "GHC:started:" <+> w eventEndsDoc ctx w = showSDocOneLine ctx $ text "GHC:finished:" <+> w |