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

passes can much easier to accurate liveness analysis on stack locations

diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor
index 0dbcf68496dded64d50165d20ce48490d514c80d..e3d9288866a0a1103aac107a9c5defaa96d6b1f3 100644 (file)
--- a/basis/compiler/cfg/builder/blocks/blocks.factor
+++ b/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, ]
-        [ call-height adjust-d ] bi
-        make-kill-block
+        [ word>> ] [ call-height ] bi emit-call-block
     ] emit-trivial-block ;
 
 : begin-branch ( -- )

diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 90b0c29cb0116004aa0f9d1b03ff5f63e34f6786..7416b2f00f7e9f86d156c11cc4ba962cebf96872 100644 (file)
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/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>>

diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 96f89725a023e19c55207beee5cd6ec3ad41ed3c..ee2e30131b7ee4231ba2c5a5e867cfa13129bd9d 100644 (file)
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/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 ]
     [
-        [
-            [ ##call, ] [ adjust-d ] bi*
-            make-kill-block
-        ] emit-trivial-block
+        [ emit-call-block ] emit-trivial-block
     ] if ;
 
 ! #recursive

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 4b9ce2c3682a0996fa1561d4645cfae548137fe3..0996a71cc196ddffa2eba0ce269b08f1e8224cb5 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/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 ;

diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
index 397e2ace2502b7aec8a9b14b6652690d10c8be4a..6b58131b1d1b610326533f5db290ce80c44a6649 100644 (file)
--- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
+++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
@@ -45,9 +45,7 @@ IN: compiler.cfg.intrinsics.fixnum
 
 : emit-overflow-case ( word -- final-bb )
     [
-        ##call,
-        -1 adjust-d
-        make-kill-block
+        -1 emit-call-block
     ] with-branch ;
 
 : emit-fixnum-overflow-op ( quot word -- )

diff --git a/basis/compiler/codegen/codegen-tests.factor b/basis/compiler/codegen/codegen-tests.factor
index c81164bff2278c43fd98f1c48c38fcd72d7da734..c2433092053fe54795e08e39126a1ce5f88b0cc9 100644 (file)
--- a/basis/compiler/codegen/codegen-tests.factor
+++ b/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

diff --git a/basis/compiler/test/test.factor b/basis/compiler/test/test.factor
index 8747123837ca7a08a44bca2943079596d88bccee..2f0386c238e4cfa7a0c37ba75a32b11fb1b7106f 100644 (file)
--- a/basis/compiler/test/test.factor
+++ b/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 -- )

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 43f4c50464444fe23442a6111f5874374515fb56..9442aed9a860f94caf363ce69f8d51f46a62ed3d 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/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 ( -- )

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 5b126f0514e1310bb856a09f6dfceccf375f1578..0b16b71bbf999acebd18cf9be8e20e27a0575d31 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/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 -- )
-    0 BL rc-relative-ppc-3-pc rel-word-pic ;
+M: ppc %call ( word height -- )
+    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

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index d02a6078c749a99a79141d399a5ae12e7b6d476f..d9c7778260505793f4eb47b2d2f58a1fdb951753 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/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 -- )