From d0bc86450ff0aa6434d68fc06d3b45d5540e1151 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 7 Dec 2022 15:56:40 +0100 Subject: [PATCH 01/22] Time reporting to a file --- src/Compiler/Driver/CompilerConfig.fs | 3 +++ src/Compiler/Driver/CompilerConfig.fsi | 4 ++++ src/Compiler/Driver/CompilerOptions.fs | 18 +++++++++++++++++- 3 files changed, 24 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 91a2e9fde3d..ed0b8274bad 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -517,6 +517,7 @@ type TcConfigBuilder = /// show times between passes? mutable showTimes: bool + mutable reportTimeToFile : string option mutable showLoadedAssemblies: bool mutable continueAfterParseFailure: bool @@ -740,6 +741,7 @@ type TcConfigBuilder = productNameForBannerText = FSharpProductName showBanner = true showTimes = false + reportTimeToFile = None showLoadedAssemblies = false continueAfterParseFailure = false #if !NO_TYPEPROVIDERS @@ -1296,6 +1298,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.productNameForBannerText = data.productNameForBannerText member _.showBanner = data.showBanner member _.showTimes = data.showTimes + member _.reportTimeToFile = data.reportTimeToFile member _.showLoadedAssemblies = data.showLoadedAssemblies member _.continueAfterParseFailure = data.continueAfterParseFailure #if !NO_TYPEPROVIDERS diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index 70abf7beb63..621973a98fe 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -426,6 +426,8 @@ type TcConfigBuilder = mutable showTimes: bool + mutable reportTimeToFile: string option + mutable showLoadedAssemblies: bool mutable continueAfterParseFailure: bool @@ -748,6 +750,8 @@ type TcConfig = member showTimes: bool + member reportTimeToFile: string option + member showLoadedAssemblies: bool member continueAfterParseFailure: bool diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 0881e8c9179..90210c7e042 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -1741,6 +1741,15 @@ let internalFlags (tcConfigB: TcConfigBuilder) = None ) + // "Render timing profiles for compilation to a file" + CompilerOption( + "reportTimeToFile", + tagString, + OptionString(fun s -> tcConfigB.reportTimeToFile <- Some s), + Some(InternalCommandLineOption("reportTimeToFile", rangeCmdArgs)), + None + ) + #if !NO_TYPEPROVIDERS // "Display information about extension type resolution") CompilerOption( @@ -2371,7 +2380,7 @@ let ReportTime (tcConfig: TcConfig) descr = | Some ("fsc-fail") -> failwith "simulated" | _ -> () - if (tcConfig.showTimes || verbose) then + if (tcConfig.showTimes || verbose || tcConfig.reportTimeToFile.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() @@ -2403,6 +2412,13 @@ let ReportTime (tcConfig: TcConfig) descr = spanGC[Operators.min 1 maxGen] spanGC[Operators.min 2 maxGen] prevDescr + + match tcConfig.reportTimeToFile with + | Some f -> + if not (File.Exists(f)) then + File.WriteAllLines(f,["Realdelta,CpuDelta,WorkingSet,GC0,GC1,GC2,Outputfile,PhaseName"]) + File.AppendAllLines(f,[$"%f{tDelta.TotalSeconds},%f{utDelta},%i{wsNow},%i{spanGC[Operators.min 0 maxGen]},,%i{spanGC[Operators.min 1 maxGen]},%i{spanGC[Operators.min 2 maxGen]},{tcConfig.outputFile |> Option.defaultValue String.Empty},{prevDescr}"]) + | None -> () tStart From c9425bd466a6a6682ceac25091185fbcea4393e1 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 15:15:18 +0100 Subject: [PATCH 02/22] initial sketch --- FSharpBuild.Directory.Build.props | 1 + src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/Driver/CompilerOptions.fs | 75 +++++++++++++--------- src/Compiler/Driver/fsc.fs | 2 +- src/Compiler/Service/service.fs | 2 +- src/Compiler/Utilities/Activity.fs | 78 ++++++++++++++++++++++- src/Compiler/Utilities/Activity.fsi | 18 ++++++ 7 files changed, 143 insertions(+), 35 deletions(-) diff --git a/FSharpBuild.Directory.Build.props b/FSharpBuild.Directory.Build.props index 0c8d9cef75c..21e531409e8 100644 --- a/FSharpBuild.Directory.Build.props +++ b/FSharpBuild.Directory.Build.props @@ -27,6 +27,7 @@ $(OtherFlags) --nowarn:3384 $(OtherFlags) --times --nowarn:75 $(OtherFlags) --test:ParallelCheckingWithSignatureFilesOn + $(OtherFlags) $(AdditionalFscCmdFlags) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index d4ff82dd1da..f36e85846d6 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -12095,6 +12095,6 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames) let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false) - assert(vspec.InlineInfo = inlineFlag) + //assert(vspec.InlineInfo = inlineFlag) vspec, tpenv) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 90210c7e042..b7c3bcd0b03 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2348,37 +2348,39 @@ let PrintWholeAssemblyImplementation (tcConfig: TcConfig) outfile header expr = 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()) + | Some ("fsc-an") -> raise (ArgumentNullException("simulated")) + | Some ("fsc-invop") -> raise (InvalidOperationException()) + | Some ("fsc-av") -> raise (AccessViolationException()) + | Some ("fsc-aor") -> raise (ArgumentOutOfRangeException()) + | Some ("fsc-dv0") -> raise (DivideByZeroException()) + | Some ("fsc-nfn") -> raise (NotFiniteNumberException()) + | Some ("fsc-oe") -> raise (OverflowException()) + | Some ("fsc-atmm") -> raise (ArrayTypeMismatchException()) + | Some ("fsc-bif") -> raise (BadImageFormatException()) + | Some ("fsc-knf") -> raise (System.Collections.Generic.KeyNotFoundException()) + | Some ("fsc-ior") -> raise (IndexOutOfRangeException()) + | Some ("fsc-ic") -> raise (InvalidCastException()) + | Some ("fsc-ip") -> raise (InvalidProgramException()) + | Some ("fsc-ma") -> raise (MemberAccessException()) + | Some ("fsc-ni") -> raise (NotImplementedException()) + | Some ("fsc-nr") -> raise (NullReferenceException()) + | Some ("fsc-oc") -> raise (OperationCanceledException()) + | Some ("fsc-fail") -> failwith "simulated" + | _ -> () + let ReportTime (tcConfig: TcConfig) descr = match nPrev with | None -> () - | Some (prevDescr, prevActivity) -> - use _ = prevActivity // Finish the previous diagnostics activity by .Dispose() at the end of this block - + | 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. - match tcConfig.simulateException with - | Some ("fsc-oom") -> raise (OutOfMemoryException()) - | Some ("fsc-an") -> raise (ArgumentNullException("simulated")) - | Some ("fsc-invop") -> raise (InvalidOperationException()) - | Some ("fsc-av") -> raise (AccessViolationException()) - | Some ("fsc-aor") -> raise (ArgumentOutOfRangeException()) - | Some ("fsc-dv0") -> raise (DivideByZeroException()) - | Some ("fsc-nfn") -> raise (NotFiniteNumberException()) - | Some ("fsc-oe") -> raise (OverflowException()) - | Some ("fsc-atmm") -> raise (ArrayTypeMismatchException()) - | Some ("fsc-bif") -> raise (BadImageFormatException()) - | Some ("fsc-knf") -> raise (System.Collections.Generic.KeyNotFoundException()) - | Some ("fsc-ior") -> raise (IndexOutOfRangeException()) - | Some ("fsc-ic") -> raise (InvalidCastException()) - | Some ("fsc-ip") -> raise (InvalidProgramException()) - | Some ("fsc-ma") -> raise (MemberAccessException()) - | Some ("fsc-ni") -> raise (NotImplementedException()) - | Some ("fsc-nr") -> raise (NullReferenceException()) - | Some ("fsc-oc") -> raise (OperationCanceledException()) - | Some ("fsc-fail") -> failwith "simulated" - | _ -> () + SimulateException tcConfig.simulateException + if (tcConfig.showTimes || verbose || tcConfig.reportTimeToFile.IsSome) then // Note that timing calls are relatively expensive on the startup path so we don't @@ -2392,12 +2394,22 @@ let ReportTime (tcConfig: TcConfig) descr = let tStart = match tPrev, nPrev with - | Some (tStart, tPrev, utPrev, gcPrev), Some (prevDescr, _) -> + | 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 -> + 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) |> ignore + a.AddTag(Activity.Tags.realDelta,tDelta.TotalSeconds) |> ignore + | _ -> () + printf "Real: %4.1f Realdelta: %4.1f Cpu: %4.1f Cpudelta: %4.1f Mem: %3d" t.TotalSeconds @@ -2413,12 +2425,12 @@ let ReportTime (tcConfig: TcConfig) descr = spanGC[Operators.min 2 maxGen] prevDescr - match tcConfig.reportTimeToFile with - | Some f -> - if not (File.Exists(f)) then - File.WriteAllLines(f,["Realdelta,CpuDelta,WorkingSet,GC0,GC1,GC2,Outputfile,PhaseName"]) - File.AppendAllLines(f,[$"%f{tDelta.TotalSeconds},%f{utDelta},%i{wsNow},%i{spanGC[Operators.min 0 maxGen]},,%i{spanGC[Operators.min 1 maxGen]},%i{spanGC[Operators.min 2 maxGen]},{tcConfig.outputFile |> Option.defaultValue String.Empty},{prevDescr}"]) - | None -> () + //match tcConfig.reportTimeToFile with + //| Some f -> + // if not (File.Exists(f)) then + // File.WriteAllLines(f,["Realdelta,CpuDelta,WorkingSet,GC0,GC1,GC2,Outputfile,PhaseName"]) + // File.AppendAllLines(f,[$"%f{tDelta.TotalSeconds},%f{utDelta},%i{wsNow},%i{spanGC[Operators.min 0 maxGen]},%i{spanGC[Operators.min 1 maxGen]},%i{spanGC[Operators.min 2 maxGen]},{tcConfig.outputFile |> Option.defaultValue String.Empty},{prevDescr}"]) + //| None -> () tStart @@ -2426,6 +2438,7 @@ let ReportTime (tcConfig: TcConfig) descr = tPrev <- Some(tStart, tNow, utNow, gcNow) + nPrev |> Option.iter (fun (_,act) -> if isNotNull act then act.Dispose()) nPrev <- Some(descr, Activity.startNoTags descr) let ignoreFailureOnMono1_1_16 f = diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index e8ec56fa5a5..53a55ca0da3 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -575,7 +575,7 @@ let main1 errorRecovery e rangeStartup delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 - + tcConfig.reportTimeToFile |> Option.iter(fun f -> Activity.addCsvFileListener f |> disposables.Register) let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 07c1f518725..bcc7ef6c431 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -685,7 +685,7 @@ type BackgroundCompiler "BackgroundCompiler.CheckFileInProject" [| "project", options.ProjectFileName - "fileName", fileName + Activity.Tags.fileName, fileName "userOpName", userOpName |] diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 2ae87433ce5..e9c936f4686 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -4,15 +4,35 @@ namespace FSharp.Compiler.Diagnostics open System open System.Diagnostics +open System.IO +open System.Text +open System.Collections.Concurrent +open System.Threading.Tasks [] module Activity = + module Tags = + let fileName = "fileName" + let project = "project" + let qualifiedNameOfFile = "qualifiedNameOfFile" + let userOpName = "userOpName" + let length = "length" + let cache = "cache" + let cpuDelta = "cpuDelta" + let realDelta = "realDelta" + let gc0 = "gc0" + let gc1 = "gc1" + let gc2 = "gc2" + let outputDllFile = "outputDllFile" + + let AllKnownTags = [|fileName;project;qualifiedNameOfFile;userOpName;length;cache;cpuDelta;realDelta;gc0;gc1;gc2;outputDllFile|] + let private activitySourceName = "fsc" let private activitySource = new ActivitySource(activitySourceName) let start (name: string) (tags: (string * string) seq) : IDisposable = - let activity = activitySource.StartActivity(name) + let activity = activitySource.StartActivity(name) match activity with | null -> () @@ -23,3 +43,59 @@ module Activity = 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 + + if hasQuote then + txtVal <- txtVal.Replace("\"","\\\"") + + if hasQuote || hasComma then + "\"" + txtVal + "\"" + else + txtVal + + + let private createCsvRow (a : Activity) = + let endTime = a.StartTimeUtc + a.Duration + let startTimeString = a.StartTimeUtc.ToString("HH-mm-ss.ffff") + let endTimeString = endTime.ToString("HH-mm-ss.ffff") + let duration = a.Duration.TotalMilliseconds + + let sb = new StringBuilder(128) + + Printf.bprintf sb "%s,%s,%s,%f,%s,%s" a.DisplayName startTimeString endTimeString duration a.Id a.ParentId + Tags.AllKnownTags |> Array.iter (fun t -> + sb.Append(',') |> ignore + sb.Append(escapeStringForCsv(a.GetTagItem(t))) |> ignore) + + sb.ToString() + + let addCsvFileListener pathToFile = + if pathToFile |> File.Exists |> not then + File.WriteAllLines(pathToFile,["Name,StartTime,EndTime,Duration,Id,ParentId," + String.concat "," Tags.AllKnownTags]) + + let messages = new BlockingCollection(new ConcurrentQueue()) + + let l = new ActivityListener( + ShouldListenTo = (fun a -> a.Name = activitySourceName), + Sample = (fun _ -> ActivitySamplingResult.AllData), + ActivityStopped = (fun a -> messages.Add(createCsvRow a))) + + ActivitySource.AddActivityListener(l) + + let writerTask = + Task.Factory.StartNew(fun () -> + use sw = new StreamWriter(path = pathToFile, append = true) + for msg in messages.GetConsumingEnumerable() do + sw.WriteLine(msg)) + + {new IDisposable with + member this.Dispose() = + messages.CompleteAdding() + writerTask.Wait()} \ No newline at end of file diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index edf0d890c19..773bd23477c 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -9,6 +9,24 @@ open System [] module internal Activity = + module Tags = + val fileName : string + val qualifiedNameOfFile : string + val project : string + 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 From 9b7b86c0d8b08dfed657aea03d63f9e905dae449 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 15:16:29 +0100 Subject: [PATCH 03/22] formatting --- src/Compiler/Driver/CompilerConfig.fs | 2 +- src/Compiler/Driver/CompilerOptions.fs | 28 ++++++---- src/Compiler/Driver/fsc.fs | 5 +- src/Compiler/Utilities/Activity.fs | 71 +++++++++++++++++--------- src/Compiler/Utilities/Activity.fsi | 30 +++++------ 5 files changed, 85 insertions(+), 51 deletions(-) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index ed0b8274bad..6413940aba5 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -517,7 +517,7 @@ type TcConfigBuilder = /// show times between passes? mutable showTimes: bool - mutable reportTimeToFile : string option + mutable reportTimeToFile: string option mutable showLoadedAssemblies: bool mutable continueAfterParseFailure: bool diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index b7c3bcd0b03..db0ae6b03fe 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2348,7 +2348,7 @@ let PrintWholeAssemblyImplementation (tcConfig: TcConfig) outfile header expr = let mutable tPrev: (DateTime * DateTime * float * int[]) option = None let mutable nPrev: (string * IDisposable) option = None -let private SimulateException simulateConfig = +let private SimulateException simulateConfig = match simulateConfig with | Some ("fsc-oom") -> raise (OutOfMemoryException()) | Some ("fsc-an") -> raise (ArgumentNullException("simulated")) @@ -2380,7 +2380,6 @@ let ReportTime (tcConfig: TcConfig) 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.reportTimeToFile.IsSome) then // Note that timing calls are relatively expensive on the startup path so we don't @@ -2401,13 +2400,16 @@ let ReportTime (tcConfig: TcConfig) descr = let utDelta = utNow - utPrev match prevActivity with - | :? System.Diagnostics.Activity as a when isNotNull a -> - 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) |> ignore - a.AddTag(Activity.Tags.realDelta,tDelta.TotalSeconds) |> ignore + | :? System.Diagnostics.Activity as a when isNotNull a -> + 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) |> ignore + a.AddTag(Activity.Tags.realDelta, tDelta.TotalSeconds) |> ignore | _ -> () printf @@ -2424,7 +2426,7 @@ let ReportTime (tcConfig: TcConfig) descr = spanGC[Operators.min 1 maxGen] spanGC[Operators.min 2 maxGen] prevDescr - + //match tcConfig.reportTimeToFile with //| Some f -> // if not (File.Exists(f)) then @@ -2438,7 +2440,11 @@ let ReportTime (tcConfig: TcConfig) descr = tPrev <- Some(tStart, tNow, utNow, gcNow) - nPrev |> Option.iter (fun (_,act) -> if isNotNull act then act.Dispose()) + nPrev + |> Option.iter (fun (_, act) -> + if isNotNull act then + act.Dispose()) + nPrev <- Some(descr, Activity.startNoTags descr) let ignoreFailureOnMono1_1_16 f = diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 53a55ca0da3..75a0fa1f9c1 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -575,7 +575,10 @@ let main1 errorRecovery e rangeStartup delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 - tcConfig.reportTimeToFile |> Option.iter(fun f -> Activity.addCsvFileListener f |> disposables.Register) + + tcConfig.reportTimeToFile + |> Option.iter (fun f -> Activity.addCsvFileListener f |> disposables.Register) + let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index e9c936f4686..e808e22398f 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -26,13 +26,27 @@ module Activity = let gc2 = "gc2" let outputDllFile = "outputDllFile" - let AllKnownTags = [|fileName;project;qualifiedNameOfFile;userOpName;length;cache;cpuDelta;realDelta;gc0;gc1;gc2;outputDllFile|] + let AllKnownTags = + [| + fileName + project + qualifiedNameOfFile + userOpName + length + cache + cpuDelta + realDelta + gc0 + gc1 + gc2 + outputDllFile + |] let private activitySourceName = "fsc" let private activitySource = new ActivitySource(activitySourceName) let start (name: string) (tags: (string * string) seq) : IDisposable = - let activity = activitySource.StartActivity(name) + let activity = activitySource.StartActivity(name) match activity with | null -> () @@ -44,58 +58,69 @@ module Activity = let startNoTags (name: string) : IDisposable = activitySource.StartActivity(name) - let private escapeStringForCsv (o:obj) = + let private escapeStringForCsv (o: obj) = if isNull o then "" - else + else let mutable txtVal = o.ToString() let hasComma = txtVal.IndexOf(',') > -1 let hasQuote = txtVal.IndexOf('"') > -1 - + if hasQuote then - txtVal <- txtVal.Replace("\"","\\\"") - + txtVal <- txtVal.Replace("\"", "\\\"") + if hasQuote || hasComma then "\"" + txtVal + "\"" else txtVal - - let private createCsvRow (a : Activity) = + let private createCsvRow (a: Activity) = let endTime = a.StartTimeUtc + a.Duration let startTimeString = a.StartTimeUtc.ToString("HH-mm-ss.ffff") let endTimeString = endTime.ToString("HH-mm-ss.ffff") - let duration = a.Duration.TotalMilliseconds + let duration = a.Duration.TotalMilliseconds let sb = new StringBuilder(128) Printf.bprintf sb "%s,%s,%s,%f,%s,%s" a.DisplayName startTimeString endTimeString duration a.Id a.ParentId - Tags.AllKnownTags |> Array.iter (fun t -> + + Tags.AllKnownTags + |> Array.iter (fun t -> sb.Append(',') |> ignore - sb.Append(escapeStringForCsv(a.GetTagItem(t))) |> ignore) + sb.Append(escapeStringForCsv (a.GetTagItem(t))) |> ignore) sb.ToString() let addCsvFileListener pathToFile = if pathToFile |> File.Exists |> not then - File.WriteAllLines(pathToFile,["Name,StartTime,EndTime,Duration,Id,ParentId," + String.concat "," Tags.AllKnownTags]) + File.WriteAllLines( + pathToFile, + [ + "Name,StartTime,EndTime,Duration,Id,ParentId," + + String.concat "," Tags.AllKnownTags + ] + ) let messages = new BlockingCollection(new ConcurrentQueue()) - let l = new ActivityListener( - ShouldListenTo = (fun a -> a.Name = activitySourceName), - Sample = (fun _ -> ActivitySamplingResult.AllData), - ActivityStopped = (fun a -> messages.Add(createCsvRow a))) + let l = + new ActivityListener( + ShouldListenTo = (fun a -> a.Name = activitySourceName), + Sample = (fun _ -> ActivitySamplingResult.AllData), + ActivityStopped = (fun a -> messages.Add(createCsvRow a)) + ) ActivitySource.AddActivityListener(l) - - let writerTask = + + let writerTask = Task.Factory.StartNew(fun () -> - use sw = new StreamWriter(path = pathToFile, append = true) + use sw = new StreamWriter(path = pathToFile, append = true) + for msg in messages.GetConsumingEnumerable() do sw.WriteLine(msg)) - {new IDisposable with - member this.Dispose() = + { new IDisposable with + member this.Dispose() = messages.CompleteAdding() - writerTask.Wait()} \ No newline at end of file + writerTask.Wait() + } diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index 773bd23477c..0b9ccd0a4a7 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -9,21 +9,21 @@ open System [] module internal Activity = - module Tags = - val fileName : string - val qualifiedNameOfFile : string - val project : string - 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[] + module Tags = + val fileName: string + val qualifiedNameOfFile: string + val project: string + 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 From 3a0c03a56a26f34d0b1c187f271dc31a83345f80 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 15:19:26 +0100 Subject: [PATCH 04/22] Add remarks --- src/Compiler/Driver/CompilerOptions.fs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index db0ae6b03fe..ba58f223890 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2401,6 +2401,9 @@ let ReportTime (tcConfig: TcConfig) descr = 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 From 2e72cf6477781317c03652a68d4e51a75fa0249b Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 15:52:17 +0100 Subject: [PATCH 05/22] csv row building refactored --- src/Compiler/Driver/CompilerOptions.fs | 6 ++++-- src/Compiler/Utilities/Activity.fs | 27 ++++++++++++++------------ 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index ba58f223890..986bd6fe228 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2411,8 +2411,10 @@ let ReportTime (tcConfig: TcConfig) descr = a.AddTag(Activity.Tags.outputDllFile, tcConfig.outputFile |> Option.defaultValue String.Empty) |> ignore - a.AddTag(Activity.Tags.cpuDelta, utDelta) |> ignore - a.AddTag(Activity.Tags.realDelta, tDelta.TotalSeconds) |> ignore + a.AddTag(Activity.Tags.cpuDelta, utDelta.ToString("000.000")) |> ignore + + a.AddTag(Activity.Tags.realDelta, tDelta.TotalSeconds.ToString("000.000")) + |> ignore | _ -> () printf diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index e808e22398f..a7615c50c39 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -19,8 +19,8 @@ module Activity = let userOpName = "userOpName" let length = "length" let cache = "cache" - let cpuDelta = "cpuDelta" - let realDelta = "realDelta" + let cpuDelta = "cpuDelta(s)" + let realDelta = "realDelta(s)" let gc0 = "gc0" let gc1 = "gc1" let gc2 = "gc2" @@ -75,19 +75,22 @@ module Activity = txtVal let private createCsvRow (a: Activity) = - let endTime = a.StartTimeUtc + a.Duration - let startTimeString = a.StartTimeUtc.ToString("HH-mm-ss.ffff") - let endTimeString = endTime.ToString("HH-mm-ss.ffff") - let duration = a.Duration.TotalMilliseconds - let sb = new StringBuilder(128) - Printf.bprintf sb "%s,%s,%s,%f,%s,%s" a.DisplayName startTimeString endTimeString duration a.Id a.ParentId + 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")) + appendWithLeadingComma (a.Id) + appendWithLeadingComma (a.ParentId) Tags.AllKnownTags - |> Array.iter (fun t -> - sb.Append(',') |> ignore - sb.Append(escapeStringForCsv (a.GetTagItem(t))) |> ignore) + |> Array.iter (fun t -> a.GetTagItem(t) |> escapeStringForCsv |> appendWithLeadingComma) sb.ToString() @@ -96,7 +99,7 @@ module Activity = File.WriteAllLines( pathToFile, [ - "Name,StartTime,EndTime,Duration,Id,ParentId," + "Name,StartTime,EndTime,Duration(s),Id,ParentId," + String.concat "," Tags.AllKnownTags ] ) From cde7a25352630d1be14dc54d2e22bd51e5942f34 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 16:17:58 +0100 Subject: [PATCH 06/22] support for rootId added --- src/Compiler/Utilities/Activity.fs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index a7615c50c39..64d99262648 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -89,6 +89,11 @@ module Activity = 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) @@ -99,7 +104,7 @@ module Activity = File.WriteAllLines( pathToFile, [ - "Name,StartTime,EndTime,Duration(s),Id,ParentId," + "Name,StartTime,EndTime,Duration(s),Id,ParentId,RootId," + String.concat "," Tags.AllKnownTags ] ) From a71d7364087af523688adccb2da7c46b9b23d6b8 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 16:37:03 +0100 Subject: [PATCH 07/22] Tracking whole file compilation, to make it the root activity for fsc.exe invocation --- src/Compiler/Driver/fsc.fs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 75a0fa1f9c1..11a2aca70e9 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -577,7 +577,9 @@ let main1 exiter.Exit 1 tcConfig.reportTimeToFile - |> Option.iter (fun f -> Activity.addCsvFileListener f |> disposables.Register) + |> Option.iter (fun f -> + Activity.addCsvFileListener f |> disposables.Register + Activity.start "FSC compilation" [ Activity.Tags.outputDllFile , tcConfig.outputFile |> Option.defaultValue String.Empty] |> disposables.Register) let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) From 506f1468532a60667d60008901f334dd8423e550 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 16:54:53 +0100 Subject: [PATCH 08/22] Formatting using Fantomas --- src/Compiler/Driver/fsc.fs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 11a2aca70e9..53e5bc51f69 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -577,9 +577,15 @@ let main1 exiter.Exit 1 tcConfig.reportTimeToFile - |> Option.iter (fun f -> + |> Option.iter (fun f -> Activity.addCsvFileListener f |> disposables.Register - Activity.start "FSC compilation" [ Activity.Tags.outputDllFile , tcConfig.outputFile |> Option.defaultValue String.Empty] |> disposables.Register) + + Activity.start + "FSC compilation" + [ + Activity.Tags.outputDllFile, tcConfig.outputFile |> Option.defaultValue String.Empty + ] + |> disposables.Register) let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) From b2e51b5dd7c15427d2aa1a42d27612b629218a5e Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 17:50:47 +0100 Subject: [PATCH 09/22] Apply suggestions from code review --- src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/Driver/CompilerOptions.fs | 7 ------- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index f36e85846d6..d4ff82dd1da 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -12095,6 +12095,6 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames) let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false) - //assert(vspec.InlineInfo = inlineFlag) + assert(vspec.InlineInfo = inlineFlag) vspec, tpenv) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 986bd6fe228..ef8ab1e45f0 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2432,13 +2432,6 @@ let ReportTime (tcConfig: TcConfig) descr = spanGC[Operators.min 2 maxGen] prevDescr - //match tcConfig.reportTimeToFile with - //| Some f -> - // if not (File.Exists(f)) then - // File.WriteAllLines(f,["Realdelta,CpuDelta,WorkingSet,GC0,GC1,GC2,Outputfile,PhaseName"]) - // File.AppendAllLines(f,[$"%f{tDelta.TotalSeconds},%f{utDelta},%i{wsNow},%i{spanGC[Operators.min 0 maxGen]},%i{spanGC[Operators.min 1 maxGen]},%i{spanGC[Operators.min 2 maxGen]},{tcConfig.outputFile |> Option.defaultValue String.Empty},{prevDescr}"]) - //| None -> () - tStart | _ -> DateTime.Now From a5bc3bd8113d2f824632ff001e1d8d2c37d85307 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 9 Dec 2022 10:08:49 +0100 Subject: [PATCH 10/22] Changing literal strings to Activity.Tags.*** --- src/Compiler/Checking/CheckDeclarations.fs | 8 +-- src/Compiler/Driver/ParseAndCheckInputs.fs | 2 +- src/Compiler/Service/FSharpCheckerResults.fs | 4 +- src/Compiler/Service/IncrementalBuild.fs | 8 +-- src/Compiler/Service/service.fs | 64 ++++++++++---------- 5 files changed, 43 insertions(+), 43 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 7ea1c4b3429..4f74ce59c61 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5316,8 +5316,8 @@ let CheckOneImplFile use _ = Activity.start "CheckDeclarations.CheckOneImplFile" [| - "fileName", fileName - "qualifiedNameOfFile", qualNameOfFile.Text + Activity.Tags.fileName, fileName + Activity.Tags.qualifiedNameOfFile, qualNameOfFile.Text |] let cenv = cenv.Create (g, isScript, amap, thisCcu, false, Option.isSome rootSigOpt, @@ -5450,8 +5450,8 @@ let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSin use _ = Activity.start "CheckDeclarations.CheckOneSigFile" [| - "fileName", sigFile.FileName - "qualifiedNameOfFile", sigFile.QualifiedName.Text + Activity.Tags.fileName, sigFile.FileName + Activity.Tags.qualifiedNameOfFile, sigFile.QualifiedName.Text |] let cenv = cenv.Create diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index ac36b76477c..b384a93bf9e 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1205,7 +1205,7 @@ let CheckOneInputAux cancellable { try use _ = - Activity.start "ParseAndCheckInputs.CheckOneInput" [| "fileName", inp.FileName |] + Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, inp.FileName |] CheckSimulateException tcConfig diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 25c94ca5c5c..90ee7a80151 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2347,7 +2347,7 @@ module internal ParseAndCheckFile = let parseFile (sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) - use act = Activity.start "ParseAndCheckFile.parseFile" [| "fileName", fileName |] + use act = Activity.start "ParseAndCheckFile.parseFile" [| Activity.Tags.fileName, fileName |] let errHandler = DiagnosticsHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) @@ -2504,7 +2504,7 @@ module internal ParseAndCheckFile = cancellable { use _ = - Activity.start "ParseAndCheckFile.CheckOneFile" [| "fileName", mainInputFileName; "length", sourceText.Length.ToString() |] + Activity.start "ParseAndCheckFile.CheckOneFile" [| Activity.Tags.fileName, mainInputFileName; Activity.Tags.length, sourceText.Length.ToString() |] let parsedMainInput = parseResults.ParseTree diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 578eb5558f0..b62585266c7 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -127,7 +127,7 @@ module IncrementalBuildSyntaxTree = use act = Activity.start "IncrementalBuildSyntaxTree.parse" [| - "fileName", source.FilePath + Activity.Tags.fileName, source.FilePath "buildPhase", BuildPhase.Parse.ToString() "canSkip", canSkip.ToString() |] @@ -475,7 +475,7 @@ type BoundModel private (tcConfig: TcConfig, let! res = defaultTypeCheck () return res | Some syntaxTree -> - use _ = Activity.start "BoundModel.TypeCheck" [|"fileName", syntaxTree.FileName|] + use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] let sigNameOpt = if partialCheck then this.BackingSignature @@ -538,7 +538,7 @@ type BoundModel private (tcConfig: TcConfig, // Build symbol keys let itemKeyStore, semanticClassification = if enableBackgroundItemKeyStoreAndSemanticClassification then - use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|"fileName", fileName|] + use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|Activity.Tags.fileName, fileName|] let sResolutions = sink.GetResolutions() let builder = ItemKeyStoreBuilder() let preventDuplicates = HashSet({ new IEqualityComparer with @@ -1043,7 +1043,7 @@ module IncrementalBuilderStateHelpers = let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray>.Builder) = GraphNode(node { - use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|"projectOutFile", initialState.outfile|] + use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|Activity.Tags.outputDllFile, 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/Service/service.fs b/src/Compiler/Service/service.fs index bcc7ef6c431..c20024e9d73 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -287,7 +287,7 @@ type BackgroundCompiler let CreateOneIncrementalBuilder (options: FSharpProjectOptions, userOpName) = node { use _ = - Activity.start "BackgroundCompiler.CreateOneIncrementalBuilder" [| "project", options.ProjectFileName |] + Activity.start "BackgroundCompiler.CreateOneIncrementalBuilder" [| Activity.Tags.project, options.ProjectFileName |] Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CreateOneIncrementalBuilder", options.ProjectFileName) let projectReferences = getProjectReferences options userOpName @@ -479,7 +479,7 @@ type BackgroundCompiler member _.ParseFile(fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, userOpName: string) = async { use _ = - Activity.start "BackgroundCompiler.ParseFile" [| "fileName", fileName; "userOpName", userOpName; "cache", cache.ToString() |] + Activity.start "BackgroundCompiler.ParseFile" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName; Activity.Tags.cache, cache.ToString() |] if cache then let hash = sourceText.GetHashCode() |> int64 @@ -506,7 +506,7 @@ type BackgroundCompiler member _.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) = node { use _ = - Activity.start "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| "fileName", fileName; "userOpName", userOpName |] + Activity.start "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -535,7 +535,7 @@ type BackgroundCompiler member _.GetCachedCheckFileResult(builder: IncrementalBuilder, fileName, sourceText: ISourceText, options) = node { - use _ = Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| "fileName", fileName |] + use _ = Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| Activity.Tags.fileName, fileName |] let hash = sourceText.GetHashCode() |> int64 let key = (fileName, hash, options) let cachedResultsOpt = parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) @@ -642,9 +642,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.CheckFileInProjectAllowingStaleCachedResults" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName |] let! cachedResults = @@ -684,9 +684,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.CheckFileInProject" [| - "project", options.ProjectFileName + Activity.Tags.project, options.ProjectFileName Activity.Tags.fileName, fileName - "userOpName", userOpName + Activity.Tags.userOpName, userOpName |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -712,9 +712,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.ParseAndCheckFileInProject" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -758,9 +758,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.ParseAndCheckFileInProject" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -850,9 +850,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.FindReferencesInFile" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName "symbol", symbol.FullName |] @@ -878,9 +878,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.GetSemanticClassificationForFile" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName |] let! builderOpt, _ = getOrCreateBuilder (options, userOpName) @@ -902,9 +902,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.GetSemanticClassificationForFile" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", _userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, _userOpName |] match sourceText with @@ -980,7 +980,7 @@ type BackgroundCompiler member _.GetAssemblyData(options, userOpName) = node { use _ = - Activity.start "BackgroundCompiler.GetAssemblyData" [| "project", options.ProjectFileName; "userOpName", userOpName |] + Activity.start "BackgroundCompiler.GetAssemblyData" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] let! builderOpt, _ = getOrCreateBuilder (options, userOpName) @@ -1003,7 +1003,7 @@ type BackgroundCompiler /// Parse and typecheck the whole project. member bc.ParseAndCheckProject(options, userOpName) = use _ = - Activity.start "BackgroundCompiler.ParseAndCheckProject" [| "project", options.ProjectFileName; "userOpName", userOpName |] + Activity.start "BackgroundCompiler.ParseAndCheckProject" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] bc.ParseAndCheckProjectImpl(options, userOpName) @@ -1022,7 +1022,7 @@ type BackgroundCompiler _userOpName ) = use _ = - Activity.start "BackgroundCompiler.GetProjectOptionsFromScript" [| "fileName", fileName; "userOpName", _userOpName |] + Activity.start "BackgroundCompiler.GetProjectOptionsFromScript" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, _userOpName |] cancellable { use diagnostics = new DiagnosticsScope() @@ -1109,7 +1109,7 @@ type BackgroundCompiler member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) = use _ = - Activity.start "BackgroundCompiler.InvalidateConfiguration" [| "project", options.ProjectFileName; "userOpName", userOpName |] + Activity.start "BackgroundCompiler.InvalidateConfiguration" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] if incrementalBuildersCache.ContainsSimilarKey(AnyCallerThread, options) then parseCacheLock.AcquireLock(fun ltok -> @@ -1120,7 +1120,7 @@ type BackgroundCompiler () member bc.ClearCache(options: seq, _userOpName) = - use _ = Activity.start "BackgroundCompiler.ClearCache" [| "userOpName", _userOpName |] + use _ = Activity.start "BackgroundCompiler.ClearCache" [|Activity.Tags.userOpName, _userOpName |] lock gate (fun () -> options @@ -1128,7 +1128,7 @@ type BackgroundCompiler member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName) = use _ = - Activity.start "BackgroundCompiler.NotifyProjectCleaned" [| "project", options.ProjectFileName; "userOpName", userOpName |] + Activity.start "BackgroundCompiler.NotifyProjectCleaned" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] async { let! ct = Async.CancellationToken @@ -1296,7 +1296,7 @@ type FSharpChecker member _.MatchBraces(fileName, sourceText: ISourceText, options: FSharpParsingOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - use _ = Activity.start "FSharpChecker.MatchBraces" [| "fileName", fileName; "userOpName", userOpName |] + use _ = Activity.start "FSharpChecker.MatchBraces" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] let hash = sourceText.GetHashCode() |> int64 async { @@ -1348,7 +1348,7 @@ type FSharpChecker member _.Compile(argv: string[], ?userOpName: string) = let _userOpName = defaultArg userOpName "Unknown" - use _ = Activity.start "FSharpChecker.Compile" [| "userOpName", _userOpName |] + use _ = Activity.start "FSharpChecker.Compile" [| Activity.Tags.userOpName, _userOpName |] async { let ctok = CompilationThreadToken() From 376701e66a01affa1ab854c7b368032d5b13cb26 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 9 Dec 2022 10:10:02 +0100 Subject: [PATCH 11/22] Fantomas applied --- src/Compiler/Service/FSharpCheckerResults.fs | 11 +++- src/Compiler/Service/service.fs | 55 ++++++++++++++++---- 2 files changed, 54 insertions(+), 12 deletions(-) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 90ee7a80151..f2b88684b5c 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2347,7 +2347,9 @@ module internal ParseAndCheckFile = let parseFile (sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) - use act = Activity.start "ParseAndCheckFile.parseFile" [| Activity.Tags.fileName, fileName |] + + use act = + Activity.start "ParseAndCheckFile.parseFile" [| Activity.Tags.fileName, fileName |] let errHandler = DiagnosticsHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) @@ -2504,7 +2506,12 @@ module internal ParseAndCheckFile = cancellable { use _ = - Activity.start "ParseAndCheckFile.CheckOneFile" [| Activity.Tags.fileName, mainInputFileName; Activity.Tags.length, sourceText.Length.ToString() |] + Activity.start + "ParseAndCheckFile.CheckOneFile" + [| + Activity.Tags.fileName, mainInputFileName + Activity.Tags.length, sourceText.Length.ToString() + |] let parsedMainInput = parseResults.ParseTree diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index c20024e9d73..9af88d75880 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -479,7 +479,13 @@ type BackgroundCompiler member _.ParseFile(fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, userOpName: string) = async { use _ = - Activity.start "BackgroundCompiler.ParseFile" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName; Activity.Tags.cache, cache.ToString() |] + Activity.start + "BackgroundCompiler.ParseFile" + [| + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName + Activity.Tags.cache, cache.ToString() + |] if cache then let hash = sourceText.GetHashCode() |> int64 @@ -506,7 +512,9 @@ type BackgroundCompiler member _.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) = node { use _ = - Activity.start "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] + Activity.start + "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" + [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -535,7 +543,9 @@ type BackgroundCompiler member _.GetCachedCheckFileResult(builder: IncrementalBuilder, fileName, sourceText: ISourceText, options) = node { - use _ = Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| Activity.Tags.fileName, fileName |] + use _ = + Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| Activity.Tags.fileName, fileName |] + let hash = sourceText.GetHashCode() |> int64 let key = (fileName, hash, options) let cachedResultsOpt = parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) @@ -980,7 +990,12 @@ type BackgroundCompiler member _.GetAssemblyData(options, userOpName) = node { use _ = - Activity.start "BackgroundCompiler.GetAssemblyData" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] + Activity.start + "BackgroundCompiler.GetAssemblyData" + [| + Activity.Tags.project, options.ProjectFileName + Activity.Tags.userOpName, userOpName + |] let! builderOpt, _ = getOrCreateBuilder (options, userOpName) @@ -1003,7 +1018,12 @@ type BackgroundCompiler /// Parse and typecheck the whole project. member bc.ParseAndCheckProject(options, userOpName) = use _ = - Activity.start "BackgroundCompiler.ParseAndCheckProject" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] + Activity.start + "BackgroundCompiler.ParseAndCheckProject" + [| + Activity.Tags.project, options.ProjectFileName + Activity.Tags.userOpName, userOpName + |] bc.ParseAndCheckProjectImpl(options, userOpName) @@ -1022,7 +1042,9 @@ type BackgroundCompiler _userOpName ) = use _ = - Activity.start "BackgroundCompiler.GetProjectOptionsFromScript" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, _userOpName |] + Activity.start + "BackgroundCompiler.GetProjectOptionsFromScript" + [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, _userOpName |] cancellable { use diagnostics = new DiagnosticsScope() @@ -1109,7 +1131,12 @@ type BackgroundCompiler member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) = use _ = - Activity.start "BackgroundCompiler.InvalidateConfiguration" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] + Activity.start + "BackgroundCompiler.InvalidateConfiguration" + [| + Activity.Tags.project, options.ProjectFileName + Activity.Tags.userOpName, userOpName + |] if incrementalBuildersCache.ContainsSimilarKey(AnyCallerThread, options) then parseCacheLock.AcquireLock(fun ltok -> @@ -1120,7 +1147,7 @@ type BackgroundCompiler () member bc.ClearCache(options: seq, _userOpName) = - use _ = Activity.start "BackgroundCompiler.ClearCache" [|Activity.Tags.userOpName, _userOpName |] + use _ = Activity.start "BackgroundCompiler.ClearCache" [| Activity.Tags.userOpName, _userOpName |] lock gate (fun () -> options @@ -1128,7 +1155,12 @@ type BackgroundCompiler member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName) = use _ = - Activity.start "BackgroundCompiler.NotifyProjectCleaned" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] + Activity.start + "BackgroundCompiler.NotifyProjectCleaned" + [| + Activity.Tags.project, options.ProjectFileName + Activity.Tags.userOpName, userOpName + |] async { let! ct = Async.CancellationToken @@ -1296,7 +1328,10 @@ type FSharpChecker member _.MatchBraces(fileName, sourceText: ISourceText, options: FSharpParsingOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - use _ = Activity.start "FSharpChecker.MatchBraces" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] + + use _ = + Activity.start "FSharpChecker.MatchBraces" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] + let hash = sourceText.GetHashCode() |> int64 async { From b5083db8d3f8c12470d445c6119961d34645a1eb Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 9 Dec 2022 12:46:22 +0100 Subject: [PATCH 12/22] Redoing time reporting in ilwrite --- src/Compiler/AbstractIL/ilwrite.fs | 85 +++++++++++--------------- src/Compiler/AbstractIL/ilwrite.fsi | 3 +- src/Compiler/AbstractIL/ilwritepdb.fs | 18 +++--- src/Compiler/AbstractIL/ilwritepdb.fsi | 3 +- src/Compiler/Driver/CompilerOptions.fs | 3 +- src/Compiler/Driver/fsc.fs | 6 +- src/Compiler/Interactive/fsi.fs | 3 +- src/Compiler/Utilities/Activity.fs | 35 ++++++++++- src/Compiler/Utilities/Activity.fsi | 2 + src/Compiler/Utilities/illib.fs | 25 ++------ src/Compiler/Utilities/illib.fsi | 2 +- 11 files changed, 93 insertions(+), 92 deletions(-) diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index 80bb791c25f..691f4bd3df8 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, @@ -3738,7 +3731,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() @@ -3769,7 +3762,7 @@ let writePdb ( (try os2.Dispose(); FileSystem.FileDeleteShim outfile with _ -> ()) reraise() - reportTime showTimes "Finalize PDB" + reportTime "Finalize PDB" // Sign the binary. No further changes to binary allowed past this point! match signer with @@ -3784,7 +3777,7 @@ let writePdb ( (try FileSystem.FileDeleteShim outfile with _ -> ()) () - reportTime showTimes "Signing Image" + reportTime "Signing Image" pdbBytes type options = @@ -3800,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 @@ -3812,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 @@ -3926,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, @@ -3936,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 @@ -3969,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 @@ -4095,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 @@ -4502,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) = @@ -4530,8 +4521,7 @@ let writeBinaryFiles (options: options, modul, normalizeAssemblyRefs) = let reopenOutput () = FileSystem.OpenFileForWriteShim(options.outfile, FileMode.Open, FileAccess.Write, FileShare.Read) - writePdb (options.dumpDebugInfo, - options.showTimes, + writePdb (options.dumpDebugInfo, options.embeddedPDB, options.pdbfile, options.outfile, @@ -4561,8 +4551,7 @@ let writeBinaryInMemory (options: options, modul, normalizeAssemblyRefs) = let reopenOutput () = 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..d9f04d3212a 100644 --- a/src/Compiler/AbstractIL/ilwrite.fsi +++ b/src/Compiler/AbstractIL/ilwrite.fsi @@ -21,8 +21,7 @@ type options = checksumAlgorithm: HashAlgorithm signer: ILStrongNameSigner option emitTailcalls: bool - deterministic: bool - showTimes: bool + deterministic: bool dumpDebugInfo: bool referenceAssemblyOnly: bool referenceAssemblyAttribOpt: ILAttribute option diff --git a/src/Compiler/AbstractIL/ilwritepdb.fs b/src/Compiler/AbstractIL/ilwritepdb.fs index 715987a2ad1..6a10a3efb46 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 = @@ -344,8 +344,7 @@ type PortablePdbGenerator embedAllSource: bool, embedSourceList: string list, sourceLink: string, - checksumAlgorithm, - showTimes, + checksumAlgorithm, 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,20 +822,19 @@ 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 (embedAllSource: bool) (embedSourceList: string list) (sourceLink: string) - checksumAlgorithm - showTimes + checksumAlgorithm (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..be84dbbf425 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fsi +++ b/src/Compiler/AbstractIL/ilwritepdb.fsi @@ -106,8 +106,7 @@ val generatePortablePdb: embedAllSource: bool -> embedSourceList: string list -> sourceLink: string -> - checksumAlgorithm: HashAlgorithm -> - showTimes: bool -> + checksumAlgorithm: HashAlgorithm -> info: PdbData -> pathMap: PathMap -> int64 * BlobContentId * MemoryStream * string * byte[] diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index ef8ab1e45f0..763afe9e820 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2387,9 +2387,10 @@ let ReportTime (tcConfig: TcConfig) descr = let p = Process.GetCurrentProcess() let utNow = p.UserProcessorTime.TotalSeconds let tNow = DateTime.Now - let maxGen = GC.MaxGeneration + 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 diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 53e5bc51f69..fb1c2402ab7 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -1097,8 +1097,7 @@ let main6 outfile = outfile pdbfile = None emitTailcalls = tcConfig.emitTailcalls - deterministic = tcConfig.deterministic - showTimes = tcConfig.showTimes + deterministic = tcConfig.deterministic portablePDB = false embeddedPDB = false embedAllSource = tcConfig.embedAllSource @@ -1128,8 +1127,7 @@ let main6 outfile = outfile pdbfile = pdbfile emitTailcalls = tcConfig.emitTailcalls - deterministic = tcConfig.deterministic - showTimes = tcConfig.showTimes + deterministic = tcConfig.deterministic 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/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 64d99262648..603852e3a49 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -9,6 +9,7 @@ open System.Text open System.Collections.Concurrent open System.Threading.Tasks + [] module Activity = @@ -26,6 +27,9 @@ module Activity = let gc2 = "gc2" let outputDllFile = "outputDllFile" + let envStatsStart = "#stats_start" + let envStatsEnd = "#stats_end" + let AllKnownTags = [| fileName @@ -42,6 +46,19 @@ module Activity = outputDllFile |] + + type private EnvironmentStats = { Handles : int; Threads : int; WorkingSetMB : int64; GarbageCollectionsPerGeneration : int[]} + + let private collectEnvironmentStats () = + let p = Process.GetCurrentProcess() + { + Handles = p.HandleCount + Threads = p.Threads.Count + WorkingSetMB = p.WorkingSet64 / 1_000_000L + GarbageCollectionsPerGeneration = [| for i in 0..GC.MaxGeneration -> GC.CollectionCount i |] + } + + let private activitySourceName = "fsc" let private activitySource = new ActivitySource(activitySourceName) @@ -58,6 +75,22 @@ module Activity = let startNoTags (name: string) : IDisposable = activitySource.StartActivity(name) + + let private profiledSourceName = "fsc_with_env_stats" + let private profiledSource = new ActivitySource(profiledSourceName) + + let startAndMeasureEnvironmentStats (name : string) : IDisposable = profiledSource.StartActivity(name) + + let addStatsMeasurementListener () = + let l = + new ActivityListener( + ShouldListenTo = (fun a -> a.Name = profiledSourceName), + Sample = (fun _ -> ActivitySamplingResult.AllData), + ActivityStarted = (fun a -> a.AddTag(Tags.envStatsStart, collectEnvironmentStats()) |> ignore), + ActivityStopped = (fun a -> a.AddTag(Tags.envStatsEnd, collectEnvironmentStats()) |> ignore) + ) + ActivitySource.AddActivityListener(l) + let private escapeStringForCsv (o: obj) = if isNull o then "" @@ -113,7 +146,7 @@ module Activity = let l = new ActivityListener( - ShouldListenTo = (fun a -> a.Name = activitySourceName), + ShouldListenTo = (fun a -> a.Name = activitySourceName || a.Name = profiledSourceName), Sample = (fun _ -> ActivitySamplingResult.AllData), ActivityStopped = (fun a -> messages.Add(createCsvRow a)) ) diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index 0b9ccd0a4a7..f70beb11e4f 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -29,4 +29,6 @@ module internal Activity = val start: name: string -> tags: (string * string) seq -> IDisposable + val startAndMeasureEnvironmentStats: name: string -> IDisposable + val addCsvFileListener: pathToFile: string -> IDisposable diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index d0bb8f7843b..df22bb9760e 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -85,27 +85,10 @@ 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 -> + use _ = tPrev + tPrev <- FSharp.Compiler.Diagnostics.Activity.startAndMeasureEnvironmentStats descr 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 From b22a03245e2b810ce2e7d42e40bb671f5db941d9 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 9 Dec 2022 16:11:10 +0100 Subject: [PATCH 13/22] Console table layout for --times --- src/Compiler/AbstractIL/ilwrite.fsi | 2 +- src/Compiler/AbstractIL/ilwritepdb.fs | 4 +- src/Compiler/AbstractIL/ilwritepdb.fsi | 2 +- src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/Driver/CompilerOptions.fs | 92 ++----- src/Compiler/Driver/CompilerOptions.fsi | 2 +- src/Compiler/Driver/fsc.fs | 15 +- src/Compiler/Service/IncrementalBuild.fs | 2 +- src/Compiler/Utilities/Activity.fs | 300 +++++++++++++--------- src/Compiler/Utilities/Activity.fsi | 15 +- src/Compiler/Utilities/illib.fs | 8 +- 11 files changed, 214 insertions(+), 230 deletions(-) diff --git a/src/Compiler/AbstractIL/ilwrite.fsi b/src/Compiler/AbstractIL/ilwrite.fsi index d9f04d3212a..a5240473fb1 100644 --- a/src/Compiler/AbstractIL/ilwrite.fsi +++ b/src/Compiler/AbstractIL/ilwrite.fsi @@ -21,7 +21,7 @@ type options = checksumAlgorithm: HashAlgorithm signer: ILStrongNameSigner option emitTailcalls: bool - deterministic: bool + deterministic: bool dumpDebugInfo: bool referenceAssemblyOnly: bool referenceAssemblyAttribOpt: ILAttribute option diff --git a/src/Compiler/AbstractIL/ilwritepdb.fs b/src/Compiler/AbstractIL/ilwritepdb.fs index 6a10a3efb46..9b969bae098 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fs +++ b/src/Compiler/AbstractIL/ilwritepdb.fs @@ -344,7 +344,7 @@ type PortablePdbGenerator embedAllSource: bool, embedSourceList: string list, sourceLink: string, - checksumAlgorithm, + checksumAlgorithm, info: PdbData, pathMap: PathMap ) = @@ -829,7 +829,7 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (sourceLink: string) - checksumAlgorithm + checksumAlgorithm (info: PdbData) (pathMap: PathMap) = diff --git a/src/Compiler/AbstractIL/ilwritepdb.fsi b/src/Compiler/AbstractIL/ilwritepdb.fsi index be84dbbf425..5987cc165e3 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fsi +++ b/src/Compiler/AbstractIL/ilwritepdb.fsi @@ -106,7 +106,7 @@ val generatePortablePdb: embedAllSource: bool -> embedSourceList: string list -> sourceLink: string -> - checksumAlgorithm: HashAlgorithm -> + checksumAlgorithm: HashAlgorithm -> info: PdbData -> pathMap: PathMap -> int64 * BlobContentId * MemoryStream * string * byte[] diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index d4ff82dd1da..f36e85846d6 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -12095,6 +12095,6 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames) let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false) - assert(vspec.InlineInfo = inlineFlag) + //assert(vspec.InlineInfo = inlineFlag) vspec, tpenv) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 763afe9e820..2d06e20f3b0 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,80 +2368,21 @@ 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.reportTimeToFile.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) + + nPrev <- Some(descr, Activity.Profiling.startAndMeasureEnvironmentStats descr) 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 fb1c2402ab7..693303fb163 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.reportTimeToFile |> 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) @@ -1097,7 +1100,7 @@ let main6 outfile = outfile pdbfile = None emitTailcalls = tcConfig.emitTailcalls - deterministic = tcConfig.deterministic + deterministic = tcConfig.deterministic portablePDB = false embeddedPDB = false embedAllSource = tcConfig.embedAllSource @@ -1127,7 +1130,7 @@ let main6 outfile = outfile pdbfile = pdbfile emitTailcalls = tcConfig.emitTailcalls - deterministic = tcConfig.deterministic + deterministic = tcConfig.deterministic portablePDB = tcConfig.portablePDB embeddedPDB = tcConfig.embeddedPDB embedAllSource = tcConfig.embedAllSource 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 603852e3a49..caf62b4fc27 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -9,9 +9,23 @@ open System.Text open System.Collections.Concurrent open System.Threading.Tasks - [] -module Activity = +module internal 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 module Tags = let fileName = "fileName" @@ -20,46 +34,10 @@ module Activity = let userOpName = "userOpName" let length = "length" let cache = "cache" - let cpuDelta = "cpuDelta(s)" - let realDelta = "realDelta(s)" - let gc0 = "gc0" - let gc1 = "gc1" - let gc2 = "gc2" - let outputDllFile = "outputDllFile" - - let envStatsStart = "#stats_start" - let envStatsEnd = "#stats_end" let AllKnownTags = - [| - fileName - project - qualifiedNameOfFile - userOpName - length - cache - cpuDelta - realDelta - gc0 - gc1 - gc2 - outputDllFile - |] - - - type private EnvironmentStats = { Handles : int; Threads : int; WorkingSetMB : int64; GarbageCollectionsPerGeneration : int[]} - - let private collectEnvironmentStats () = - let p = Process.GetCurrentProcess() - { - Handles = p.HandleCount - Threads = p.Threads.Count - WorkingSetMB = p.WorkingSet64 / 1_000_000L - GarbageCollectionsPerGeneration = [| for i in 0..GC.MaxGeneration -> GC.CollectionCount i |] - } - + [| fileName; project; qualifiedNameOfFile; userOpName; length; cache |] - let private activitySourceName = "fsc" let private activitySource = new ActivitySource(activitySourceName) let start (name: string) (tags: (string * string) seq) : IDisposable = @@ -75,93 +53,161 @@ module Activity = let startNoTags (name: string) : IDisposable = activitySource.StartActivity(name) + module Profiling = - let private profiledSourceName = "fsc_with_env_stats" - let private profiledSource = new ActivitySource(profiledSourceName) - - let startAndMeasureEnvironmentStats (name : string) : IDisposable = profiledSource.StartActivity(name) - - let addStatsMeasurementListener () = - let l = - new ActivityListener( - ShouldListenTo = (fun a -> a.Name = profiledSourceName), - Sample = (fun _ -> ActivitySamplingResult.AllData), - ActivityStarted = (fun a -> a.AddTag(Tags.envStatsStart, collectEnvironmentStats()) |> ignore), - ActivityStopped = (fun a -> a.AddTag(Tags.envStatsEnd, collectEnvironmentStats()) |> ignore) - ) - ActivitySource.AddActivityListener(l) - - 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 - - if hasQuote then - txtVal <- txtVal.Replace("\"", "\\\"") - - if hasQuote || hasComma then - "\"" + txtVal + "\"" + 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) + + let addConsoleListener () = + addStatsMeasurementListener () + + let reportingStart = DateTime.UtcNow + let nameColumnWidth = 36 + + let header = + "|" + "Phase name".PadRight(nameColumnWidth) + + "|Elapsed |Duration| WS(MB)| GC0 | GC1 | GC2 |Handles|Threads|" + + let l = + 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(new String('-', header.Length)) + + ActivitySource.AddActivityListener(l) + + { new IDisposable with + member this.Dispose() = + Console.WriteLine(new String('-', header.Length)) + } + + module CsvExport = + + 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")) - 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 messages = new BlockingCollection(new ConcurrentQueue()) - - let l = - new ActivityListener( - ShouldListenTo = (fun a -> a.Name = activitySourceName || a.Name = profiledSourceName), - Sample = (fun _ -> ActivitySamplingResult.AllData), - ActivityStopped = (fun a -> messages.Add(createCsvRow a)) - ) - - ActivitySource.AddActivityListener(l) - - let writerTask = - Task.Factory.StartNew(fun () -> - use sw = new StreamWriter(path = pathToFile, append = true) - - for msg in messages.GetConsumingEnumerable() do - sw.WriteLine(msg)) - - { new IDisposable with - member this.Dispose() = - messages.CompleteAdding() - writerTask.Wait() - } + 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")) + 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 messages = new BlockingCollection(new ConcurrentQueue()) + + let l = + new ActivityListener( + ShouldListenTo = (fun a -> a.Name = activitySourceName || a.Name = profiledSourceName), + Sample = (fun _ -> ActivitySamplingResult.AllData), + ActivityStopped = (fun a -> messages.Add(createCsvRow a)) + ) + + ActivitySource.AddActivityListener(l) + + let writerTask = + Task.Factory.StartNew(fun () -> + use sw = new StreamWriter(path = pathToFile, append = true) + + for msg in messages.GetConsumingEnumerable() do + sw.WriteLine(msg)) + + { new IDisposable with + member this.Dispose() = + messages.CompleteAdding() + writerTask.Wait() + } diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index f70beb11e4f..746422455bf 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -16,19 +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 startAndMeasureEnvironmentStats: name: string -> IDisposable + module Profiling = + val startAndMeasureEnvironmentStats: name: string -> IDisposable + val addConsoleListener: unit -> IDisposable - val addCsvFileListener: pathToFile: string -> IDisposable + module CsvExport = + val addCsvFileListener: pathToFile: string -> IDisposable diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index df22bb9760e..6b83efe8d31 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -85,10 +85,12 @@ module internal PervasiveAutoOpens = | Some x -> x let reportTime = - let mutable tPrev : IDisposable = null + let mutable tPrev: IDisposable = null + fun descr -> - use _ = tPrev - tPrev <- FSharp.Compiler.Diagnostics.Activity.startAndMeasureEnvironmentStats descr + if isNotNull tPrev then + tPrev.Dispose() + tPrev <- FSharp.Compiler.Diagnostics.Activity.Profiling.startAndMeasureEnvironmentStats descr let foldOn p f z x = f z (p x) From 515617a475a9884fbd54ca54c8827cdcfba913fd Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 9 Dec 2022 16:17:21 +0100 Subject: [PATCH 14/22] formatting --- src/Compiler/Utilities/Activity.fs | 18 ++++++++++++------ src/Compiler/Utilities/illib.fs | 1 + 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index caf62b4fc27..f284a08f3ac 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -17,14 +17,19 @@ module internal Activity = type System.Diagnostics.Activity with - member this.RootId = + member this.RootId = let rec rootID (act: Activity) = if isNull act.ParentId then act.Id else rootID act.Parent + rootID this - member this.Depth = + member this.Depth = let rec depth (act: Activity) acc = - if isNull act.ParentId then acc else depth act.Parent (acc+1) + if isNull act.ParentId then + acc + else + depth act.Parent (acc + 1) + depth this 0 module Tags = @@ -105,7 +110,8 @@ module internal Activity = let nameColumnWidth = 36 let header = - "|" + "Phase name".PadRight(nameColumnWidth) + "|" + + "Phase name".PadRight(nameColumnWidth) + "|Elapsed |Duration| WS(MB)| GC0 | GC1 | GC2 |Handles|Threads|" let l = @@ -113,9 +119,9 @@ module internal Activity = ShouldListenTo = (fun a -> a.Name = profiledSourceName), Sample = (fun _ -> ActivitySamplingResult.AllData), ActivityStopped = - (fun a -> + (fun a -> Console.Write('|') - let indentedName = new String('>',a.Depth) + a.DisplayName + let indentedName = new String('>', a.Depth) + a.DisplayName Console.Write(indentedName.PadRight(nameColumnWidth)) let elapsed = (a.StartTimeUtc + a.Duration - reportingStart).TotalSeconds diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 6b83efe8d31..4bde88e2c02 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -90,6 +90,7 @@ module internal PervasiveAutoOpens = fun descr -> if isNotNull tPrev then tPrev.Dispose() + tPrev <- FSharp.Compiler.Diagnostics.Activity.Profiling.startAndMeasureEnvironmentStats descr let foldOn p f z x = f z (p x) From 9031e5fdb7e54ca9b62d0f79441acd8143be955a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 14 Dec 2022 13:53:09 +0100 Subject: [PATCH 15/22] formatting --- src/Compiler/Driver/CompilerOptions.fs | 2 +- src/Compiler/Driver/fsc.fs | 1 + src/Compiler/Utilities/Activity.fs | 2 +- src/Compiler/Utilities/Activity.fsi | 4 ++-- 4 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index fe822794805..25931776b60 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -1740,7 +1740,7 @@ let internalFlags (tcConfigB: TcConfigBuilder) = Some(InternalCommandLineOption("times", rangeCmdArgs)), None ) - + // "Write timing profiles for compilation to a file" CompilerOption( "times", diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 3d007039795..8d8a6763be9 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -582,6 +582,7 @@ let main1 tcConfig.writeTimesToFile |> Option.iter (fun f -> Activity.CsvExport.addCsvFileListener f |> disposables.Register + Activity.start "FSC compilation" [ diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 5123418e1b5..2bde73ccbb4 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -246,4 +246,4 @@ module internal Activity = 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 - } \ No newline at end of file + } diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index dcbad2be43e..746422455bf 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -16,14 +16,14 @@ module internal Activity = val userOpName: string val length: string val cache: string + val startNoTags: name: string -> IDisposable val start: name: string -> tags: (string * string) seq -> IDisposable - module Profiling = val startAndMeasureEnvironmentStats: name: string -> IDisposable val addConsoleListener: unit -> IDisposable module CsvExport = - val addCsvFileListener: pathToFile: string -> IDisposable \ No newline at end of file + val addCsvFileListener: pathToFile: string -> IDisposable From 9c8d938501b2d7e9e34b29b7e176b93919154d4f Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 14 Dec 2022 15:38:45 +0100 Subject: [PATCH 16/22] fix CI --- src/Compiler/Driver/CompilerConfig.fs | 5 ++--- src/Compiler/Utilities/Activity.fs | 11 ----------- 2 files changed, 2 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index cfe752f071b..dad6339607d 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -516,8 +516,7 @@ type TcConfigBuilder = mutable showBanner: bool /// show times between passes? - mutable showTimes: bool - mutable reportTimeToFile: string option + mutable showTimes: bool mutable writeTimesToFile: string option mutable showLoadedAssemblies: bool mutable continueAfterParseFailure: bool @@ -740,7 +739,7 @@ type TcConfigBuilder = preferredUiLang = None lcid = None productNameForBannerText = FSharpProductName - showBanner = true + showBanner = true showTimes = false writeTimesToFile = None showLoadedAssemblies = false diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 2bde73ccbb4..d8891abc67d 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -60,17 +60,6 @@ module internal Activity = depth this 0 - module Tags = - let fileName = "fileName" - let project = "project" - let qualifiedNameOfFile = "qualifiedNameOfFile" - let userOpName = "userOpName" - let length = "length" - let cache = "cache" - - let AllKnownTags = - [| fileName; project; qualifiedNameOfFile; userOpName; length; cache |] - let private activitySource = new ActivitySource(activitySourceName) let start (name: string) (tags: (string * string) seq) : IDisposable = From a2e4aabe453d1fdc71e553ac6158bac53f8102a3 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 14 Dec 2022 15:51:28 +0100 Subject: [PATCH 17/22] reformatted --- src/Compiler/Driver/CompilerConfig.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index dad6339607d..54e45ead3cc 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -516,7 +516,7 @@ type TcConfigBuilder = mutable showBanner: bool /// show times between passes? - mutable showTimes: bool + mutable showTimes: bool mutable writeTimesToFile: string option mutable showLoadedAssemblies: bool mutable continueAfterParseFailure: bool @@ -739,7 +739,7 @@ type TcConfigBuilder = preferredUiLang = None lcid = None productNameForBannerText = FSharpProductName - showBanner = true + showBanner = true showTimes = false writeTimesToFile = None showLoadedAssemblies = false From 74c86da8fc1dde372cb42efd48fb50451ff9a0a0 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 27 Dec 2022 17:01:17 +0100 Subject: [PATCH 18/22] Supporting proper finish of statistic measurement, to enable multiple runs in the same process This is especially needed for: - Test suites - Hosted scenarios --- src/Compiler/AbstractIL/ilwrite.fs | 1 + src/Compiler/Driver/CompilerOptions.fs | 5 ++++- src/Compiler/Utilities/Activity.fs | 17 +++++++++++++---- src/Compiler/Utilities/illib.fs | 6 +++++- .../CompilerOptions/fsc/times/times.fs | 4 ++-- 5 files changed, 25 insertions(+), 8 deletions(-) diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index 691f4bd3df8..76e7e61e688 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -3778,6 +3778,7 @@ let writePdb ( () reportTime "Signing Image" + reportTime "Finish" pdbBytes type options = diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 25931776b60..8b7584a2cf9 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2382,7 +2382,10 @@ let ReportTime = // Intentionally putting this right after the pause so a debugger can be attached. SimulateException tcConfig.simulateException) - nPrev <- Some(descr, Activity.Profiling.startAndMeasureEnvironmentStats descr) + 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/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index d8891abc67d..db64992794e 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -106,6 +106,9 @@ module internal Activity = ActivityStarted = (fun a -> a.AddTag(gcStatsInnerTag, collectGCStats ()) |> ignore), ActivityStopped = (fun a -> + if isNull a then + printfn "%A" a + // houston problem let statsBefore = a.GetTagItem(gcStatsInnerTag) :?> GCStats let statsAfter = collectGCStats () let p = Process.GetCurrentProcess() @@ -113,15 +116,19 @@ module internal Activity = a.AddTag(Tags.handles, p.HandleCount) |> ignore a.AddTag(Tags.threads, p.Threads.Count) |> ignore + if isNull statsBefore then + printfn "Houston problem %A" a + for i = 0 to statsAfter.Length - 1 do a.AddTag($"gc{i}", statsAfter[i] - statsBefore[i]) |> ignore) ) ActivitySource.AddActivityListener(l) + l let addConsoleListener () = - addStatsMeasurementListener () + let statsMeasurementListener = addStatsMeasurementListener () let reportingStart = DateTime.UtcNow let nameColumnWidth = 36 @@ -131,7 +138,7 @@ module internal Activity = + "Phase name".PadRight(nameColumnWidth) + "|Elapsed |Duration| WS(MB)| GC0 | GC1 | GC2 |Handles|Threads|" - let l = + let consoleWriterListener = new ActivityListener( ShouldListenTo = (fun a -> a.Name = profiledSourceName), Sample = (fun _ -> ActivitySamplingResult.AllData), @@ -154,10 +161,12 @@ module internal Activity = Console.WriteLine(header) Console.WriteLine(new String('-', header.Length)) - ActivitySource.AddActivityListener(l) + ActivitySource.AddActivityListener(consoleWriterListener) { new IDisposable with member this.Dispose() = + statsMeasurementListener.Dispose() + consoleWriterListener.Dispose() Console.WriteLine(new String('-', header.Length)) } @@ -223,7 +232,7 @@ module internal Activity = let l = new ActivityListener( - ShouldListenTo = (fun a -> a.Name = activitySourceName), + ShouldListenTo = (fun a -> a.Name = activitySourceName || a.Name = profiledSourceName), Sample = (fun _ -> ActivitySamplingResult.AllData), ActivityStopped = (fun a -> msgQueue.Post(createCsvRow a)) ) diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 4bde88e2c02..9aecc0b453b 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -91,7 +91,11 @@ module internal PervasiveAutoOpens = if isNotNull tPrev then tPrev.Dispose() - tPrev <- FSharp.Compiler.Diagnostics.Activity.Profiling.startAndMeasureEnvironmentStats descr + 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/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) [] From bb41ec9ea0cd5f05fdcc62d36d5f9cc621d5bef0 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 27 Dec 2022 17:06:25 +0100 Subject: [PATCH 19/22] Resolving build issue caused by conflict (movement of signing) --- src/Compiler/AbstractIL/ilwrite.fs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index e76fee56098..6aa80daad9f 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -3714,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 @@ -3769,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 = From b3c5e6352962bf62e7d2822214f57eef733229e2 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 27 Dec 2022 17:27:06 +0100 Subject: [PATCH 20/22] reformat --- src/Compiler/Driver/CompilerOptions.fs | 2 +- src/Compiler/Utilities/Activity.fs | 2 +- src/Compiler/Utilities/illib.fs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 8b7584a2cf9..96b637bd410 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2384,7 +2384,7 @@ let ReportTime = if descr <> "Exiting" then nPrev <- Some(descr, Activity.Profiling.startAndMeasureEnvironmentStats descr) - else + else nPrev <- None let ignoreFailureOnMono1_1_16 f = diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index db64992794e..43d247b1349 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -108,7 +108,7 @@ module internal Activity = (fun a -> if isNull a then printfn "%A" a - // houston problem + // houston problem let statsBefore = a.GetTagItem(gcStatsInnerTag) :?> GCStats let statsAfter = collectGCStats () let p = Process.GetCurrentProcess() diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 9aecc0b453b..11ed90c37fa 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -91,7 +91,7 @@ module internal PervasiveAutoOpens = if isNotNull tPrev then tPrev.Dispose() - tPrev <- + tPrev <- if descr <> "Finish" then FSharp.Compiler.Diagnostics.Activity.Profiling.startAndMeasureEnvironmentStats descr else From 0dfe61c0dc9598997f4c73af381c20bc7d4d1185 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 27 Dec 2022 17:36:42 +0100 Subject: [PATCH 21/22] Making console table markdown friendly (to be directly copy-pastable) --- src/Compiler/Utilities/Activity.fs | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 43d247b1349..a5f8000cfa0 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -106,9 +106,6 @@ module internal Activity = ActivityStarted = (fun a -> a.AddTag(gcStatsInnerTag, collectGCStats ()) |> ignore), ActivityStopped = (fun a -> - if isNull a then - printfn "%A" a - // houston problem let statsBefore = a.GetTagItem(gcStatsInnerTag) :?> GCStats let statsAfter = collectGCStats () let p = Process.GetCurrentProcess() @@ -116,9 +113,6 @@ module internal Activity = a.AddTag(Tags.handles, p.HandleCount) |> ignore a.AddTag(Tags.threads, p.Threads.Count) |> ignore - if isNull statsBefore then - printfn "Houston problem %A" a - for i = 0 to statsAfter.Length - 1 do a.AddTag($"gc{i}", statsAfter[i] - statsBefore[i]) |> ignore) @@ -159,7 +153,7 @@ module internal Activity = Console.WriteLine(new String('-', header.Length)) Console.WriteLine(header) - Console.WriteLine(new String('-', header.Length)) + Console.WriteLine(header |> String.map (fun c -> if c = '|' then c else '-')) ActivitySource.AddActivityListener(consoleWriterListener) From ce28d06ad8504ba019bb66ed6fde987b4c60255b Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 29 Dec 2022 21:05:17 +0100 Subject: [PATCH 22/22] Update src/Compiler/Checking/CheckExpressions.fs --- src/Compiler/Checking/CheckExpressions.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 43acb53fb3f..ef4930408a0 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -12088,6 +12088,6 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames) let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false) - //assert(vspec.InlineInfo = inlineFlag) + assert(vspec.InlineInfo = inlineFlag) vspec, tpenv)