@@ -16,6 +16,7 @@ open System.Runtime.InteropServices
1616open Internal.Utilities .Library
1717open Internal.Utilities .Library .Extras
1818open System.Threading .Tasks
19+ open System.Collections .Concurrent
1920
2021/// Represents the style being used to format errors
2122[<RequireQualifiedAccess; NoComparison; NoEquality>]
@@ -868,6 +869,66 @@ let internal languageFeatureNotSupportedInLibraryError (langFeature: LanguageFea
868869 let suggestedVersionStr = LanguageVersion.GetFeatureVersionString langFeature
869870 error ( Error( FSComp.SR.chkFeatureNotSupportedInLibrary ( featureStr, suggestedVersionStr), m))
870871
872+ module StackGuardMetrics =
873+
874+ let meter = FSharp.Compiler.Diagnostics.Metrics.Meter
875+
876+ let jumpCounter =
877+ meter.CreateCounter< int64>(
878+ " stackguard-jumps" ,
879+ description = " Tracks the number of times the stack guard has jumped to a new thread"
880+ )
881+
882+ let countJump memberName location =
883+ let tags =
884+ let mutable tags = TagList()
885+ tags.Add( Activity.Tags.callerMemberName, memberName)
886+ tags.Add( " source" , location)
887+ tags
888+
889+ jumpCounter.Add( 1 L, & tags)
890+
891+ // Used by the self-listener.
892+ let jumpsByFunctionName = ConcurrentDictionary<_, int64 ref>()
893+
894+ let Listen () =
895+ let listener = new Metrics.MeterListener()
896+
897+ listener.EnableMeasurementEvents jumpCounter
898+
899+ listener.SetMeasurementEventCallback( fun _ v tags _ ->
900+ let memberName = nonNull tags[ 0 ]. Value :?> string
901+ let source = nonNull tags[ 1 ]. Value :?> string
902+ let counter = jumpsByFunctionName.GetOrAdd(( memberName, source), fun _ -> ref 0 L)
903+ Interlocked.Add( counter, v) |> ignore)
904+
905+ listener.Start()
906+ listener :> IDisposable
907+
908+ let StatsToString () =
909+ let headers = [ " caller" ; " source" ; " jumps" ]
910+
911+ let data =
912+ [
913+ for kvp in jumpsByFunctionName do
914+ let ( memberName , source ) = kvp.Key
915+ [ memberName; source; string kvp.Value.Value ]
916+ ]
917+
918+ if List.isEmpty data then
919+ " "
920+ else
921+ $" StackGuard jumps:\n {Metrics.printTable headers data}"
922+
923+ let CaptureStatsAndWriteToConsole () =
924+ let listener = Listen()
925+
926+ { new IDisposable with
927+ member _.Dispose () =
928+ listener.Dispose()
929+ StatsToString() |> printfn " %s "
930+ }
931+
871932/// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached
872933type StackGuard ( maxDepth : int , name : string ) =
873934
@@ -882,22 +943,15 @@ type StackGuard(maxDepth: int, name: string) =
882943 [<CallerLineNumber; Optional; DefaultParameterValue( 0 ) >] line : int
883944 ) =
884945
885- Activity.addEventWithTags
886- " DiagnosticsLogger.StackGuard.Guard"
887- ( seq {
888- Activity.Tags.stackGuardName, box name
889- Activity.Tags.stackGuardCurrentDepth, depth
890- Activity.Tags.stackGuardMaxDepth, maxDepth
891- Activity.Tags.callerMemberName, memberName
892- Activity.Tags.callerFilePath, path
893- Activity.Tags.callerLineNumber, line
894- })
895-
896946 depth <- depth + 1
897947
898948 try
899949 if depth % maxDepth = 0 then
900950
951+ let fileName = System.IO.Path.GetFileName( path)
952+
953+ StackGuardMetrics.countJump memberName $" {fileName}:{line}"
954+
901955 async {
902956 do ! Async.SwitchToNewThread()
903957 Thread.CurrentThread.Name <- $" F# Extra Compilation Thread for {name} (depth {depth})"
0 commit comments