Fix tailcalls in async.fs

src/fsharp/FSharp.Core/async.fs

@@ -156,40 +156,58 @@ namespace Microsoft.FSharp.Control
             assert storedExnCont.IsNone
             storedExnCont <- Some action
 
-    type TrampolineHolder() as this =
+    type TrampolineHolder() =
         let mutable trampoline = null
 
-        // Preallocate this delegate and keep it in the trampoline holder.
-        let sendOrPostCallbackWithTrampoline =
-            SendOrPostCallback (fun o ->
-                let f = unbox<unit -> AsyncReturn> o
-                // Reminder: the ignore below ignores an AsyncReturn.
-                this.ExecuteWithTrampoline f |> ignore)
-
-        // Preallocate this delegate and keep it in the trampoline holder.
-        let waitCallbackForQueueWorkItemWithTrampoline =
-            WaitCallback (fun o ->
-                let f = unbox<unit -> AsyncReturn> o
-                this.ExecuteWithTrampoline f |> ignore)
-
-        // Preallocate this delegate and keep it in the trampoline holder.
-        let threadStartCallbackForStartThreadWithTrampoline =
-            ParameterizedThreadStart (fun o ->
-                let f = unbox<unit -> AsyncReturn> o
-                this.ExecuteWithTrampoline f |> ignore)
+        // On-demand allocate this delegate and keep it in the trampoline holder.
+        let mutable sendOrPostCallbackWithTrampoline : SendOrPostCallback = null
+        let getSendOrPostCallbackWithTrampoline(this: TrampolineHolder) =
+            match sendOrPostCallbackWithTrampoline with 
+            | null ->
+                sendOrPostCallbackWithTrampoline <- 
+                    SendOrPostCallback (fun o ->
+                    let f = unbox<unit -> AsyncReturn> o
+                    // Reminder: the ignore below ignores an AsyncReturn.
+                    this.ExecuteWithTrampoline f |> ignore)
+            | _ -> ()
+            sendOrPostCallbackWithTrampoline
+
+        // On-demand allocate this delegate and keep it in the trampoline holder.
+        let mutable waitCallbackForQueueWorkItemWithTrampoline : WaitCallback = null
+        let getWaitCallbackForQueueWorkItemWithTrampoline(this: TrampolineHolder) =
+            match waitCallbackForQueueWorkItemWithTrampoline with 
+            | null ->
+                waitCallbackForQueueWorkItemWithTrampoline <-
+                    WaitCallback (fun o ->
+                        let f = unbox<unit -> AsyncReturn> o
+                        this.ExecuteWithTrampoline f |> ignore)
+            | _ -> ()
+            waitCallbackForQueueWorkItemWithTrampoline
+
+        // On-demand allocate this delegate and keep it in the trampoline holder.
+        let mutable threadStartCallbackForStartThreadWithTrampoline : ParameterizedThreadStart = null
+        let getThreadStartCallbackForStartThreadWithTrampoline(this: TrampolineHolder) =
+            match threadStartCallbackForStartThreadWithTrampoline with 
+            | null ->
+                threadStartCallbackForStartThreadWithTrampoline <-
+                    ParameterizedThreadStart (fun o ->
+                        let f = unbox<unit -> AsyncReturn> o
+                        this.ExecuteWithTrampoline f |> ignore)
+            | _ -> ()
+            threadStartCallbackForStartThreadWithTrampoline
 
         /// Execute an async computation after installing a trampoline on its synchronous stack.
         [<DebuggerHidden>]
         member _.ExecuteWithTrampoline firstAction =
             trampoline <- Trampoline()
             trampoline.Execute firstAction
 
-        member _.PostWithTrampoline (syncCtxt: SynchronizationContext)  (f: unit -> AsyncReturn) =
-            syncCtxt.Post (sendOrPostCallbackWithTrampoline, state=(f |> box))
+        member this.PostWithTrampoline (syncCtxt: SynchronizationContext)  (f: unit -> AsyncReturn) =
+            syncCtxt.Post (getSendOrPostCallbackWithTrampoline(this), state=(f |> box))
             AsyncReturn.Fake()
 
-        member _.QueueWorkItemWithTrampoline (f: unit -> AsyncReturn) =
-            if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then
+        member this.QueueWorkItemWithTrampoline (f: unit -> AsyncReturn) =
+            if not (ThreadPool.QueueUserWorkItem(getWaitCallbackForQueueWorkItemWithTrampoline(this), f |> box)) then
                 failwith "failed to queue user work item"
             AsyncReturn.Fake()
 
@@ -199,8 +217,8 @@ namespace Microsoft.FSharp.Control
             | _ -> this.PostWithTrampoline syncCtxt f
 
         // This should be the only call to Thread.Start in this library. We must always install a trampoline.
