Implement Ctrl+C on coreclr (#13428)

* Ctrl+C on coreclr

* Update ControlledExecution.fs

Co-authored-by: Don Syme <[email protected]>

Author: KevinRansom

.gitignore

@@ -69,10 +69,11 @@ ossreadme*.txt
 *.fsproj.user
 *.vbproj.user
 *.sln.DotSettings.user
+launchSettings.json
 *.log
 *.jrs
 *.chk
-*.bak                                                     
+*.bak
 *.vserr
 *.err
 *.orig

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -463,9 +463,9 @@
     <Compile Include="Service\ServiceStructure.fs" />
     <Compile Include="Service\ServiceAnalysis.fsi" />
     <Compile Include="Service\ServiceAnalysis.fs" />
+    <Compile Include="Interactive\ControlledExecution.fs" />
     <Compile Include="Interactive\fsi.fsi" />
     <Compile Include="Interactive\fsi.fs" />
-
     <!-- A legacy resolver used to help with scripting diagnostics in the Visual Studio tools -->
     <Compile Include="Legacy\LegacyMSBuildReferenceResolver.fsi" Condition="'$(MonoPackaging)' != 'true'" />
     <Compile Include="Legacy\LegacyMSBuildReferenceResolver.fs" Condition="'$(MonoPackaging)' != 'true'" />

src/Compiler/Interactive/ControlledExecution.fs

@@ -0,0 +1,75 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+// This wraps System.Runtime.CompilerServices.ControlledExecution
+// This class enables scripting engines such as Fsi to abort threads safely in the coreclr
+// This functionality will be introduced in .net 7.0.
+// because we continue to dupport older coreclrs and the windows desktop framework through netstandard2.0
+// we access the features using reflection
+
+namespace FSharp.Compiler.Interactive
+
+open System
+open System.Reflection
+open System.Threading
+
+open Internal.Utilities.FSharpEnvironment
+
+type internal ControlledExecution (thread:Thread) =
+
+    static let ceType: Type option =
+        Option.ofObj (Type.GetType("System.Runtime.CompilerServices.ControlledExecution, System.Private.CoreLib", false))
+
+    static let threadType: Type option =
+        Option.ofObj (typeof<Threading.Thread>)
+
+    static let ceConstructor: ConstructorInfo option =
+        match ceType with
+        | None -> None
+        | Some t -> Option.ofObj (t.GetConstructor([|typeof<Action>|]))
+
+    static let ceRun: MethodInfo option =
+        match ceType with
+        | None -> None
+        | Some t -> Option.ofObj (t.GetMethod("Run", [||]) )
+
+    static let ceTryAbort: MethodInfo option =
+        match ceType with
+        | None -> None
+        | Some t -> Option.ofObj (t.GetMethod("TryAbort", [|typeof<TimeSpan>|]))
+
+    static let threadResetAbort: MethodInfo option =
+        match isRunningOnCoreClr, threadType with
+        | false, Some t -> Option.ofObj (t.GetMethod("ResetAbort", [||]))
+        | _ -> None
+
+    let newInstance (action: Action) =
+        match ceConstructor with
+        | None -> None
+        | Some c -> Option.ofObj (c.Invoke([|action|]))
+
+    let mutable instance = Unchecked.defaultof<obj option>
+
+    member this.Run(action: Action) =
+        let newinstance = newInstance(action)
+        match newinstance, ceRun with
+        | Some inst, Some ceRun ->
+            instance <- newinstance
+            ceRun.Invoke(inst, [||]) |> ignore
+        | _ -> action.Invoke()
+
+    member _.TryAbort(timeout: TimeSpan): bool =
+        match isRunningOnCoreClr, instance, ceTryAbort with
+        | _, Some instance, Some tryAbort -> tryAbort.Invoke(instance, [|timeout|]) :?> bool
+        | false, _, _ -> thread.Abort(); true
+        | true, _, _ -> true
+
+    member _.ResetAbort() =
+        match thread, threadResetAbort with
+        | thread, Some threadResetAbort -> threadResetAbort.Invoke(thread, [||]) |> ignore
+        | _ -> ()
+
+    static member StripTargetInvocationException(exn: Exception) =
+       match exn with
+       | :? TargetInvocationException as e when not(isNull e.InnerException) ->
+            ControlledExecution.StripTargetInvocationException(e.InnerException)
+       | _ -> exn

src/Compiler/Interactive/fsi.fs

@@ -47,6 +47,7 @@ open FSharp.Compiler.EditorServices
 open FSharp.Compiler.DiagnosticsLogger
 open FSharp.Compiler.Features
 open FSharp.Compiler.IlxGen
+open FSharp.Compiler.Interactive
 open FSharp.Compiler.InfoReader
 open FSharp.Compiler.IO
 open FSharp.Compiler.Lexhelp
@@ -2208,7 +2209,10 @@ type internal FsiInterruptControllerKillerThreadRequest =
     | ExitRequest
     | PrintInterruptRequest
 
-type internal FsiInterruptController(fsiOptions: FsiCommandLineOptions, fsiConsoleOutput: FsiConsoleOutput) =
+type internal FsiInterruptController(
+    fsiOptions: FsiCommandLineOptions,
+    controlledExecution: ControlledExecution,
+    fsiConsoleOutput: FsiConsoleOutput) =
 
     let mutable stdinInterruptState = StdinNormal
     let CTRL_C = 0
@@ -2240,7 +2244,12 @@ type internal FsiInterruptController(fsiOptions: FsiCommandLineOptions, fsiConso
 
     member _.EventHandlers = ctrlEventHandlers
 
-    member controller.InstallKillThread(threadToKill:Thread, pauseMilliseconds:int) =
+    member _.ControlledExecution() = controlledExecution
+
+    member controller.InstallKillThread() =
+        // Compute how long to pause before a ThreadAbort is actually executed.
+        // A somewhat arbitrary choice.
+        let pauseMilliseconds = (if fsiOptions.Gui then 400 else 100)
 
         // Fsi Interrupt handler
         let raiseCtrlC() =
@@ -2259,8 +2268,11 @@ type internal FsiInterruptController(fsiOptions: FsiCommandLineOptions, fsiConso
                         if killThreadRequest = ThreadAbortRequest then
                             if progress then fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiAbortingMainThread())
                             killThreadRequest <- NoRequest
-                            threadToKill.Abort()
-                        ()),Name="ControlCAbortThread")
+                            let rec abortLoop n =
+                                if n > 0 then
+                                    if not (controlledExecution.TryAbort(TimeSpan.FromSeconds(30))) then abortLoop (n-1)
+                            abortLoop 3
+                        ()), Name="ControlCAbortThread")
                 killerThread.IsBackground <- true
                 killerThread.Start()
 
