diff --git a/compiler/main/SysTools/Tasks.hs b/compiler/main/SysTools/Tasks.hs
index 0310bd8eb258e6f8b5c17efd503cd30c0e3c1d2c..eeaadfa5b83d0d47ed4a195d098397f40b0a0227 100644
--- a/compiler/main/SysTools/Tasks.hs
+++ b/compiler/main/SysTools/Tasks.hs
@@ -37,14 +37,14 @@ import SysTools.Info
 -}
 
 runUnlit :: DynFlags -> [Option] -> IO ()
-runUnlit dflags args = do
+runUnlit dflags args = traceToolCommand dflags "unlit" $ do
   let prog = pgm_L dflags
       opts = getOpts dflags opt_L
   runSomething dflags "Literate pre-processor" prog
                (map Option opts ++ args)
 
 runCpp :: DynFlags -> [Option] -> IO ()
-runCpp dflags args =   do
+runCpp dflags args = traceToolCommand dflags "cpp" $ do
   let (p,args0) = pgm_P dflags
       args1 = map Option (getOpts dflags opt_P)
       args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags]
@@ -54,14 +54,14 @@ runCpp dflags args =   do
                        (args0 ++ args1 ++ args2 ++ args) Nothing mb_env
 
 runPp :: DynFlags -> [Option] -> IO ()
-runPp dflags args =   do
+runPp dflags args = traceToolCommand dflags "pp" $ do
   let prog = pgm_F dflags
       opts = map Option (getOpts dflags opt_F)
   runSomething dflags "Haskell pre-processor" prog (args ++ opts)
 
 -- | Run compiler of C-like languages and raw objects (such as gcc or clang).
 runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO ()
-runCc mLanguage dflags args =   do
+runCc mLanguage dflags args = traceToolCommand dflags "cc" $ do
   let p = pgm_c dflags
       args1 = map Option userOpts
       args2 = languageOptions ++ args ++ args1
@@ -144,7 +144,7 @@ xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
 
 -- | Run the linker with some arguments and return the output
 askLd :: DynFlags -> [Option] -> IO String
-askLd dflags args = do
+askLd dflags args = traceToolCommand dflags "linker" $ do
   let (p,args0) = pgm_l dflags
       args1     = map Option (getOpts dflags opt_l)
       args2     = args0 ++ args1 ++ args
@@ -153,7 +153,7 @@ askLd dflags args = do
     readCreateProcessWithExitCode' (proc p real_args){ env = mb_env }
 
 runAs :: DynFlags -> [Option] -> IO ()
-runAs dflags args = do
+runAs dflags args = traceToolCommand dflags "as" $ do
   let (p,args0) = pgm_a dflags
       args1 = map Option (getOpts dflags opt_a)
       args2 = args0 ++ args1 ++ args
@@ -162,7 +162,7 @@ runAs dflags args = do
 
 -- | Run the LLVM Optimiser
 runLlvmOpt :: DynFlags -> [Option] -> IO ()
-runLlvmOpt dflags args = do
+runLlvmOpt dflags args = traceToolCommand dflags "opt" $ do
   let (p,args0) = pgm_lo dflags
       args1 = map Option (getOpts dflags opt_lo)
       -- We take care to pass -optlo flags (e.g. args0) last to ensure that the
@@ -171,7 +171,7 @@ runLlvmOpt dflags args = do
 
 -- | Run the LLVM Compiler
 runLlvmLlc :: DynFlags -> [Option] -> IO ()
-runLlvmLlc dflags args = do
+runLlvmLlc dflags args = traceToolCommand dflags "llc" $ do
   let (p,args0) = pgm_lc dflags
       args1 = map Option (getOpts dflags opt_lc)
   runSomething dflags "LLVM Compiler" p (args0 ++ args1 ++ args)
@@ -180,7 +180,7 @@ runLlvmLlc dflags args = do
 -- backend on OS X as LLVM doesn't support the OS X system
 -- assembler)
 runClang :: DynFlags -> [Option] -> IO ()
