compiler.*,cpu.*: add a height slot to ##call nodes, then other compiler

passes can much easier to accurate liveness analysis on stack locations

basis/compiler/cfg/builder/blocks/blocks.factor

@@ -35,11 +35,12 @@ IN: compiler.cfg.builder.blocks
 : call-height ( #call -- n )
     [ out-d>> length ] [ in-d>> length ] bi - ;
 
+: emit-call-block ( word height -- )
+    dup adjust-d ##call, make-kill-block ;
+
 : emit-primitive ( node -- )
     [
-        [ word>> ##call, ]
+        [ word>> ] [ call-height ] bi emit-call-block
-        [ call-height adjust-d ] bi
-        make-kill-block
     ] emit-trivial-block ;
 
 : begin-branch ( -- )

basis/compiler/cfg/builder/builder-tests.factor

@@ -245,7 +245,7 @@ IN: compiler.cfg.builder.tests
 
 ! emit-call
 {
-    V{ T{ ##call { word print } } T{ ##branch } }
+    V{ T{ ##call { word print } { height 4 } } T{ ##branch } }
 } [
     [ \ print 4 emit-call ] V{ } make drop
     basic-block get successors>> first instructions>>

basis/compiler/cfg/builder/builder.factor

@@ -69,10 +69,7 @@ GENERIC: emit-node ( node -- )
     over loops get key?
     [ drop loops get at emit-loop-call ]
     [
-        [
+        [ emit-call-block ] emit-trivial-block
-            [ ##call, ] [ adjust-d ] bi*
-            make-kill-block
-        ] emit-trivial-block
     ] if ;
 
 ! #recursive

basis/compiler/cfg/instructions/instructions.factor

@@ -62,7 +62,7 @@ literal: loc ;
 
 ! Subroutine calls
 INSN: ##call
-literal: word ;
+literal: word height ;
 
 INSN: ##jump
 literal: word ;

basis/compiler/cfg/intrinsics/fixnum/fixnum.factor

@@ -45,9 +45,7 @@ IN: compiler.cfg.intrinsics.fixnum
 
 : emit-overflow-case ( word -- final-bb )
     [
-        ##call,
+        -1 emit-call-block
-        -1 adjust-d
-        make-kill-block
     ] with-branch ;
 
 : emit-fixnum-overflow-op ( quot word -- )

basis/compiler/codegen/codegen-tests.factor

@@ -4,7 +4,7 @@ kernel make compiler.constants words ;
 IN: compiler.codegen.tests
 
 [ ] [ [ ] with-fixup drop ] unit-test
-[ ] [ [ \ + %call ] with-fixup drop ] unit-test
+[ ] [ [ \ + 0 %call ] with-fixup drop ] unit-test
 
 [ ] [ [ <label> dup define-label dup resolve-label %jump-label ] with-fixup drop ] unit-test
 [ ] [ [ <label> dup define-label dup resolve-label B{ 0 0 0 0 } % rc-absolute-cell label-fixup ] with-fixup drop ] unit-test

basis/compiler/test/test.factor

@@ -24,6 +24,7 @@ fry namespaces ;
 : init-cfg-test ( -- )
     reset-vreg-counter begin-stack-analysis
     <basic-block> dup basic-block set begin-local-analysis
+    H{ } clone representations set
     H{ } clone replaces set ;
 
 : cfg-unit-test ( result quot -- )

basis/cpu/architecture/architecture.factor

@@ -234,7 +234,7 @@ HOOK: %replace-imm cpu ( src loc -- )
 HOOK: %inc cpu ( loc -- )
 
 HOOK: stack-frame-size cpu ( stack-frame -- n )
-HOOK: %call cpu ( word -- )
+HOOK: %call cpu ( word height -- )
 HOOK: %jump cpu ( word -- )
 HOOK: %jump-label cpu ( label -- )
 HOOK: %return cpu ( -- )

basis/cpu/ppc/ppc.factor

@@ -195,8 +195,8 @@ M: ppc stack-frame-size ( stack-frame -- i )
     factor-area-size +
     16 align ;
 
-M: ppc %call ( word -- )
+M: ppc %call ( word height -- )
-    0 BL rc-relative-ppc-3-pc rel-word-pic ;
+    drop 0 BL rc-relative-ppc-3-pc rel-word-pic ;
 
 : instrs ( n -- b ) 4 * ; inline
 
@@ -922,7 +922,7 @@ M:: ppc %check-nursery-branch ( label size cc temp1 temp2 -- )
     } case ;
 
 M: ppc %call-gc ( gc-map -- )
-    \ minor-gc %call gc-map-here ;
+    \ minor-gc 0 %call gc-map-here ;
 
 M:: ppc %prologue ( stack-size -- )
     0 MFLR

basis/cpu/x86/x86.factor

@@ -95,7 +95,7 @@ M: x86 %replace-imm
 M: x86 %inc ( loc -- )
     [ n>> ] [ ds-loc? ds-reg rs-reg ? ] bi (%inc) ;
 
-M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ;
+M: x86 %call ( word height -- ) drop 0 CALL rc-relative rel-word-pic ;
 
 : xt-tail-pic-offset ( -- n )
     #! See the comment in vm/cpu-x86.hpp
@@ -510,7 +510,7 @@ M: x86 gc-root-offset
     n>> spill-offset special-offset cell + cell /i ;
 
 M: x86 %call-gc ( gc-map -- )
-    \ minor-gc %call
+    \ minor-gc 0 %call
     gc-map-here ;
 
 M: x86 %alien-global ( dst symbol library -- )