From 8df92abeb9c170ca95732c0323c05fc9185cc5aa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Thu, 7 May 2015 13:34:48 +0200
Subject: [PATCH] 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     | 7 ++++---
 basis/compiler/cfg/builder/builder-tests.factor     | 2 +-
 basis/compiler/cfg/builder/builder.factor           | 5 +----
 basis/compiler/cfg/instructions/instructions.factor | 2 +-
 basis/compiler/cfg/intrinsics/fixnum/fixnum.factor  | 4 +---
 basis/compiler/codegen/codegen-tests.factor         | 2 +-
 basis/compiler/test/test.factor                     | 1 +
 basis/cpu/architecture/architecture.factor          | 2 +-
 basis/cpu/ppc/ppc.factor                            | 6 +++---
 basis/cpu/x86/x86.factor                            | 4 ++--
 10 files changed, 16 insertions(+), 19 deletions(-)

diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor
index 0dbcf68496..e3d9288866 100644
--- 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 90b0c29cb0..7416b2f00f 100644
--- 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 96f89725a0..ee2e30131b 100644
--- 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 4b9ce2c368..0996a71cc1 100644
--- 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 397e2ace25..6b58131b1d 100644
--- 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 c81164bff2..c243309205 100644
--- 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 8747123837..2f0386c238 100644
--- 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 43f4c50464..9442aed9a8 100644
--- 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 5b126f0514..0b16b71bbf 100644
--- 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 d02a6078c7..d9c7778260 100644
--- 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 -- )