From 6f75e84d93fd93e50b8f7681e7513a70317730e3 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 19 Oct 2011 13:04:43 -0700
Subject: [PATCH] compiler.cfg.tco: teach TCO about safepoints

---
 basis/compiler/cfg/tco/tco.factor | 23 ++++++++++++++++++-----
 1 file changed, 18 insertions(+), 5 deletions(-)

diff --git a/basis/compiler/cfg/tco/tco.factor b/basis/compiler/cfg/tco/tco.factor
index bd8a7cf754..7751aa5b03 100644
--- a/basis/compiler/cfg/tco/tco.factor
+++ b/basis/compiler/cfg/tco/tco.factor
@@ -15,9 +15,14 @@ IN: compiler.cfg.tco
 : return? ( bb -- ? )
     skip-empty-blocks
     instructions>> {
-        [ length 2 = ]
-        [ first ##epilogue? ]
-        [ second ##return? ]
+        [ length 3 = ]
+        [ first ##safepoint? ]
+        [ second ##epilogue? ]
+        [ third ##return? ]
+
+        ! [ length 2 = ]
+        ! [ first ##epilogue? ]
+        ! [ second ##return? ]
     } 1&& ;
 
 : tail-call? ( bb -- ? )
@@ -33,8 +38,9 @@ IN: compiler.cfg.tco
     '[
         instructions>>
         [ pop* ] [ pop ] [ ] tri
+        [ [ \ ##safepoint new-insn ] dip push ]
         [ [ \ ##epilogue new-insn ] dip push ]
-        [ _ dip push ] bi
+        [ _ dip push ] tri
     ]
     [ successors>> delete-all ]
     bi ; inline
@@ -48,7 +54,14 @@ IN: compiler.cfg.tco
 
 : convert-loop-tail-call ( bb -- )
     ! If a word calls itself, this becomes a loop in the CFG.
-    [ instructions>> [ pop* ] [ pop* ] [ [ \ ##branch new-insn ] dip push ] tri ]
+    [
+        instructions>> {
+            [ pop* ]
+            [ pop* ]
+            [ [ \ ##safepoint new-insn ] dip push ]
+            [ [ \ ##branch new-insn ] dip push ]
+        } cleave
+    ]
     [ successors>> delete-all ]
     [ [ cfg get entry>> successors>> first ] dip successors>> push ]
     tri ;