compiler.cfg Remove height tracking for ##call instructions, wire in ##no-tco instruction

basis/compiler/cfg/builder/builder.factor

@@ -72,18 +72,15 @@ GENERIC: emit-node ( node -- )
     basic-block get successors>> push
     basic-block off ;
 
-: emit-call ( word height -- )
+: emit-call ( word -- )
-    over loops get key?
+    dup loops get key?
-    [ drop loops get at local-recursive-call ]
+    [ loops get at local-recursive-call ]
     [ ##call ##branch begin-basic-block ]
     if ;
 
 ! #recursive
-: recursive-height ( #recursive -- n )
-    [ label>> return>> in-d>> length ] [ in-d>> length ] bi - ;
-
 : emit-recursive ( #recursive -- )
-    [ [ label>> id>> ] [ recursive-height ] bi emit-call ]
+    [ label>> id>> emit-call ]
     [ [ child>> ] [ label>> word>> ] [ label>> id>> ] tri (build-cfg) ] bi ;
 
 : remember-loop ( label -- )
@@ -152,10 +149,10 @@ M: #dispatch emit-node
 ! #call
 M: #call emit-node
     dup word>> dup "intrinsic" word-prop
-    [ emit-intrinsic ] [ swap call-height emit-call ] if ;
+    [ emit-intrinsic ] [ nip emit-call ] if ;
 
 ! #call-recursive
-M: #call-recursive emit-node [ label>> id>> ] [ call-height ] bi emit-call ;
+M: #call-recursive emit-node label>> id>> emit-call ;
 
 ! #push
 M: #push emit-node
@@ -180,7 +177,7 @@ M: #return-recursive emit-node
     [ ##epilogue ##return ] unless ;
 
 ! #terminate
-M: #terminate emit-node drop ;
+M: #terminate emit-node drop ##no-tco ;
 
 ! FFI
 : return-size ( ctype -- n )

basis/compiler/cfg/instructions/instructions.factor

@@ -53,10 +53,13 @@ INSN: ##inc-r { n integer } ;
 
 ! Subroutine calls
 INSN: ##stack-frame stack-frame ;
-INSN: ##call word { height integer } ;
+INSN: ##call word ;
 INSN: ##jump word ;
 INSN: ##return ;
 
+! Dummy instruction that simply inhibits TCO
+INSN: ##no-tco ;
+
 ! Jump tables
 INSN: ##dispatch src temp ;
 

basis/compiler/cfg/stack-analysis/stack-analysis.factor

@@ -48,7 +48,8 @@ M: ##inc-r visit
 ! Instructions which don't have any effect on the stack
 UNION: neutral-insn
     ##effect
-    ##flushable ;
+    ##flushable
+    ##no-tco ;
 
 M: neutral-insn visit , ;
 

basis/compiler/cfg/utilities/utilities.factor

@@ -35,8 +35,5 @@ IN: compiler.cfg.utilities
 
 : stop-iterating ( -- next ) end-basic-block f ;
 
-: call-height ( ##call -- n )
-    [ out-d>> length ] [ in-d>> length ] bi - ;
-
 : emit-primitive ( node -- )
-    [ word>> ] [ call-height ] bi ##call ##branch begin-basic-block ;
+    word>> ##call ##branch begin-basic-block ;

basis/compiler/codegen/codegen.factor

@@ -67,6 +67,8 @@ SYMBOL: labels
 : lookup-label ( id -- label )
     labels get [ drop <label> ] cache ;
 
+M: ##no-tco generate-insn drop ;
+
 M: ##load-immediate generate-insn
     [ dst>> register ] [ val>> ] bi %load-immediate ;