-runClang dflags args = do
+runClang dflags args = traceToolCommand dflags "clang" $ do
   let (clang,_) = pgm_lcc dflags
       -- be careful what options we call clang with
       -- see #5903 and #7617 for bugs caused by this.
@@ -201,7 +201,7 @@ runClang dflags args = do
 
 -- | Figure out which version of LLVM we are running this session
 figureLlvmVersion :: DynFlags -> IO (Maybe LlvmVersion)
-figureLlvmVersion dflags = do
+figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do
   let (pgm,opts) = pgm_lc dflags
       args = filter notNull (map showOpt opts)
       -- we grab the args even though they should be useless just in
@@ -246,7 +246,7 @@ figureLlvmVersion dflags = do
 
 
 runLink :: DynFlags -> [Option] -> IO ()
-runLink dflags args = do
+runLink dflags args = traceToolCommand dflags "linker" $ do
   -- See Note [Run-time linker info]
   linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
   let (p,args0) = pgm_l dflags
@@ -306,7 +306,7 @@ ld: warning: symbol referencing errors
 
 
 runLibtool :: DynFlags -> [Option] -> IO ()
-runLibtool dflags args = do
+runLibtool dflags args = traceToolCommand dflags "libtool" $ do
   linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
   let args1      = map Option (getOpts dflags opt_l)
       args2      = [Option "-static"] ++ args1 ++ args ++ linkargs
@@ -315,30 +315,30 @@ runLibtool dflags args = do
   runSomethingFiltered dflags id "Linker" libtool args2 Nothing mb_env
 
 runAr :: DynFlags -> Maybe FilePath -> [Option] -> IO ()
-runAr dflags cwd args = do
+runAr dflags cwd args = traceToolCommand dflags "ar" $ do
   let ar = pgm_ar dflags
   runSomethingFiltered dflags id "Ar" ar args cwd Nothing
 
 askAr :: DynFlags -> Maybe FilePath -> [Option] -> IO String
-askAr dflags mb_cwd args = do
+askAr dflags mb_cwd args = traceToolCommand dflags "ar" $ do
   let ar = pgm_ar dflags
   runSomethingWith dflags "Ar" ar args $ \real_args ->
     readCreateProcessWithExitCode' (proc ar real_args){ cwd = mb_cwd }
 
 runRanlib :: DynFlags -> [Option] -> IO ()
-runRanlib dflags args = do
+runRanlib dflags args = traceToolCommand dflags "ranlib" $ do
   let ranlib = pgm_ranlib dflags
   runSomethingFiltered dflags id "Ranlib" ranlib args Nothing Nothing
 
 runMkDLL :: DynFlags -> [Option] -> IO ()
-runMkDLL dflags args = do
+runMkDLL dflags args = traceToolCommand dflags "mkdll" $ do
   let (p,args0) = pgm_dll dflags
       args1 = args0 ++ args
   mb_env <- getGccEnv (args0++args)
   runSomethingFiltered dflags id "Make DLL" p args1 Nothing mb_env
 
 runWindres :: DynFlags -> [Option] -> IO ()
-runWindres dflags args = do
+runWindres dflags args = traceToolCommand dflags "windres" $ do
   let cc = pgm_c dflags
       cc_args = map Option (sOpt_c (settings dflags))
       windres = pgm_windres dflags
@@ -361,5 +361,18 @@ runWindres dflags args = do
   runSomethingFiltered dflags id "Windres" windres args' Nothing mb_env
 
 touch :: DynFlags -> String -> String -> IO ()
-touch dflags purpose arg =
+touch dflags purpose arg = traceToolCommand dflags "touch" $
   runSomething dflags purpose (pgm_T dflags) [FileOption "" arg]
+
+-- * Tracing utility
+
+-- | Record in the eventlog when the given tool command starts
+--   and finishes, prepending the given 'String' with
+--   \"systool:\", to easily be able to collect and process
+--   all the systool events.
+--
+--   For those events to show up in the eventlog, you need
+--   to run GHC with @-v2@ or @-ddump-timings@.
+traceToolCommand :: DynFlags -> String -> IO a -> IO a
+traceToolCommand dflags tool = withTiming
+  (return dflags) (text $ "systool:" ++ tool) (const ())