Change --times console reporting to be based on Activity (#14470)

### Changing --times reporting of compiler timing to be based on the Activity module

* Console table layout for --times

* Supporting proper finish of statistic measurement, to enable multiple runs in the same process
  This is especially needed for:
  - Test suites
  - Hosted scenarios

* Making console table markdown friendly (to be directly copy-pastable)

src/Compiler/AbstractIL/ilwrite.fs

@@ -502,9 +502,7 @@ type cenv =
 
       emitTailcalls: bool
 
-      deterministic: bool
-
-      showTimes: bool
+      deterministic: bool    
 
       desiredMetadataVersion: ILVersionInfo
 
@@ -3020,14 +3018,14 @@ let GenModule (cenv : cenv) (modul: ILModuleDef) =
     let midx = AddUnsharedRow cenv TableNames.Module (GetModuleAsRow cenv modul)
     List.iter (GenResourcePass3 cenv) (modul.Resources.AsList())
     let tdefs = destTypeDefsWithGlobalFunctionsFirst cenv.ilg modul.TypeDefs
-    reportTime cenv.showTimes "Module Generation Preparation"
+    reportTime "Module Generation Preparation"
     GenTypeDefsPass1 [] cenv tdefs
-    reportTime cenv.showTimes "Module Generation Pass 1"
+    reportTime "Module Generation Pass 1"
     GenTypeDefsPass2 0 [] cenv tdefs
-    reportTime cenv.showTimes "Module Generation Pass 2"
+    reportTime "Module Generation Pass 2"
     (match modul.Manifest with None -> () | Some m -> GenManifestPass3 cenv m)
     GenTypeDefsPass3 [] cenv tdefs
-    reportTime cenv.showTimes "Module Generation Pass 3"
+    reportTime "Module Generation Pass 3"
     GenCustomAttrsPass3Or4 cenv (hca_Module, midx) modul.CustomAttrs
     // GenericParam is the only sorted table indexed by Columns in other tables (GenericParamConstraint\CustomAttributes).
     // Hence we need to sort it before we emit any entries in GenericParamConstraint\CustomAttributes that are attached to generic params.
@@ -3035,7 +3033,7 @@ let GenModule (cenv : cenv) (modul: ILModuleDef) =
     // the key --> index map since it is no longer valid
     cenv.GetTable(TableNames.GenericParam).SetRowsOfSharedTable (SortTableRows TableNames.GenericParam (cenv.GetTable(TableNames.GenericParam).GenericRowsOfTable))
     GenTypeDefsPass4 [] cenv tdefs
-    reportTime cenv.showTimes "Module Generation Pass 4"
+    reportTime "Module Generation Pass 4"
 
 /// Arbitrary value
 [<Literal>]
@@ -3053,8 +3051,7 @@ let generateIL (
     generatePdb,
     ilg: ILGlobals,
     emitTailcalls,
-    deterministic,
-    showTimes,
+    deterministic,  
     referenceAssemblyOnly,
     referenceAssemblyAttribOpt: ILAttribute option,
     allGivenSources,
@@ -3095,8 +3092,7 @@ let generateIL (
                 MetadataTable.Unshared (MetadataTable<UnsharedRow>.New ("row table "+string i, EqualityComparer.Default)))
     use cenv =
         { emitTailcalls=emitTailcalls
-          deterministic = deterministic
-          showTimes=showTimes
+          deterministic = deterministic         
           ilg = ilg
           desiredMetadataVersion=desiredMetadataVersion
           requiredDataFixups= requiredDataFixups
@@ -3180,7 +3176,7 @@ let generateIL (
        EventTokenMap = (fun t edef ->
         let tidx = idxForNextedTypeDef t
         getUncodedToken TableNames.Event (cenv.eventDefs.GetTableEntry (EventKey (tidx, edef.Name)))) }
-    reportTime cenv.showTimes "Finalize Module Generation Results"
+    reportTime "Finalize Module Generation Results"
     // New return the results
     let data = cenv.data.AsMemory().ToArray()
     let resources = cenv.resources.AsMemory().ToArray()
@@ -3214,8 +3210,7 @@ let writeILMetadataAndCode (
     desiredMetadataVersion,
     ilg,
     emitTailcalls,
-    deterministic,
-    showTimes,
+    deterministic,   
     referenceAssemblyOnly,
     referenceAssemblyAttribOpt,
     allGivenSources,
@@ -3237,8 +3232,7 @@ let writeILMetadataAndCode (
           generatePdb,
           ilg,
           emitTailcalls,
-          deterministic,
-          showTimes,
+          deterministic,       
           referenceAssemblyOnly,
           referenceAssemblyAttribOpt,
           allGivenSources,
@@ -3246,7 +3240,7 @@ let writeILMetadataAndCode (
           cilStartAddress,
           normalizeAssemblyRefs)
 
-    reportTime showTimes "Generated Tables and Code"
+    reportTime "Generated Tables and Code"
     let tableSize (tab: TableName) = tables[tab.Index].Count
 
    // Now place the code
@@ -3318,7 +3312,7 @@ let writeILMetadataAndCode (
       (if tableSize TableNames.GenericParamConstraint > 0 then 0x00001000 else 0x00000000) |||
       0x00000200
 
-    reportTime showTimes "Layout Header of Tables"
+    reportTime "Layout Header of Tables"
 
     let guidAddress n = (if n = 0 then 0 else (n - 1) * 0x10 + 0x01)
 
@@ -3362,7 +3356,7 @@ let writeILMetadataAndCode (
         if n >= blobAddressTable.Length then failwith "blob index out of range"
         blobAddressTable[n]
 
-    reportTime showTimes "Build String/Blob Address Tables"
+    reportTime "Build String/Blob Address Tables"
 
     let sortedTables =
       Array.init 64 (fun i ->
@@ -3371,7 +3365,7 @@ let writeILMetadataAndCode (
           let rows = tab.GenericRowsOfTable
           if TableRequiresSorting tabName then SortTableRows tabName rows else rows)
 
-    reportTime showTimes "Sort Tables"
+    reportTime "Sort Tables"
 
     let codedTables =
 
@@ -3486,7 +3480,7 @@ let writeILMetadataAndCode (
                 tablesBuf.EmitInt32 rows.Length
 
 
-        reportTime showTimes "Write Header of tablebuf"
+        reportTime "Write Header of tablebuf"
 
       // The tables themselves
         for rows in sortedTables do
@@ -3521,7 +3515,7 @@ let writeILMetadataAndCode (
 
         tablesBuf.AsMemory().ToArray()
 
-    reportTime showTimes "Write Tables to tablebuf"
+    reportTime "Write Tables to tablebuf"
 
     let tablesStreamUnpaddedSize = codedTables.Length
     // QUERY: extra 4 empty bytes in array.exe - why? Include some extra padding after
@@ -3538,7 +3532,7 @@ let writeILMetadataAndCode (
     let blobsChunk, _next = chunk blobsStreamPaddedSize next
     let blobsStreamPadding = blobsChunk.size - blobsStreamUnpaddedSize
 
-    reportTime showTimes "Layout Metadata"
+    reportTime "Layout Metadata"
 
     let metadata, guidStart =
       use mdbuf = ByteBuffer.Create(MetadataCapacity, useArrayPool = true)
@@ -3573,12 +3567,12 @@ let writeILMetadataAndCode (
       mdbuf.EmitInt32 blobsChunk.size
       mdbuf.EmitIntsAsBytes [| 0x23; 0x42; 0x6c; 0x6f; 0x62; 0x00; 0x00; 0x00; (* #Blob000 *)|]
 
-      reportTime showTimes "Write Metadata Header"
+      reportTime "Write Metadata Header"
      // Now the coded tables themselves
       mdbuf.EmitBytes codedTables
       for i = 1 to tablesStreamPadding do
           mdbuf.EmitIntAsByte 0x00
-      reportTime showTimes "Write Metadata Tables"
+      reportTime "Write Metadata Tables"
 
      // The string stream
       mdbuf.EmitByte 0x00uy
@@ -3586,7 +3580,7 @@ let writeILMetadataAndCode (
           mdbuf.EmitBytes s
       for i = 1 to stringsStreamPadding do
           mdbuf.EmitIntAsByte 0x00
-      reportTime showTimes "Write Metadata Strings"
+      reportTime "Write Metadata Strings"
      // The user string stream
       mdbuf.EmitByte 0x00uy
       for s in userStrings do
@@ -3596,7 +3590,7 @@ let writeILMetadataAndCode (
       for i = 1 to userStringsStreamPadding do
           mdbuf.EmitIntAsByte 0x00
 
-      reportTime showTimes "Write Metadata User Strings"
+      reportTime "Write Metadata User Strings"
     // The GUID stream
       let guidStart = mdbuf.Position
       Array.iter mdbuf.EmitBytes guids
@@ -3608,7 +3602,7 @@ let writeILMetadataAndCode (
           mdbuf.EmitBytes s
       for i = 1 to blobsStreamPadding do
           mdbuf.EmitIntAsByte 0x00
-      reportTime showTimes "Write Blob Stream"
+      reportTime "Write Blob Stream"
      // Done - close the buffer and return the result.
       mdbuf.AsMemory().ToArray(), guidStart
 
@@ -3624,7 +3618,7 @@ let writeILMetadataAndCode (
               let token = getUncodedToken TableNames.UserStrings (userStringAddress userStringIndex)
               if (Bytes.get code (locInCode-1) <> i_ldstr) then failwith "strings-in-code fixup: not at ldstr instruction!"
               applyFixup32 code locInCode token
-    reportTime showTimes "Fixup Metadata"
+    reportTime "Fixup Metadata"
 
     entryPointToken, code, codePadding, metadata, data, resources, requiredDataFixups.Value, pdbData, mappings, guidStart
 
@@ -3687,8 +3681,7 @@ let writeDirectory os dict =
 let writeBytes (os: BinaryWriter) (chunk: byte[]) = os.Write(chunk, 0, chunk.Length)
 
 let writePdb (
-    dumpDebugInfo,
-    showTimes,
+    dumpDebugInfo,   
     embeddedPDB,
     pdbfile,
     outfile,
@@ -3721,7 +3714,7 @@ let writePdb (
                 s.SignStream fs
             with exn ->
                 failwith ($"Warning: A call to SignFile failed ({exn.Message})")
-        reportTime showTimes "Signing Image"
+        reportTime "Signing Image"
 
     // Now we've done the bulk of the binary, do the PDB file and fixup the binary.
     match pdbfile with
@@ -3751,7 +3744,7 @@ let writePdb (
                         stream.WriteTo fs
                     getInfoForPortablePdb contentId pdbfile pathMap debugDataChunk debugDeterministicPdbChunk debugChecksumPdbChunk algorithmName checkSum embeddedPDB deterministic
             | None -> [| |]
-        reportTime showTimes "Generate PDB Info"
+        reportTime "Generate PDB Info"
 
         // Now we have the debug data we can go back and fill in the debug directory in the image
         use fs2 = reopenOutput()
@@ -3776,14 +3769,15 @@ let writePdb (
                     os2.BaseStream.Seek (int64 (textV2P i.iddChunk.addr), SeekOrigin.Begin) |> ignore
                     if i.iddChunk.size < i.iddData.Length then failwith "Debug data area is not big enough. Debug info may not be usable"
                     writeBytes os2 i.iddData
-            reportTime showTimes "Finalize PDB"
+            reportTime "Finalize PDB"
             signImage ()
             os2.Dispose()
         with exn ->
             failwith ("Error while writing debug directory entry: " + exn.Message)
             (try os2.Dispose(); FileSystem.FileDeleteShim outfile with _ -> ())
             reraise()
-
+           
+    reportTime "Finish"
     pdbBytes
 
 type options =
@@ -3799,8 +3793,7 @@ type options =
      checksumAlgorithm: HashAlgorithm
      signer: ILStrongNameSigner option
      emitTailcalls: bool
-     deterministic: bool
-     showTimes: bool
+     deterministic: bool  
      dumpDebugInfo: bool
      referenceAssemblyOnly: bool
      referenceAssemblyAttribOpt: ILAttribute option
@@ -3811,7 +3804,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
     // Store the public key from the signer into the manifest. This means it will be written
     // to the binary and also acts as an indicator to leave space for delay sign
 
-    reportTime options.showTimes "Write Started"
+    reportTime "Write Started"
     let isDll = modul.IsDLL
     let ilg = options.ilg
 
@@ -3925,8 +3918,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
                   desiredMetadataVersion,
                   ilg,
                   options.emitTailcalls,
-                  options.deterministic,
-                  options.showTimes,
+                  options.deterministic,                 
                   options.referenceAssemblyOnly,
                   options.referenceAssemblyAttribOpt,
                   options.allGivenSources,
@@ -3935,7 +3927,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
                   normalizeAssemblyRefs
               )
 
-          reportTime options.showTimes "Generated IL and metadata"
+          reportTime "Generated IL and metadata"
           let _codeChunk, next = chunk code.Length next
           let _codePaddingChunk, next = chunk codePadding.Length next
 
@@ -3968,7 +3960,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
             match options.pdbfile, options.portablePDB with
             | Some _, true ->
                 let pdbInfo =
-                    generatePortablePdb options.embedAllSource options.embedSourceList options.sourceLink options.checksumAlgorithm options.showTimes pdbData options.pathMap
+                    generatePortablePdb options.embedAllSource options.embedSourceList options.sourceLink options.checksumAlgorithm pdbData options.pathMap
 
                 if options.embeddedPDB then
                     let (uncompressedLength, contentId, stream, algorithmName, checkSum) = pdbInfo
@@ -4094,7 +4086,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
           let imageEndSectionPhysLoc = nextPhys
           let imageEndAddr = next
 
-          reportTime options.showTimes "Layout image"
+          reportTime "Layout image"
 
           let write p (os: BinaryWriter) chunkName chunk =
               match p with
@@ -4501,7 +4493,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
 
           pdbData, pdbInfoOpt, debugDirectoryChunk, debugDataChunk, debugChecksumPdbChunk, debugEmbeddedPdbChunk, debugDeterministicPdbChunk, textV2P, mappings
 
-    reportTime options.showTimes "Writing Image"
+    reportTime "Writing Image"
     pdbData, pdbInfoOpt, debugDirectoryChunk, debugDataChunk, debugChecksumPdbChunk, debugEmbeddedPdbChunk, debugDeterministicPdbChunk, textV2P, mappings
 
 let writeBinaryFiles (options: options, modul, normalizeAssemblyRefs) =
@@ -4529,8 +4521,7 @@ let writeBinaryFiles (options: options, modul, normalizeAssemblyRefs) =
     let reopenOutput () =
         FileSystem.OpenFileForWriteShim(options.outfile, FileMode.Open, FileAccess.ReadWrite, FileShare.Read)
 
-    writePdb (options.dumpDebugInfo,
-        options.showTimes,
+    writePdb (options.dumpDebugInfo,      
         options.embeddedPDB,
         options.pdbfile,
         options.outfile,
@@ -4562,8 +4553,7 @@ let writeBinaryInMemory (options: options, modul, normalizeAssemblyRefs) =
         stream
 
     let pdbBytes =
-        writePdb (options.dumpDebugInfo,
-            options.showTimes,
+        writePdb (options.dumpDebugInfo,         
             options.embeddedPDB,
             options.pdbfile,
             options.outfile,

src/Compiler/AbstractIL/ilwrite.fsi

@@ -22,7 +22,6 @@ type options =
       signer: ILStrongNameSigner option
       emitTailcalls: bool
       deterministic: bool
-      showTimes: bool
       dumpDebugInfo: bool
       referenceAssemblyOnly: bool
       referenceAssemblyAttribOpt: ILAttribute option

src/Compiler/AbstractIL/ilwritepdb.fs

@@ -316,10 +316,10 @@ let pdbGetDebugInfo
 let getDebugFileName outfile =
     (FileSystemUtils.chopExtension outfile) + ".pdb"
 
-let sortMethods showTimes info =
-    reportTime showTimes (sprintf "PDB: Defined %d documents" info.Documents.Length)
+let sortMethods info =
+    reportTime (sprintf "PDB: Defined %d documents" info.Documents.Length)
     Array.sortInPlaceBy (fun x -> x.MethToken) info.Methods
-    reportTime showTimes (sprintf "PDB: Sorted %d methods" info.Methods.Length)
+    reportTime (sprintf "PDB: Sorted %d methods" info.Methods.Length)
     ()
 
 let getRowCounts tableRowCounts =
@@ -345,7 +345,6 @@ type PortablePdbGenerator
         embedSourceList: string list,
         sourceLink: string,
         checksumAlgorithm,
-        showTimes,
         info: PdbData,
         pathMap: PathMap
     ) =
@@ -784,7 +783,7 @@ type PortablePdbGenerator
         | Some scope -> writeMethodScopes minfo.MethToken scope
 
     member _.Emit() =
-        sortMethods showTimes info
+        sortMethods info
         metadata.SetCapacity(TableIndex.MethodDebugInformation, info.Methods.Length)
 
         defineModuleImportScope ()
@@ -823,7 +822,7 @@ type PortablePdbGenerator
         let contentId = serializer.Serialize blobBuilder
         let portablePdbStream = new MemoryStream()
         blobBuilder.WriteContentTo portablePdbStream
-        reportTime showTimes "PDB: Created"
+        reportTime "PDB: Created"
         (portablePdbStream.Length, contentId, portablePdbStream, algorithmName, contentHash)
 
 let generatePortablePdb
@@ -831,12 +830,11 @@ let generatePortablePdb
     (embedSourceList: string list)
     (sourceLink: string)
     checksumAlgorithm
-    showTimes
     (info: PdbData)
     (pathMap: PathMap)
     =
     let generator =
-        PortablePdbGenerator(embedAllSource, embedSourceList, sourceLink, checksumAlgorithm, showTimes, info, pathMap)
+        PortablePdbGenerator(embedAllSource, embedSourceList, sourceLink, checksumAlgorithm, info, pathMap)
 
     generator.Emit()
 

src/Compiler/AbstractIL/ilwritepdb.fsi

@@ -107,7 +107,6 @@ val generatePortablePdb:
     embedSourceList: string list ->
     sourceLink: string ->
     checksumAlgorithm: HashAlgorithm ->
-    showTimes: bool ->
     info: PdbData ->
     pathMap: PathMap ->
         int64 * BlobContentId * MemoryStream * string * byte[]

src/Compiler/Driver/CompilerOptions.fs

@@ -2362,9 +2362,6 @@ let PrintWholeAssemblyImplementation (tcConfig: TcConfig) outfile header expr =
 // ReportTime
 //----------------------------------------------------------------------------
 
-let mutable tPrev: (DateTime * DateTime * float * int[]) option = None
-let mutable nPrev: (string * IDisposable) option = None
-
 let private SimulateException simulateConfig =
     match simulateConfig with
     | Some ("fsc-oom") -> raise (OutOfMemoryException())
@@ -2388,79 +2385,24 @@ let private SimulateException simulateConfig =
     | Some ("fsc-fail") -> failwith "simulated"
     | _ -> ()
 
-let ReportTime (tcConfig: TcConfig) descr =
-    match nPrev with
-    | None -> ()
-    | Some (prevDescr, _) ->
-        if tcConfig.pause then
-            dprintf "[done '%s', entering '%s'] press <enter> to continue... " prevDescr descr
-            Console.ReadLine() |> ignore
-        // Intentionally putting this right after the pause so a debugger can be attached.
-        SimulateException tcConfig.simulateException
-
-    if (tcConfig.showTimes || verbose || tcConfig.writeTimesToFile.IsSome) then
-        // Note that timing calls are relatively expensive on the startup path so we don't
-        // make this call unless showTimes has been turned on.
-        let p = Process.GetCurrentProcess()
-        let utNow = p.UserProcessorTime.TotalSeconds
-        let tNow = DateTime.Now
-        let maxGen = GC.MaxGeneration
-        let gcNow = [| for i in 0..maxGen -> GC.CollectionCount i |]
-        let wsNow = p.WorkingSet64 / 1000000L
-
-        let tStart =
-            match tPrev, nPrev with
-            | Some (tStart, tPrev, utPrev, gcPrev), Some (prevDescr, prevActivity) ->
-                let spanGC = [| for i in 0..maxGen -> GC.CollectionCount i - gcPrev[i] |]
-                let t = tNow - tStart
-                let tDelta = tNow - tPrev
-                let utDelta = utNow - utPrev
-
-                match prevActivity with
-                | :? System.Diagnostics.Activity as a when isNotNull a ->
-                    // Yes, there is duplicity of code between the console reporting and Activity collection right now.
-                    // If current --times behaviour can be changed (=breaking change to the layout etc.), the GC and CPU time collecting logic can move to Activity
-                    // (if a special Tag is set for an activity, the listener itself could evaluate CPU and GC info and set it
-                    a.AddTag(Activity.Tags.gc0, spanGC[Operators.min 0 maxGen]) |> ignore
-                    a.AddTag(Activity.Tags.gc1, spanGC[Operators.min 1 maxGen]) |> ignore
-                    a.AddTag(Activity.Tags.gc2, spanGC[Operators.min 2 maxGen]) |> ignore
-
-                    a.AddTag(Activity.Tags.outputDllFile, tcConfig.outputFile |> Option.defaultValue String.Empty)
-                    |> ignore
-
-                    a.AddTag(Activity.Tags.cpuDelta, utDelta.ToString("000.000")) |> ignore
-
-                    a.AddTag(Activity.Tags.realDelta, tDelta.TotalSeconds.ToString("000.000"))
-                    |> ignore
-                | _ -> ()
-
-                printf
-                    "Real: %4.1f Realdelta: %4.1f Cpu: %4.1f Cpudelta: %4.1f Mem: %3d"
-                    t.TotalSeconds
-                    tDelta.TotalSeconds
-                    utNow
-                    utDelta
-                    wsNow
-
-                printfn
-                    " G0: %3d G1: %2d G2: %2d [%s]"
-                    spanGC[Operators.min 0 maxGen]
-                    spanGC[Operators.min 1 maxGen]
-                    spanGC[Operators.min 2 maxGen]
-                    prevDescr
-
-                tStart
-
-            | _ -> DateTime.Now
-
-        tPrev <- Some(tStart, tNow, utNow, gcNow)
-
-    nPrev
-    |> Option.iter (fun (_, act) ->
-        if isNotNull act then
-            act.Dispose())
-
-    nPrev <- Some(descr, Activity.startNoTags descr)
+let ReportTime =
+    let mutable nPrev = None
+
+    fun (tcConfig: TcConfig) descr ->
+        nPrev
+        |> Option.iter (fun (prevDescr, prevAct) ->
+            use _ = prevAct
+
+            if tcConfig.pause then
+                dprintf "[done '%s', entering '%s'] press <enter> to continue... " prevDescr descr
+                Console.ReadLine() |> ignore
+            // Intentionally putting this right after the pause so a debugger can be attached.
+            SimulateException tcConfig.simulateException)
+
+        if descr <> "Exiting" then
+            nPrev <- Some(descr, Activity.Profiling.startAndMeasureEnvironmentStats descr)
+        else
+            nPrev <- None
 
 let ignoreFailureOnMono1_1_16 f =
     try

src/Compiler/Driver/CompilerOptions.fsi

@@ -91,7 +91,7 @@ val DoWithColor: ConsoleColor -> (unit -> 'T) -> 'T
 
 val DoWithDiagnosticColor: FSharpDiagnosticSeverity -> (unit -> 'T) -> 'T
 
-val ReportTime: TcConfig -> string -> unit
+val ReportTime: (TcConfig -> string -> unit)
 
 val GetAbbrevFlagSet: TcConfigBuilder -> bool -> Set<string>
 

src/Compiler/Driver/fsc.fs

@@ -577,14 +577,17 @@ let main1
             delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter)
             exiter.Exit 1
 
+    if tcConfig.showTimes then
+        Activity.Profiling.addConsoleListener () |> disposables.Register
+
     tcConfig.writeTimesToFile
     |> Option.iter (fun f ->
-        Activity.addCsvFileListener f |> disposables.Register
+        Activity.CsvExport.addCsvFileListener f |> disposables.Register
 
         Activity.start
             "FSC compilation"
             [
-                Activity.Tags.outputDllFile, tcConfig.outputFile |> Option.defaultValue String.Empty
+                Activity.Tags.project, tcConfig.outputFile |> Option.defaultValue String.Empty
             ]
         |> disposables.Register)
 
@@ -600,7 +603,7 @@ let main1
         AbortOnError(diagnosticsLogger, exiter)
 
     // Resolve assemblies
-    ReportTime tcConfig "Import mscorlib and FSharp.Core.dll"
+    ReportTime tcConfig "Import mscorlib+FSharp.Core"
     let foundationalTcConfigP = TcConfigProvider.Constant tcConfig
 
     let sysRes, otherRes, knownUnresolved =
@@ -774,7 +777,7 @@ let main2
     if tcConfig.printSignature || tcConfig.printAllSignatureFiles then
         InterfaceFileWriter.WriteInterfaceFile(tcGlobals, tcConfig, InfoReader(tcGlobals, tcImports.GetImportMap()), typedImplFiles)
 
-    ReportTime tcConfig "Write XML document signatures"
+    ReportTime tcConfig "Write XML doc signatures"
 
     if tcConfig.xmlDocOutputFile.IsSome then
         XmlDocWriter.ComputeXmlDocSigs(tcGlobals, generatedCcu)
@@ -1099,7 +1102,6 @@ let main6
                             pdbfile = None
                             emitTailcalls = tcConfig.emitTailcalls
                             deterministic = tcConfig.deterministic
-                            showTimes = tcConfig.showTimes
                             portablePDB = false
                             embeddedPDB = false
                             embedAllSource = tcConfig.embedAllSource
@@ -1130,7 +1132,6 @@ let main6
                             pdbfile = pdbfile
                             emitTailcalls = tcConfig.emitTailcalls
                             deterministic = tcConfig.deterministic
-                            showTimes = tcConfig.showTimes
                             portablePDB = tcConfig.portablePDB
                             embeddedPDB = tcConfig.embeddedPDB
                             embedAllSource = tcConfig.embedAllSource

src/Compiler/Interactive/fsi.fs

@@ -1457,8 +1457,7 @@ type internal FsiDynamicCompiler(
               // but needs to be set for some logic of ilwrite to function.
               pdbfile = (if tcConfig.debuginfo then Some (multiAssemblyName + ".pdb") else None)
               emitTailcalls = tcConfig.emitTailcalls
-              deterministic = tcConfig.deterministic
-              showTimes = tcConfig.showTimes
+              deterministic = tcConfig.deterministic           
               // we always use portable for F# Interactive debug emit
               portablePDB = true
               // we don't use embedded for F# Interactive debug emit

src/Compiler/Service/IncrementalBuild.fs

@@ -1043,7 +1043,7 @@ module IncrementalBuilderStateHelpers =
 
     let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray<GraphNode<BoundModel>>.Builder) =
         GraphNode(node {
-            use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|Activity.Tags.outputDllFile, initialState.outfile|]
+            use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|Activity.Tags.project, initialState.outfile|]
             // Compute last bound model then get all the evaluated models.
             let! _ = boundModels[boundModels.Count - 1].GetOrComputeValue()
             let boundModels =

src/Compiler/Utilities/Activity.fs

@@ -8,7 +8,7 @@ open System.IO
 open System.Text
 
 [<RequireQualifiedAccess>]
-module Activity =
+module internal Activity =
 
     module Tags =
         let fileName = "fileName"
@@ -41,6 +41,25 @@ module Activity =
             |]
 
     let private activitySourceName = "fsc"
+    let private profiledSourceName = "fsc_with_env_stats"
+
+    type System.Diagnostics.Activity with
+
+        member this.RootId =
+            let rec rootID (act: Activity) =
+                if isNull act.ParentId then act.Id else rootID act.Parent
+
+            rootID this
+
+        member this.Depth =
+            let rec depth (act: Activity) acc =
+                if isNull act.ParentId then
+                    acc
+                else
+                    depth act.Parent (acc + 1)
+
+            depth this 0
+
     let private activitySource = new ActivitySource(activitySourceName)
 
     let start (name: string) (tags: (string * string) seq) : IDisposable =
@@ -56,80 +75,167 @@ module Activity =
 
     let startNoTags (name: string) : IDisposable = activitySource.StartActivity(name)
 
-    let private escapeStringForCsv (o: obj) =
-        if isNull o then
-            ""
-        else
-            let mutable txtVal = o.ToString()
-            let hasComma = txtVal.IndexOf(',') > -1
-            let hasQuote = txtVal.IndexOf('"') > -1
+    module Profiling =
+
+        module Tags =
+            let workingSetMB = "workingSet(MB)"
+            let gc0 = "gc0"
+            let gc1 = "gc1"
+            let gc2 = "gc2"
+            let handles = "handles"
+            let threads = "threads"
+
+            let profilingTags = [| workingSetMB; gc0; gc1; gc2; handles; threads |]
+
+        let private profiledSource = new ActivitySource(profiledSourceName)
+
+        let startAndMeasureEnvironmentStats (name: string) : IDisposable = profiledSource.StartActivity(name)
+
+        type private GCStats = int[]
+
+        let private collectGCStats () : GCStats =
+            [| for i in 0 .. GC.MaxGeneration -> GC.CollectionCount i |]
+
+        let private addStatsMeasurementListener () =
+            let gcStatsInnerTag = "#gc_stats_internal"
+
+            let l =
+                new ActivityListener(
+                    ShouldListenTo = (fun a -> a.Name = profiledSourceName),
+                    Sample = (fun _ -> ActivitySamplingResult.AllData),
+                    ActivityStarted = (fun a -> a.AddTag(gcStatsInnerTag, collectGCStats ()) |> ignore),
+                    ActivityStopped =
+                        (fun a ->
+                            let statsBefore = a.GetTagItem(gcStatsInnerTag) :?> GCStats
+                            let statsAfter = collectGCStats ()
+                            let p = Process.GetCurrentProcess()
+                            a.AddTag(Tags.workingSetMB, p.WorkingSet64 / 1_000_000L) |> ignore
+                            a.AddTag(Tags.handles, p.HandleCount) |> ignore
+                            a.AddTag(Tags.threads, p.Threads.Count) |> ignore
+
+                            for i = 0 to statsAfter.Length - 1 do
+                                a.AddTag($"gc{i}", statsAfter[i] - statsBefore[i]) |> ignore)
+
+                )
+
+            ActivitySource.AddActivityListener(l)
+            l
+
+        let addConsoleListener () =
+            let statsMeasurementListener = addStatsMeasurementListener ()
+
+            let reportingStart = DateTime.UtcNow
+            let nameColumnWidth = 36
+
+            let header =
+                "|"
+                + "Phase name".PadRight(nameColumnWidth)
+                + "|Elapsed |Duration| WS(MB)|  GC0  |  GC1  |  GC2  |Handles|Threads|"
+
+            let consoleWriterListener =
+                new ActivityListener(
+                    ShouldListenTo = (fun a -> a.Name = profiledSourceName),
+                    Sample = (fun _ -> ActivitySamplingResult.AllData),
+                    ActivityStopped =
+                        (fun a ->
+                            Console.Write('|')
+                            let indentedName = new String('>', a.Depth) + a.DisplayName
+                            Console.Write(indentedName.PadRight(nameColumnWidth))
+
+                            let elapsed = (a.StartTimeUtc + a.Duration - reportingStart).TotalSeconds
+                            Console.Write("|{0,8:N4}|{1,8:N4}|", elapsed, a.Duration.TotalSeconds)
+
+                            for t in Tags.profilingTags do
+                                Console.Write("{0,7}|", a.GetTagItem(t))
+
+                            Console.WriteLine())
+                )
+
+            Console.WriteLine(new String('-', header.Length))
+            Console.WriteLine(header)
+            Console.WriteLine(header |> String.map (fun c -> if c = '|' then c else '-'))
+
+            ActivitySource.AddActivityListener(consoleWriterListener)
+
+            { new IDisposable with
+                member this.Dispose() =
+                    statsMeasurementListener.Dispose()
+                    consoleWriterListener.Dispose()
+                    Console.WriteLine(new String('-', header.Length))
+            }
 
-            if hasQuote then
-                txtVal <- txtVal.Replace("\"", "\\\"")
+    module CsvExport =
 
-            if hasQuote || hasComma then
-                "\"" + txtVal + "\""
+        let private escapeStringForCsv (o: obj) =
+            if isNull o then
+                ""
             else
-                txtVal
-
-    let private createCsvRow (a: Activity) =
-        let sb = new StringBuilder(128)
-
-        let appendWithLeadingComma (s: string) =
-            sb.Append(',') |> ignore
-            sb.Append(s) |> ignore
-
-        // "Name,StartTime,EndTime,Duration,Id,ParentId"
-        sb.Append(a.DisplayName) |> ignore
-        appendWithLeadingComma (a.StartTimeUtc.ToString("HH-mm-ss.ffff"))
-        appendWithLeadingComma ((a.StartTimeUtc + a.Duration).ToString("HH-mm-ss.ffff"))
-        appendWithLeadingComma (a.Duration.TotalSeconds.ToString("000.0000", System.Globalization.CultureInfo.InvariantCulture))
-        appendWithLeadingComma (a.Id)
-        appendWithLeadingComma (a.ParentId)
-
-        let rec rootID (act: Activity) =
-            if isNull act.ParentId then act.Id else rootID act.Parent
-
-        appendWithLeadingComma (rootID a)
-
-        Tags.AllKnownTags
-        |> Array.iter (fun t -> a.GetTagItem(t) |> escapeStringForCsv |> appendWithLeadingComma)
-
-        sb.ToString()
-
-    let addCsvFileListener pathToFile =
-        if pathToFile |> File.Exists |> not then
-            File.WriteAllLines(
-                pathToFile,
-                [
-                    "Name,StartTime,EndTime,Duration(s),Id,ParentId,RootId,"
-                    + String.concat "," Tags.AllKnownTags
-                ]
-            )
-
-        let sw = new StreamWriter(path = pathToFile, append = true)
-
-        let msgQueue =
-            MailboxProcessor<string>.Start
-                (fun inbox ->
-                    async {
-                        while true do
-                            let! msg = inbox.Receive()
-                            do! sw.WriteLineAsync(msg) |> Async.AwaitTask
-                    })
-
-        let l =
-            new ActivityListener(
-                ShouldListenTo = (fun a -> a.Name = activitySourceName),
-                Sample = (fun _ -> ActivitySamplingResult.AllData),
-                ActivityStopped = (fun a -> msgQueue.Post(createCsvRow a))
-            )
-
-        ActivitySource.AddActivityListener(l)
-
-        { new IDisposable with
-            member this.Dispose() =
-                l.Dispose() // Unregister from listening new activities first
-                (msgQueue :> IDisposable).Dispose() // Wait for the msg queue to be written out
-                sw.Dispose() // Only then flush the messages and close the file
-        }
+                let mutable txtVal = o.ToString()
+                let hasComma = txtVal.IndexOf(',') > -1
+                let hasQuote = txtVal.IndexOf('"') > -1
+
+                if hasQuote then
+                    txtVal <- txtVal.Replace("\"", "\\\"")
+
+                if hasQuote || hasComma then
+                    "\"" + txtVal + "\""
+                else
+                    txtVal
+
+        let private createCsvRow (a: Activity) =
+            let sb = new StringBuilder(128)
+
+            let appendWithLeadingComma (s: string) =
+                sb.Append(',') |> ignore
+                sb.Append(s) |> ignore
+
+            // "Name,StartTime,EndTime,Duration,Id,ParentId"
+            sb.Append(a.DisplayName) |> ignore
+            appendWithLeadingComma (a.StartTimeUtc.ToString("HH-mm-ss.ffff"))
+            appendWithLeadingComma ((a.StartTimeUtc + a.Duration).ToString("HH-mm-ss.ffff"))
+            appendWithLeadingComma (a.Duration.TotalSeconds.ToString("000.0000", System.Globalization.CultureInfo.InvariantCulture))
+            appendWithLeadingComma (a.Id)
+            appendWithLeadingComma (a.ParentId)
+            appendWithLeadingComma (a.RootId)
+
+            Tags.AllKnownTags
+            |> Array.iter (fun t -> a.GetTagItem(t) |> escapeStringForCsv |> appendWithLeadingComma)
+
+            sb.ToString()
+
+        let addCsvFileListener pathToFile =
+            if pathToFile |> File.Exists |> not then
+                File.WriteAllLines(
+                    pathToFile,
+                    [
+                        "Name,StartTime,EndTime,Duration(s),Id,ParentId,RootId,"
+                        + String.concat "," Tags.AllKnownTags
+                    ]
+                )
+
+            let sw = new StreamWriter(path = pathToFile, append = true)
+
+            let msgQueue =
+                MailboxProcessor<string>.Start
+                    (fun inbox ->
+                        async {
+                            while true do
+                                let! msg = inbox.Receive()
+                                do! sw.WriteLineAsync(msg) |> Async.AwaitTask
+                        })
+
+            let l =
+                new ActivityListener(
+                    ShouldListenTo = (fun a -> a.Name = activitySourceName || a.Name = profiledSourceName),
+                    Sample = (fun _ -> ActivitySamplingResult.AllData),
+                    ActivityStopped = (fun a -> msgQueue.Post(createCsvRow a))
+                )
+
+            ActivitySource.AddActivityListener(l)
+
+            { new IDisposable with
+                member this.Dispose() =
+                    l.Dispose() // Unregister from listening new activities first
+                    (msgQueue :> IDisposable).Dispose() // Wait for the msg queue to be written out
+                    sw.Dispose() // Only then flush the messages and close the file
+            }

src/Compiler/Utilities/Activity.fsi

@@ -16,17 +16,14 @@ module internal Activity =
         val userOpName: string
         val length: string
         val cache: string
-        val cpuDelta: string
-        val realDelta: string
-        val gc0: string
-        val gc1: string
-        val gc2: string
-        val outputDllFile: string
-
-        val AllKnownTags: string[]
 
     val startNoTags: name: string -> IDisposable
 
     val start: name: string -> tags: (string * string) seq -> IDisposable
 
-    val addCsvFileListener: pathToFile: string -> IDisposable
+    module Profiling =
+        val startAndMeasureEnvironmentStats: name: string -> IDisposable
+        val addConsoleListener: unit -> IDisposable
+
+    module CsvExport =
+        val addCsvFileListener: pathToFile: string -> IDisposable

src/Compiler/Utilities/illib.fs

@@ -85,27 +85,17 @@ module internal PervasiveAutoOpens =
         | Some x -> x
 
     let reportTime =
-        let mutable tFirst = None
-        let mutable tPrev = None
-
-        fun showTimes descr ->
-            if showTimes then
-                let t = Process.GetCurrentProcess().UserProcessorTime.TotalSeconds
-
-                let prev =
-                    match tPrev with
-                    | None -> 0.0
-                    | Some t -> t
-
-                let first =
-                    match tFirst with
-                    | None ->
-                        (tFirst <- Some t
-                         t)
-                    | Some t -> t
-
-                printf "  ilwrite: Cpu %4.1f (total)   %4.1f (delta) - %s\n" (t - first) (t - prev) descr
-                tPrev <- Some t
+        let mutable tPrev: IDisposable = null
+
+        fun descr ->
+            if isNotNull tPrev then
+                tPrev.Dispose()
+
+            tPrev <-
+                if descr <> "Finish" then
+                    FSharp.Compiler.Diagnostics.Activity.Profiling.startAndMeasureEnvironmentStats descr
+                else
+                    null
 
     let foldOn p f z x = f z (p x)
 

src/Compiler/Utilities/illib.fsi

@@ -48,7 +48,7 @@ module internal PervasiveAutoOpens =
     /// We set the limit to be 80k to account for larger pointer sizes for when F# is running 64-bit.
     val LOH_SIZE_THRESHOLD_BYTES: int
 
-    val reportTime: (bool -> string -> unit)
+    val reportTime: (string -> unit)
 
     /// Get an initialization hole
     val getHole: r: 'a option ref -> 'a

tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs

@@ -68,8 +68,8 @@ module times =
         let consoleContents = sw.ToString()
         Assert.Contains("Parse inputs",consoleContents)
         Assert.Contains("Typecheck",consoleContents)
-        Assert.Contains("Mem",consoleContents)
-        Assert.Contains("Realdelta",consoleContents)
+        Assert.Contains("GC0",consoleContents)
+        Assert.Contains("Duration",consoleContents)
 
 
     [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"error_01.fs"|])>]