diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index c23434d5e31..6aa80daad9f 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/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 [] @@ -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.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, diff --git a/src/Compiler/AbstractIL/ilwrite.fsi b/src/Compiler/AbstractIL/ilwrite.fsi index 780a6a95f09..a5240473fb1 100644 --- a/src/Compiler/AbstractIL/ilwrite.fsi +++ b/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 diff --git a/src/Compiler/AbstractIL/ilwritepdb.fs b/src/Compiler/AbstractIL/ilwritepdb.fs index 715987a2ad1..9b969bae098 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fs +++ b/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() diff --git a/src/Compiler/AbstractIL/ilwritepdb.fsi b/src/Compiler/AbstractIL/ilwritepdb.fsi index 79c1db52ac0..5987cc165e3 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fsi +++ b/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[] diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 5d800416450..96b637bd410 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2345,9 +2345,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()) @@ -2371,79 +2368,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 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 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 diff --git a/src/Compiler/Driver/CompilerOptions.fsi b/src/Compiler/Driver/CompilerOptions.fsi index 0915d999032..7fdf79ea2e6 100644 --- a/src/Compiler/Driver/CompilerOptions.fsi +++ b/src/Compiler/Driver/CompilerOptions.fsi @@ -89,7 +89,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 diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 705d6bb3832..8d8a6763be9 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -576,14 +576,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) @@ -599,7 +602,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 = @@ -773,7 +776,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) @@ -1098,7 +1101,6 @@ let main6 pdbfile = None emitTailcalls = tcConfig.emitTailcalls deterministic = tcConfig.deterministic - showTimes = tcConfig.showTimes portablePDB = false embeddedPDB = false embedAllSource = tcConfig.embedAllSource @@ -1129,7 +1131,6 @@ let main6 pdbfile = pdbfile emitTailcalls = tcConfig.emitTailcalls deterministic = tcConfig.deterministic - showTimes = tcConfig.showTimes portablePDB = tcConfig.portablePDB embeddedPDB = tcConfig.embeddedPDB embedAllSource = tcConfig.embedAllSource diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 0485d4e06e5..698c6e92023 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/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 diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index b62585266c7..a77ba8ff9ff 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1043,7 +1043,7 @@ module IncrementalBuilderStateHelpers = let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray>.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 = diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index f352d81ea1e..a5f8000cfa0 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -8,7 +8,7 @@ open System.IO open System.Text [] -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.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.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 + } diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index 0b9ccd0a4a7..746422455bf 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/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 diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index d0bb8f7843b..11ed90c37fa 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/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) diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index 40f8c8f8162..5696a14da98 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/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 diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs index 6bc77d45a8e..604071cc694 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs +++ b/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) []