Fix debug tailcalls for pipelines if /tailcalls+ is explicitly specif…

…ied (#12430) * don't suppress tailcalls in pipeline debugging if tailcalls are on * don't suppress tailcalls in pipeline debugging if tailcalls are on
dotnet · Nov 22, 2021 · c5da378 · c5da378
1 parent 3d15c43
commit c5da378
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 21 deletions.
diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs
@@ -2941,26 +2941,35 @@ and GenLinearExpr cenv cgbuf eenv sp expr sequel preSteps (contf: FakeUnit -> Fa
         // Compiler generated sequential executions result in suppressions of debug points on both
         // left and right of the sequence
         let spStmt, spExpr =
-            (match spSeq with
-             | DebugPointAtSequential.SuppressNeither -> SPAlways, SPAlways
-             | DebugPointAtSequential.SuppressStmt -> SPSuppress, sp
-             | DebugPointAtSequential.SuppressExpr -> sp, SPSuppress
-             | DebugPointAtSequential.SuppressBoth -> SPSuppress, SPSuppress)
+            match spSeq with
+            | DebugPointAtSequential.SuppressNeither -> SPAlways, SPAlways
+            | DebugPointAtSequential.SuppressStmt -> SPSuppress, sp
+            | DebugPointAtSequential.SuppressExpr -> sp, SPSuppress
+            | DebugPointAtSequential.SuppressBoth -> SPSuppress, SPSuppress
+
         match specialSeqFlag with
         | NormalSeq ->
             GenExpr cenv cgbuf eenv spStmt e1 discard
             GenLinearExpr cenv cgbuf eenv spExpr e2 sequel true contf
         | ThenDoSeq ->
-            let g = cenv.g
-            let isUnit = isUnitTy g (tyOfExpr g e1) 
-            if isUnit then
-                GenExpr cenv cgbuf eenv spExpr e1 discard
-                GenExpr cenv cgbuf eenv spStmt e2 discard
-                GenUnitThenSequel cenv eenv e2.Range eenv.cloc cgbuf sequel
-            else
-                GenExpr cenv cgbuf eenv spExpr e1 Continue
-                GenExpr cenv cgbuf eenv spStmt e2 discard
-                GenSequel cenv eenv.cloc cgbuf sequel
+            // "e then ()" with DebugPointAtSequential.SuppressStmt is used
+            // in mkDebugPoint to emit a debug point on "e".  However we don't want this to interfere
+            // with tailcalls, so detect this case and throw the "then ()" away, having already
+            // worked out "spExpr" up above.
+            match e2 with
+            | Expr.Const (Const.Unit, _, _) ->
+                GenExpr cenv cgbuf eenv spExpr e1 sequel
+            | _ -> 
+                let g = cenv.g
+                let isUnit = isUnitTy g (tyOfExpr g e1) 
+                if isUnit then
+                    GenExpr cenv cgbuf eenv spExpr e1 discard
+                    GenExpr cenv cgbuf eenv spStmt e2 discard
+                    GenUnitThenSequel cenv eenv e2.Range eenv.cloc cgbuf sequel
+                else
+                    GenExpr cenv cgbuf eenv spExpr e1 Continue
+                    GenExpr cenv cgbuf eenv spStmt e2 discard
+                    GenSequel cenv eenv.cloc cgbuf sequel
             contf Fake
 
     | Expr.Let (bind, body, _, _) ->

diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/Testfunction15.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/Testfunction15.il.bsl
@@ -13,7 +13,7 @@
 .assembly extern FSharp.Core
 {
   .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A )                         // .?_....:
-  .ver 5:0:0:0
+  .ver 6:0:0:0
 }
 .assembly TestFunction15
 {
@@ -36,13 +36,13 @@
   // Offset: 0x000001F0 Length: 0x00000072
 }
 .module TestFunction15.exe
-// MVID: {611B0ED4-A624-4662-A745-0383D40E1B61}
+// MVID: {6197D1F9-A624-4662-A745-0383F9D19761}
 .imagebase 0x00400000
 .file alignment 0x00000200
 .stackreserve 0x00100000
 .subsystem 0x0003       // WINDOWS_CUI
 .corflags 0x00000001    //  ILONLY
-// Image base: 0x07120000
+// Image base: 0x06AD0000
 
 
 // =============== CLASS MEMBERS DECLARATION ===================
@@ -95,7 +95,7 @@
   .method public static class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<int32> 
           TestFunction15(int32 inp) cil managed
   {
-    // Code size       40 (0x28)
+    // Code size       42 (0x2a)
     .maxstack  6
     .locals init ([0] int32 x,
              [1] class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<int32> 'Pipe #1 input at line 6')
@@ -119,9 +119,10 @@
     .line 6,6 : 16,41 ''
     IL_001c:  ldsfld     class TestFunction15/TestFunction15@6 TestFunction15/TestFunction15@6::@_instance
     IL_0021:  ldloc.1
-    IL_0022:  call       class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!!1> [FSharp.Core]Microsoft.FSharp.Collections.ListModule::Map<int32,int32>(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<!!0,!!1>,
+    IL_0022:  tail.
+    IL_0024:  call       class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!!1> [FSharp.Core]Microsoft.FSharp.Collections.ListModule::Map<int32,int32>(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<!!0,!!1>,
                                                                                                                                                                   class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!!0>)
-    IL_0027:  ret
+    IL_0029:  ret
   } // end of method TestFunction15::TestFunction15
 
 } // end of class TestFunction15