From 2b391ff2825397c0da925cfe7ad619054f245001 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Fri, 9 Sep 2022 02:17:39 +0200 Subject: [PATCH] Add name and depth fo the stackguard threads (#13859) Co-authored-by: Don Syme --- src/Compiler/AbstractIL/ilwritepdb.fs | 2 +- src/Compiler/Checking/CheckBasics.fs | 2 +- .../Checking/CheckIncrementalClasses.fs | 2 +- src/Compiler/Checking/FindUnsolved.fs | 2 +- src/Compiler/Checking/PostInferenceChecks.fs | 2 +- src/Compiler/CodeGen/IlxGen.fs | 2 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 4 ++-- src/Compiler/Facilities/DiagnosticsLogger.fsi | 2 +- src/Compiler/Optimize/DetupleArgs.fs | 2 +- .../Optimize/InnerLambdasToTopLevelFuncs.fs | 2 +- src/Compiler/Optimize/LowerCalls.fs | 2 +- src/Compiler/Optimize/LowerLocalMutables.fs | 2 +- src/Compiler/Optimize/LowerStateMachines.fs | 2 +- src/Compiler/Optimize/Optimizer.fs | 2 +- src/Compiler/TypedTree/TypedTreeOps.fs | 20 +++++++++---------- 15 files changed, 25 insertions(+), 25 deletions(-) diff --git a/src/Compiler/AbstractIL/ilwritepdb.fs b/src/Compiler/AbstractIL/ilwritepdb.fs index 52fc97a977..715987a2ad 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fs +++ b/src/Compiler/AbstractIL/ilwritepdb.fs @@ -1037,6 +1037,6 @@ let rec pushShadowedLocals (stackGuard: StackGuard) (localsToPush: PdbLocalVar[] // adding the text " (shadowed)" to the names of those with name conflicts. let unshadowScopes rootScope = // Avoid stack overflow when writing linearly nested scopes - let stackGuard = StackGuard(100) + let stackGuard = StackGuard(100, "ILPdbWriter.unshadowScopes") let result, _ = pushShadowedLocals stackGuard [||] rootScope result diff --git a/src/Compiler/Checking/CheckBasics.fs b/src/Compiler/Checking/CheckBasics.fs index ee42b425a3..e6fb401437 100644 --- a/src/Compiler/Checking/CheckBasics.fs +++ b/src/Compiler/Checking/CheckBasics.fs @@ -341,7 +341,7 @@ type TcFileState = { g = g amap = amap recUses = ValMultiMap<_>.Empty - stackGuard = StackGuard(TcStackGuardDepth) + stackGuard = StackGuard(TcStackGuardDepth, "TcFileState") createsGeneratedProvidedTypes = false thisCcu = thisCcu isScript = isScript diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fs b/src/Compiler/Checking/CheckIncrementalClasses.fs index c5418132b8..c58414dfb0 100644 --- a/src/Compiler/Checking/CheckIncrementalClasses.fs +++ b/src/Compiler/Checking/CheckIncrementalClasses.fs @@ -527,7 +527,7 @@ type IncrClassReprInfo = PostTransform = (fun _ -> None) PreInterceptBinding = None RewriteQuotations = true - StackGuard = StackGuard(TcClassRewriteStackGuardDepth) } expr + StackGuard = StackGuard(TcClassRewriteStackGuardDepth, "FixupIncrClassExprPhase2C") } expr type IncrClassConstructionBindingsPhase2C = | Phase2CBindings of IncrClassBindingGroup list diff --git a/src/Compiler/Checking/FindUnsolved.fs b/src/Compiler/Checking/FindUnsolved.fs index 754a621520..3a3b8c9de8 100644 --- a/src/Compiler/Checking/FindUnsolved.fs +++ b/src/Compiler/Checking/FindUnsolved.fs @@ -285,7 +285,7 @@ let UnsolvedTyparsOfModuleDef g amap denv mdef extraAttribs = amap=amap denv=denv unsolved = [] - stackGuard = StackGuard(FindUnsolvedStackGuardDepth) } + stackGuard = StackGuard(FindUnsolvedStackGuardDepth, "UnsolvedTyparsOfModuleDef") } accModuleOrNamespaceDef cenv NoEnv mdef accAttribs cenv NoEnv extraAttribs List.rev cenv.unsolved diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 031c5ae799..41b4922a7d 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2615,7 +2615,7 @@ let CheckImplFile (g, amap, reportErrors, infoReader, internalsVisibleToPaths, v reportErrors = reportErrors boundVals = Dictionary<_, _>(100, HashIdentity.Structural) limitVals = Dictionary<_, _>(100, HashIdentity.Structural) - stackGuard = StackGuard(PostInferenceChecksStackGuardDepth) + stackGuard = StackGuard(PostInferenceChecksStackGuardDepth, "CheckImplFile") potentialUnboundUsesOfVals = Map.empty anonRecdTypes = StampMap.Empty usesQuotations = false diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 19f6de28fd..e83d70fd7f 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -11863,7 +11863,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai intraAssemblyInfo = intraAssemblyInfo optionsOpt = None optimizeDuringCodeGen = (fun _flag expr -> expr) - stackGuard = StackGuard(IlxGenStackGuardDepth) + stackGuard = StackGuard(IlxGenStackGuardDepth, "IlxAssemblyGenerator") } /// Register a set of referenced assemblies with the ILX code generator diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index aebfd1cfd6..4c82c5f445 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -813,7 +813,7 @@ let internal languageFeatureNotSupportedInLibraryError (langFeature: LanguageFea error (Error(FSComp.SR.chkFeatureNotSupportedInLibrary (featureStr, suggestedVersionStr), m)) /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached -type StackGuard(maxDepth: int) = +type StackGuard(maxDepth: int, name: string) = let mutable depth = 1 @@ -828,7 +828,7 @@ type StackGuard(maxDepth: int) = async { do! Async.SwitchToNewThread() - Thread.CurrentThread.Name <- "F# Extra Compilation Thread" + Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})" use _scope = new CompilationGlobalsScope(diagnosticsLogger, buildPhase) return f () } diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index c4f0b226e1..c3af3a7da9 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -389,7 +389,7 @@ val tryLanguageFeatureErrorOption: val languageFeatureNotSupportedInLibraryError: langFeature: LanguageFeature -> m: range -> 'T type StackGuard = - new: maxDepth: int -> StackGuard + new: maxDepth: int * name: string -> StackGuard /// Execute the new function, on a new thread if necessary member Guard: f: (unit -> 'T) -> 'T diff --git a/src/Compiler/Optimize/DetupleArgs.fs b/src/Compiler/Optimize/DetupleArgs.fs index 4bdb5262a0..dc2ea60f6e 100644 --- a/src/Compiler/Optimize/DetupleArgs.fs +++ b/src/Compiler/Optimize/DetupleArgs.fs @@ -864,7 +864,7 @@ let passImplFile penv assembly = PreInterceptBinding = None PostTransform = postTransformExpr penv RewriteQuotations = false - StackGuard = StackGuard(DetupleRewriteStackGuardDepth) } + StackGuard = StackGuard(DetupleRewriteStackGuardDepth, "RewriteImplFile") } assembly |> RewriteImplFile rwenv //------------------------------------------------------------------------- diff --git a/src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs b/src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs index a4b3620b78..ed2097236f 100644 --- a/src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs +++ b/src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs @@ -1366,7 +1366,7 @@ let MakeTopLevelRepresentationDecisions ccu g expr = recShortCallS = recShortCallS envPackM = envPackM fHatM = fHatM - stackGuard = StackGuard(InnerLambdasToTopLevelFunctionsStackGuardDepth) } + stackGuard = StackGuard(InnerLambdasToTopLevelFunctionsStackGuardDepth, "InnerLambdasToTopLevelFunctionsStackGuardDepth") } let z = Pass4_RewriteAssembly.rewriteState0 Pass4_RewriteAssembly.TransImplFile penv z expr diff --git a/src/Compiler/Optimize/LowerCalls.fs b/src/Compiler/Optimize/LowerCalls.fs index 5cf047f7e4..4fcbf9f36f 100644 --- a/src/Compiler/Optimize/LowerCalls.fs +++ b/src/Compiler/Optimize/LowerCalls.fs @@ -49,5 +49,5 @@ let LowerImplFile g assembly = PreInterceptBinding=None PostTransform= (fun _ -> None) RewriteQuotations=false - StackGuard = StackGuard(LowerCallsRewriteStackGuardDepth) } + StackGuard = StackGuard(LowerCallsRewriteStackGuardDepth, "LowerCallsRewriteStackGuardDepth") } assembly |> RewriteImplFile rwenv diff --git a/src/Compiler/Optimize/LowerLocalMutables.fs b/src/Compiler/Optimize/LowerLocalMutables.fs index 320df36ce3..0899875242 100644 --- a/src/Compiler/Optimize/LowerLocalMutables.fs +++ b/src/Compiler/Optimize/LowerLocalMutables.fs @@ -196,6 +196,6 @@ let TransformImplFile g amap implFile = PreInterceptBinding = Some(TransformBinding g heapValMap) PostTransform = (fun _ -> None) RewriteQuotations = true - StackGuard = StackGuard(AutoboxRewriteStackGuardDepth) } + StackGuard = StackGuard(AutoboxRewriteStackGuardDepth, "AutoboxRewriteStackGuardDepth") } diff --git a/src/Compiler/Optimize/LowerStateMachines.fs b/src/Compiler/Optimize/LowerStateMachines.fs index 3197225234..0f36b0db0e 100644 --- a/src/Compiler/Optimize/LowerStateMachines.fs +++ b/src/Compiler/Optimize/LowerStateMachines.fs @@ -358,7 +358,7 @@ type LowerStateMachine(g: TcGlobals) = PostTransform = (fun _ -> None) PreInterceptBinding = None RewriteQuotations=true - StackGuard = StackGuard(LowerStateMachineStackGuardDepth) } + StackGuard = StackGuard(LowerStateMachineStackGuardDepth, "LowerStateMachineStackGuardDepth") } let ConvertStateMachineLeafExpression (env: env) expr = if sm_verbose then printfn "ConvertStateMachineLeafExpression for %A..." expr diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 62e8078e8c..fa96506920 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -4325,7 +4325,7 @@ let OptimizeImplFile (settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncr localInternalVals=Dictionary(10000) emitTailcalls=emitTailcalls casApplied=Dictionary() - stackGuard = StackGuard(OptimizerStackGuardDepth) + stackGuard = StackGuard(OptimizerStackGuardDepth, "OptimizerStackGuardDepth") } let env, _, _, _ as results = OptimizeImplFileInternal cenv optEnv isIncrementalFragment fsiMultiAssemblyEmit hidden mimpls diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 8228d5782b..b27b273160 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -2209,7 +2209,7 @@ let CollectTypars = CollectTyparsAndLocals let CollectLocals = CollectTyparsAndLocals let CollectTyparsAndLocalsWithStackGuard() = - let stackGuard = StackGuard(AccFreeVarsStackGuardDepth) + let stackGuard = StackGuard(AccFreeVarsStackGuardDepth, "AccFreeVarsStackGuardDepth") CollectTyparsAndLocalsImpl (Some stackGuard) let CollectLocalsWithStackGuard() = CollectTyparsAndLocalsWithStackGuard() @@ -6248,31 +6248,31 @@ and remapImplFile ctxt compgen tmenv implFile = // Entry points let remapAttrib g tmenv attrib = - let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth, "RemapExprStackGuardDepth") } remapAttribImpl ctxt tmenv attrib let remapExpr g (compgen: ValCopyFlag) (tmenv: Remap) expr = - let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth, "RemapExprStackGuardDepth") } remapExprImpl ctxt compgen tmenv expr let remapPossibleForallTy g tmenv ty = - let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth, "RemapExprStackGuardDepth") } remapPossibleForallTyImpl ctxt tmenv ty let copyModuleOrNamespaceType g compgen mtyp = - let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth, "RemapExprStackGuardDepth") } copyAndRemapAndBindModTy ctxt compgen Remap.Empty mtyp |> fst let copyExpr g compgen e = - let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth, "RemapExprStackGuardDepth") } remapExprImpl ctxt compgen Remap.Empty e let copyImplFile g compgen e = - let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth, "RemapExprStackGuardDepth") } remapImplFile ctxt compgen Remap.Empty e |> fst let instExpr g tpinst e = - let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth, "RemapExprStackGuardDepth") } remapExprImpl ctxt CloneAll (mkInstRemap tpinst) e //-------------------------------------------------------------------------- @@ -7162,7 +7162,7 @@ let ExprFolder0 = type ExprFolders<'State> (folders: ExprFolder<'State>) = let mutable exprFClosure = Unchecked.defaultof<'State -> Expr -> 'State> // prevent reallocation of closure let mutable exprNoInterceptFClosure = Unchecked.defaultof<'State -> Expr -> 'State> // prevent reallocation of closure - let stackGuard = StackGuard(FoldExprStackGuardDepth) + let stackGuard = StackGuard(FoldExprStackGuardDepth, "FoldExprStackGuardDepth") let rec exprsF z xs = List.fold exprFClosure z xs @@ -9493,7 +9493,7 @@ and remapValToNonLocal ctxt tmenv inp = inp |> Construct.NewModifiedVal (remapValData ctxt tmenv) let ApplyExportRemappingToEntity g tmenv x = - let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth, "RemapExprStackGuardDepth") } remapTyconToNonLocal ctxt tmenv x (* Which constraints actually get compiled to .NET constraints? *)