@@ -2853,24 +2865,35 @@ type FsiInteractionProcessor
     /// Execute a single parsed interaction on the parser/execute thread.
     let mainThreadProcessAction ctok action istate =
         try
-            let tcConfig = TcConfig.Create(tcConfigB,validate=false)
-            if progress then fprintfn fsiConsoleOutput.Out "In mainThreadProcessAction...";
-            fsiInterruptController.InterruptAllowed <- InterruptCanRaiseException;
-            let res = action ctok tcConfig istate
-            fsiInterruptController.ClearInterruptRequest()
-            fsiInterruptController.InterruptAllowed <- InterruptIgnored;
-            res
+            let mutable result = Unchecked.defaultof<'a * FsiInteractionStepStatus>
+            fsiInterruptController.ControlledExecution().Run(
+            fun () ->
+                let tcConfig = TcConfig.Create(tcConfigB,validate=false)
+                if progress then fprintfn fsiConsoleOutput.Out "In mainThreadProcessAction..."
+                fsiInterruptController.InterruptAllowed <- InterruptCanRaiseException;
+                let res = action ctok tcConfig istate
+                fsiInterruptController.ClearInterruptRequest()
+                fsiInterruptController.InterruptAllowed <- InterruptIgnored
+                result <- res)
+            result
         with
         | :? ThreadAbortException ->
-           fsiInterruptController.ClearInterruptRequest()
-           fsiInterruptController.InterruptAllowed <- InterruptIgnored;
-           (try Thread.ResetAbort() with _ -> ());
-           (istate,CtrlC)
+            fsiInterruptController.ClearInterruptRequest()
+            fsiInterruptController.InterruptAllowed <- InterruptIgnored
+            fsiInterruptController.ControlledExecution().ResetAbort()
+            (istate,CtrlC)
+
+        | :? TargetInvocationException as e when (ControlledExecution.StripTargetInvocationException(e)).GetType().Name = "ThreadAbortException" ->
+            fsiInterruptController.ClearInterruptRequest()
+            fsiInterruptController.InterruptAllowed <- InterruptIgnored
+            fsiInterruptController.ControlledExecution().ResetAbort()
+            (istate,CtrlC)
+
         |  e ->
