summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2020-11-13 16:14:56 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-11-29 15:33:18 -0500
commit1bc104b029b4f043cac42253ee2387f4d574abca (patch)
treec9adc9c06f430752882a59f4ee4ee68519bce01e
parentae14f160c64d20880486ba365348ef3900c84a60 (diff)
downloadhaskell-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.
-rw-r--r--compiler/GHC/Utils/Error.hs19
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