[Git][ghc/ghc][master] withTimings: Emit allocations counter

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00
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.

- - - - -


1 changed file:

- compiler/GHC/Utils/Error.hs


Changes:

=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bc104b029b4f043cac42253ee2387f4d574abca

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bc104b029b4f043cac42253ee2387f4d574abca
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201129/fc926a1f/attachment-0001.html>