-        member _.StartThreadWithTrampoline (f: unit -> AsyncReturn) =
-            Thread(threadStartCallbackForStartThreadWithTrampoline, IsBackground=true).Start(f|>box)
+        member this.StartThreadWithTrampoline (f: unit -> AsyncReturn) =
+            Thread(getThreadStartCallbackForStartThreadWithTrampoline(this), IsBackground=true).Start(f|>box)
             AsyncReturn.Fake()
 
         /// Save the exception continuation during propagation of an exception, or prior to raising an exception
@@ -287,18 +305,26 @@ namespace Microsoft.FSharp.Control
             contents.aux.ccont (OperationCanceledException (contents.aux.token))
 
         /// Check for trampoline hijacking.
-        member inline _.HijackCheckThenCall cont arg =
-            contents.aux.trampolineHolder.HijackCheckThenCall cont arg
+        // Note, this must make tailcalls, so may not be an instance member taking a byref argument,
+        /// nor call any members taking byref arguments.
+        static member inline HijackCheckThenCall (ctxt: AsyncActivation<'T>) cont arg =
+            ctxt.aux.trampolineHolder.HijackCheckThenCall cont arg
 
         /// Call the success continuation of the asynchronous execution context after checking for
         /// cancellation and trampoline hijacking.
         //   - Cancellation check
         //   - Hijack check
-        member ctxt.OnSuccess result =
+        //
+        // Note, this must make tailcalls, so may not be an instance member taking a byref argument.
+        static member Success (ctxt: AsyncActivation<'T>) result =
             if ctxt.IsCancellationRequested then
                 ctxt.OnCancellation ()
             else
-                ctxt.HijackCheckThenCall ctxt.cont result
+                AsyncActivation<'T>.HijackCheckThenCall ctxt ctxt.cont result
+
+        // For backwards API Compat
+        [<Obsolete("Call Success instead")>]
+        member ctxt.OnSuccess (result: 'T) = AsyncActivation<'T>.Success ctxt result
 
         /// Save the exception continuation during propagation of an exception, or prior to raising an exception
         member _.OnExceptionRaised() =
@@ -381,7 +407,7 @@ namespace Microsoft.FSharp.Control
         // Note: direct calls to this function may end up in user assemblies via inlining
         [<DebuggerHidden>]
         let Invoke (computation: Async<'T>) (ctxt: AsyncActivation<_>) : AsyncReturn =
-            ctxt.HijackCheckThenCall computation.Invoke ctxt
+            AsyncActivation<'T>.HijackCheckThenCall ctxt computation.Invoke ctxt
 
         /// Apply 'userCode' to 'arg'. If no exception is raised then call the normal continuation.  Used to implement
         /// 'finally' and 'when cancelled'.
@@ -401,7 +427,7 @@ namespace Microsoft.FSharp.Control
                     ctxt.OnExceptionRaised()
 
             if ok then
-                ctxt.HijackCheckThenCall ctxt.cont result
+                AsyncActivation<'T>.HijackCheckThenCall ctxt ctxt.cont result
             else
                 fake()
 
@@ -466,7 +492,7 @@ namespace Microsoft.FSharp.Control
             if ok then
                 match resOpt with
                 | None ->
-                    ctxt.HijackCheckThenCall ctxt.econt edi
+                    AsyncActivation<'T>.HijackCheckThenCall ctxt ctxt.econt edi
                 | Some res ->
                     Invoke res ctxt
             else
@@ -569,7 +595,7 @@ namespace Microsoft.FSharp.Control
         ///   - Hijack check (see OnSuccess)
         let inline CreateReturnAsync res =
             // Note: this code ends up in user assemblies via inlining
-            MakeAsync (fun ctxt -> ctxt.OnSuccess res)
+            MakeAsync (fun ctxt -> AsyncActivation.Success ctxt res)
 
         /// Runs the first process, takes its result, applies f and then runs the new process produced.
         ///   - Initial cancellation check (see Bind)

src/fsharp/FSharp.Core/async.fsi

@@ -622,7 +622,12 @@ namespace Microsoft.FSharp.Control
         /// <summary>The F# compiler emits calls to this function to implement F# async expressions.</summary>
         ///
         /// <returns>A value indicating asynchronous execution.</returns>
-        member OnSuccess: 'T -> AsyncReturn
+        static member Success: AsyncActivation<'T> -> result: 'T -> AsyncReturn
+
+        /// <summary>The F# compiler emits calls to this function to implement F# async expressions.</summary>
+        ///
+        /// <returns>A value indicating asynchronous execution.</returns>
+        member OnSuccess: result: 'T -> AsyncReturn
 
         /// <summary>The F# compiler emits calls to this function to implement F# async expressions.</summary>
         member OnExceptionRaised: unit -> unit

src/fsharp/IlxGen.fs

@@ -3415,7 +3415,7 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel =
 
           // For instance method calls chop off some type arguments, which are already
           // carried by the class.  Also work out if it's a virtual call.
-          let _, virtualCall, newobj, isSuperInit, isSelfInit, _, _, _ = GetMemberCallInfo g (vref, valUseFlags)
+          let _, virtualCall, newobj, isSuperInit, isSelfInit, takesInstanceArg, _, _ = GetMemberCallInfo g (vref, valUseFlags)
 
           // numEnclILTypeArgs will include unit-of-measure args, unfortunately. For now, just cut-and-paste code from GetMemberCallInfo
           // @REVIEW: refactor this
@@ -3447,7 +3447,8 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel =
                   let isDllImport = IsValRefIsDllImport g vref
                   let hasByrefArg = mspec.FormalArgTypes |> List.exists (function ILType.Byref _ -> true | _ -> false)
                   let makesNoCriticalTailcalls = vref.MakesNoCriticalTailcalls
-                  CanTailcall((boxity=AsValue), ccallInfo, eenv.withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, isSelfInit, makesNoCriticalTailcalls, sequel)
+                  let hasStructObjArg = (boxity=AsValue) && takesInstanceArg
+                  CanTailcall(hasStructObjArg, ccallInfo, eenv.withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, isSelfInit, makesNoCriticalTailcalls, sequel)
               else
                   Normalcall
 
@@ -4193,7 +4194,8 @@ and GenILCall cenv cgbuf eenv (virt, valu, newobj, valUseFlags, isDllImport, ilM
     let boxity = (if valu then AsValue else AsObject)
     let mustGenerateUnitAfterCall = isNil returnTys
     let makesNoCriticalTailcalls = (newobj || not virt) // Don't tailcall for 'newobj', or 'call' to IL code
-    let tail = CanTailcall(valu, ccallInfo, eenv.withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, false, makesNoCriticalTailcalls, sequel)
+    let hasStructObjArg = valu && ilMethRef.CallingConv.IsInstance
+    let tail = CanTailcall(hasStructObjArg, ccallInfo, eenv.withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, false, makesNoCriticalTailcalls, sequel)
 
     let ilEnclArgTys = GenTypeArgs cenv.amap m eenv.tyenv enclArgTys
     let ilMethArgTys = GenTypeArgs cenv.amap m eenv.tyenv methArgTys

tests/FSharp.Core.UnitTests/SurfaceArea.fs

@@ -513,6 +513,7 @@ Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean IsCancellationRequested
 Microsoft.FSharp.Control.AsyncActivation`1[T]: Boolean get_IsCancellationRequested()
 Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnCancellation()
 Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn OnSuccess(T)
+Microsoft.FSharp.Control.AsyncActivation`1[T]: Microsoft.FSharp.Control.AsyncReturn Success(Microsoft.FSharp.Control.AsyncActivation`1[T], T)
 Microsoft.FSharp.Control.AsyncActivation`1[T]: Void OnExceptionRaised()
 Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn Bind[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], Microsoft.FSharp.Control.FSharpAsync`1[TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]])
 Microsoft.FSharp.Control.AsyncPrimitives: Microsoft.FSharp.Control.AsyncReturn CallThenInvoke[T,TResult](Microsoft.FSharp.Control.AsyncActivation`1[T], TResult, Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Control.FSharpAsync`1[T]])

tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest3.il.bsl

@@ -1,5 +1,5 @@
 
-//  Microsoft (R) .NET Framework IL Disassembler.  Version 4.6.1055.0
+//  Microsoft (R) .NET Framework IL Disassembler.  Version 4.8.3928.0
 //  Copyright (c) Microsoft Corporation.  All rights reserved.
 
 
@@ -13,7 +13,7 @@
 .assembly extern FSharp.Core
 {
   .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A )                         // .?_....:
-  .ver 4:4:3:0
+  .ver 5:0:0:0
 }
 .assembly AsyncExpressionSteppingTest3
 {
@@ -29,20 +29,20 @@
 }
 .mresource public FSharpSignatureData.AsyncExpressionSteppingTest3
 {
-  // Offset: 0x00000000 Length: 0x00000277
+  // Offset: 0x00000000 Length: 0x0000026B
 }
 .mresource public FSharpOptimizationData.AsyncExpressionSteppingTest3
 {
-  // Offset: 0x00000280 Length: 0x000000B1
+  // Offset: 0x00000270 Length: 0x000000B1
 }
 .module AsyncExpressionSteppingTest3.dll
-// MVID: {5AF5DDAE-6394-F35E-A745-0383AEDDF55A}
+// MVID: {60EDFA6D-6394-F35E-A745-03836DFAED60}
 .imagebase 0x00400000
 .file alignment 0x00000200
 .stackreserve 0x00100000
 .subsystem 0x0003       // WINDOWS_CUI
 .corflags 0x00000001    //  ILONLY
-// Image base: 0x04650000
+// Image base: 0x06D00000
 
 
 // =============== CLASS MEMBERS DECLARATION ===================
@@ -80,15 +80,17 @@
       .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn 
               Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1<int32> ctxt) cil managed
       {
-        // Code size       14 (0xe)
+        // Code size       15 (0xf)
         .maxstack  8
         .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}'
-        .line 10,10 : 17,25 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest3.fs'
-        IL_0000:  ldarga.s   ctxt
-        IL_0002:  ldarg.0
-        IL_0003:  ldfld      int32 AsyncExpressionSteppingTest3/AsyncExpressionSteppingTest3/'f3@10-1'::'value'
-        IL_0008:  call       instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1<int32>::OnSuccess(!0)
-        IL_000d:  ret
+        .line 10,10 : 17,25 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest3.fs'
+        IL_0000:  ldarg.1
+        IL_0001:  ldarg.0
+        IL_0002:  ldfld      int32 AsyncExpressionSteppingTest3/AsyncExpressionSteppingTest3/'f3@10-1'::'value'
+        IL_0007:  tail.
+        IL_0009:  call       class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1<int32>::Success(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1<!0>,
+                                                                                                                                                                       !0)
+        IL_000e:  ret
       } // end of method 'f3@10-1'::Invoke
 
     } // end of class 'f3@10-1'

tests/fsharpqa/Source/CodeGen/EmittedIL/AsyncExpressionStepping/AsyncExpressionSteppingTest4.il.bsl

@@ -1,5 +1,5 @@
 
-//  Microsoft (R) .NET Framework IL Disassembler.  Version 4.6.1055.0
+//  Microsoft (R) .NET Framework IL Disassembler.  Version 4.8.3928.0
 //  Copyright (c) Microsoft Corporation.  All rights reserved.
 
 
@@ -13,7 +13,7 @@
 .assembly extern FSharp.Core
 {
   .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A )                         // .?_....:
-  .ver 4:4:3:0
+  .ver 5:0:0:0
 }
 .assembly AsyncExpressionSteppingTest4
 {
@@ -29,20 +29,20 @@
 }
 .mresource public FSharpSignatureData.AsyncExpressionSteppingTest4
 {
-  // Offset: 0x00000000 Length: 0x00000277
+  // Offset: 0x00000000 Length: 0x0000026B
 }
 .mresource public FSharpOptimizationData.AsyncExpressionSteppingTest4
 {
-  // Offset: 0x00000280 Length: 0x000000B1
+  // Offset: 0x00000270 Length: 0x000000B1
 }
 .module AsyncExpressionSteppingTest4.dll
-// MVID: {5AF5DDAE-6394-6D4B-A745-0383AEDDF55A}
+// MVID: {60EDFA6D-6394-6D4B-A745-03836DFAED60}
 .imagebase 0x00400000
 .file alignment 0x00000200
 .stackreserve 0x00100000
 .subsystem 0x0003       // WINDOWS_CUI
 .corflags 0x00000001    //  ILONLY
-// Image base: 0x028F0000
+// Image base: 0x06840000
 
 
 // =============== CLASS MEMBERS DECLARATION ===================
@@ -80,15 +80,17 @@
       .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn 
               Invoke(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1<int32> ctxt) cil managed
       {
-        // Code size       14 (0xe)
+        // Code size       15 (0xf)
         .maxstack  8
         .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}'
-        .line 10,10 : 21,29 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest4.fs'
-        IL_0000:  ldarga.s   ctxt
-        IL_0002:  ldarg.0
-        IL_0003:  ldfld      int32 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@10-2'::'value'
-        IL_0008:  call       instance class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1<int32>::OnSuccess(!0)
-        IL_000d:  ret
+        .line 10,10 : 21,29 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\AsyncExpressionStepping\\AsyncExpressionSteppingTest4.fs'
+        IL_0000:  ldarg.1
+        IL_0001:  ldarg.0
+        IL_0002:  ldfld      int32 AsyncExpressionSteppingTest4/AsyncExpressionSteppingTest4/'f4@10-2'::'value'
+        IL_0007:  tail.
+        IL_0009:  call       class [FSharp.Core]Microsoft.FSharp.Control.AsyncReturn valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1<int32>::Success(valuetype [FSharp.Core]Microsoft.FSharp.Control.AsyncActivation`1<!0>,
+                                                                                                                                                                       !0)
+        IL_000e:  ret
       } // end of method 'f4@10-2'::Invoke
 
     } // end of class 'f4@10-2'