-           fsiInterruptController.ClearInterruptRequest()
-           fsiInterruptController.InterruptAllowed <- InterruptIgnored;
-           stopProcessingRecovery e range0;
-           istate, CompletedWithReportedError e
+            fsiInterruptController.ClearInterruptRequest()
+            fsiInterruptController.InterruptAllowed <- InterruptIgnored;
+            stopProcessingRecovery e range0;
+            istate, CompletedWithReportedError e
 
     let mainThreadProcessParsedInteractions ctok diagnosticsLogger (action, istate) cancellationToken =
       istate |> mainThreadProcessAction ctok (fun ctok tcConfig istate ->
@@ -3180,27 +3203,32 @@ let internal SpawnInteractiveServer
 /// Repeatedly drive the event loop (e.g. Application.Run()) but catching ThreadAbortException and re-running.
 ///
 /// This gives us a last chance to catch an abort on the main execution thread.
-let internal DriveFsiEventLoop (fsi: FsiEvaluationSessionHostConfig, fsiConsoleOutput: FsiConsoleOutput) =
+let internal DriveFsiEventLoop (fsi: FsiEvaluationSessionHostConfig, fsiInterruptController: FsiInterruptController, fsiConsoleOutput: FsiConsoleOutput) =
+
+    if progress then fprintfn fsiConsoleOutput.Out "GUI thread runLoop"
+    fsiInterruptController.InstallKillThread()
+
     let rec runLoop() =
-        if progress then fprintfn fsiConsoleOutput.Out "GUI thread runLoop";
+
         let restart =
             try
-              // BLOCKING POINT: The GUI Thread spends most (all) of its time this event loop
-              if progress then fprintfn fsiConsoleOutput.Out "MAIN:  entering event loop...";
-              fsi.EventLoopRun()
+                fsi.EventLoopRun()
             with
-            |  :? ThreadAbortException ->
+            | :? TargetInvocationException as e when (ControlledExecution.StripTargetInvocationException(e)).GetType().Name = "ThreadAbortException" ->
               // If this TAE handler kicks it's almost certainly too late to save the
               // state of the process - the state of the message loop may have been corrupted
-              fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiUnexpectedThreadAbortException());
-              (try Thread.ResetAbort() with _ -> ());
+              fsiInterruptController.ControlledExecution().ResetAbort()
               true
-              // Try again, just case we can restart
-            | e ->
-              stopProcessingRecovery e range0;
+            | :? ThreadAbortException ->
+              // If this TAE handler kicks it's almost certainly too late to save the
+              // state of the process - the state of the message loop may have been corrupted
+              fsiInterruptController.ControlledExecution().ResetAbort()
               true
-              // Try again, just case we can restart
-        if progress then fprintfn fsiConsoleOutput.Out "MAIN:  exited event loop...";
+            | e ->
+                stopProcessingRecovery e range0
+                true
+        // Try again, just case we can restart
+        if progress then fprintfn fsiConsoleOutput.Out "MAIN:  exited event loop..."
         if restart then runLoop()
 
     runLoop();
@@ -3380,7 +3408,9 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i
 
     let fsiDynamicCompiler = FsiDynamicCompiler(fsi, timeReporter, tcConfigB, tcLockObject, outWriter, tcImports, tcGlobals, fsiOptions, fsiConsoleOutput, fsiCollectible, niceNameGen, resolveAssemblyRef)
 
-    let fsiInterruptController = FsiInterruptController(fsiOptions, fsiConsoleOutput)
+    let controlledExecution = ControlledExecution(Thread.CurrentThread)
+
+    let fsiInterruptController = FsiInterruptController(fsiOptions, controlledExecution, fsiConsoleOutput)
 
     let uninstallMagicAssemblyResolution = MagicAssemblyResolution.Install(tcConfigB, tcImports, fsiDynamicCompiler, fsiConsoleOutput)
 
@@ -3640,14 +3670,6 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i
         if fsiOptions.Interact then
             // page in the type check env
             fsiInteractionProcessor.LoadDummyInteraction(ctokStartup, diagnosticsLogger)
-            if progress then fprintfn fsiConsoleOutput.Out "MAIN: InstallKillThread!";
-
-            // Compute how long to pause before a ThreadAbort is actually executed.
-            // A somewhat arbitrary choice.
-            let pauseMilliseconds = (if fsiOptions.Gui then 400 else 100)
-
-            // Request that ThreadAbort interrupts be performed on this (current) thread
-            fsiInterruptController.InstallKillThread(Thread.CurrentThread, pauseMilliseconds)
             if progress then fprintfn fsiConsoleOutput.Out "MAIN: got initial state, creating form";
 
 #if !FX_NO_APP_DOMAINS
@@ -3657,12 +3679,10 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i
                 | :? System.Exception as err -> x.ReportUnhandledExceptionSafe false err
                 | _ -> ())
 #endif
-
             fsiInteractionProcessor.LoadInitialFiles(ctokRun, diagnosticsLogger)
-
             fsiInteractionProcessor.StartStdinReadAndProcessThread(diagnosticsLogger)
 
-            DriveFsiEventLoop (fsi, fsiConsoleOutput )
+            DriveFsiEventLoop (fsi, fsiInterruptController, fsiConsoleOutput)
 
         else // not interact
             if progress then fprintfn fsiConsoleOutput.Out "Run: not interact, loading initial files..."