From c66df2e28acc6d3dd77f9fa2a19fcd51b069e530 Mon Sep 17 00:00:00 2001
From: Jimmy Byrd <jimmybyrd@gmail.com>
Date: Tue, 14 Mar 2023 23:26:52 -0400
Subject: [PATCH] More threadpool exhaustion fixes

---
 .../LspServers/AdaptiveFSharpLspServer.fs     | 22 +++++++++++--------
 .../LspServers/FSharpLspClient.fs             |  4 ++--
 2 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs
index 8631d836b..31af5c34e 100644
--- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs
+++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs
@@ -602,7 +602,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
 
         ()
       }
-      |> Async.RunSynchronouslyWithCT ct
+      |> fun work -> Async.StartImmediate(work, ct)
     with :? OperationCanceledException as e ->
       ()
 
@@ -717,7 +717,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
             use progressReport = new ServerProgressReport(lspClient)
 
             progressReport.Begin($"Loading {projects.Count} Projects")
-            |> Async.RunSynchronously
+            |> Async.StartImmediate
 
             let projectOptions =
               loader.LoadProjects(projects |> Seq.map (fst >> UMX.untag) |> Seq.toList, [], binlogConfig)
@@ -1015,8 +1015,18 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
 
 
   do
+    let filesystemShim file =
+      // GetLastWriteTimeShim gets called _alot_ and when we do checks on save we use Async.Parallel for type checking.
+      // Adaptive uses lots of locks under the covers, so many threads can get blocked waiting for data.
+      // We know we don't store anything other than Fsharp type files in open files so this so we shouldn't hit any locks
+      // when F# compiler asks for DLL timestamps
+      if Utils.isFileWithFSharp %file then
+        forceFindOpenFile file
+      else
+        None
+
     FSharp.Compiler.IO.FileSystemAutoOpens.FileSystem <-
-      FileSystem(FSharp.Compiler.IO.FileSystemAutoOpens.FileSystem, forceFindOpenFile)
+      FileSystem(FSharp.Compiler.IO.FileSystemAutoOpens.FileSystem, filesystemShim)
 
   let forceFindSourceText filePath =
     forceFindOpenFileOrRead filePath |> Result.map (fun f -> f.Lines)
@@ -1181,11 +1191,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
       let simpleName = Path.GetFileName(UMX.untag file.Lines.FileName)
       do! progressReport.Begin($"Typechecking {simpleName}", message = $"{file.Lines.FileName}")
 
-
-      // HACK: Insurance for a bug where FCS invalidates graph nodes incorrectly and seems to typecheck forever
-      use cts = new CancellationTokenSource()
-      cts.CancelAfter(TimeSpan.FromSeconds(60.))
-
       let! result =
         checker.ParseAndCheckFileInProject(
           file.Lines.FileName,
@@ -1194,7 +1199,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
           options,
           shouldCache = shouldCache
         )
-        |> Async.withCancellation cts.Token
         |> Debug.measureAsync $"checker.ParseAndCheckFileInProject - {file.Lines.FileName}"
 
       do! progressReport.End($"Typechecked {file.Lines.FileName}")
diff --git a/src/FsAutoComplete/LspServers/FSharpLspClient.fs b/src/FsAutoComplete/LspServers/FSharpLspClient.fs
index 2ddbce748..c5aeb03a4 100644
--- a/src/FsAutoComplete/LspServers/FSharpLspClient.fs
+++ b/src/FsAutoComplete/LspServers/FSharpLspClient.fs
@@ -139,7 +139,7 @@ type ServerProgressReport(lspClient: FSharpLspClient, ?token: ProgressToken) =
 
   interface IDisposable with
     member x.Dispose() =
-      (x :> IAsyncDisposable).DisposeAsync().GetAwaiter().GetResult()
+      (x :> IAsyncDisposable).DisposeAsync() |> ignore
 
 
 open System.Diagnostics.Tracing
@@ -279,7 +279,7 @@ type ProgressListener(lspClient: FSharpLspClient, traceNamespace: string array)
 
   interface IDisposable with
     member this.Dispose() : unit =
-      (this :> IAsyncDisposable).DisposeAsync().GetAwaiter().GetResult()
+      (this :> IAsyncDisposable).DisposeAsync() |> ignore
 
   interface IAsyncDisposable with
     member this.DisposeAsync() : ValueTask =