compiler.cfg.*: removing the adjust-d word

inc-stack can be used in emit-call-block if we check if the block is a
kill block in end-local-analysis

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

@@ -1,6 +1,6 @@
 USING: accessors compiler.cfg compiler.cfg.builder.blocks
 compiler.cfg.instructions compiler.cfg.stacks.local
-compiler.cfg.utilities compiler.test kernel namespaces sequences
+compiler.cfg.utilities compiler.test kernel make namespaces sequences
 tools.test ;
 IN: compiler.cfg.builder.blocks.tests
 
@@ -19,6 +19,14 @@ IN: compiler.cfg.builder.blocks.tests
     <basic-block> dup begin-branch eq?
 ] cfg-unit-test
 
+! emit-call-block
+{
+    V{ T{ ##call { word 2drop } } }
+    { { -2 -2 } { 0 0 } }
+} [
+    \ 2drop -2 <basic-block> [ emit-call-block ] V{ } make height-state get
+] cfg-unit-test
+
 ! emit-trivial-block
 {
     V{ T{ ##no-tco } T{ ##branch } }

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

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays compiler.cfg compiler.cfg.instructions
-compiler.cfg.stacks compiler.cfg.stacks.local compiler.cfg.utilities
-kernel make math namespaces sequences ;
+compiler.cfg.registers compiler.cfg.stacks.local
+compiler.cfg.utilities kernel make math namespaces sequences ;
 IN: compiler.cfg.builder.blocks
 SLOT: in-d
 SLOT: out-d
@@ -28,7 +28,8 @@ SLOT: out-d
     [ out-d>> length ] [ in-d>> length ] bi - ;
 
 : emit-call-block ( word height block -- )
-    t swap kill-block?<< adjust-d ##call, ;
+    t swap kill-block?<<
+    <ds-loc> inc-stack ##call, ;
 
 : emit-trivial-call ( block word height -- block' )
     rot [ emit-call-block ] emit-trivial-block ;

basis/compiler/cfg/stacks/local/local-docs.factor

@@ -3,7 +3,7 @@ compiler.cfg.registers compiler.cfg.stacks hash-sets hashtables
 help.markup help.syntax kernel math sequences ;
 IN: compiler.cfg.stacks.local
 
-HELP: emit-changes
+HELP: emit-insns
 { $values { "replaces" sequence } { "state" sequence } }
 { $description "Insert height and stack changes prior to the last instruction." } ;
 

basis/compiler/cfg/stacks/local/local-tests.factor

@@ -71,7 +71,7 @@ IN: compiler.cfg.stacks.local.tests
     replaces get remove-redundant-replaces
 ] cfg-unit-test
 
-! emit-changes
+! emit-insns
 {
     V{
         T{ ##copy { dst 1 } { src 3 } { rep any-rep } }
@@ -80,7 +80,7 @@ IN: compiler.cfg.stacks.local.tests
 } [
     3 D: 0 replace-loc [
         "eh" ,
-        replaces get height-state get emit-changes
+        replaces get height-state get emit-insns
     ] V{ } make
 ] cfg-unit-test
 

basis/compiler/cfg/stacks/local/local.factor

@@ -52,7 +52,7 @@ SYMBOLS: height-state locs>vregs local-peek-set replaces ;
 : changes>insns ( replaces height-state -- insns )
     [ replaces>copy-insns ] [ height-state>insns ] bi* append ;
 
-: emit-changes ( replaces state -- )
+: emit-insns ( replaces state -- )
     building get pop -rot changes>insns % , ;
 
 : peek-loc ( loc -- vreg )
@@ -79,7 +79,9 @@ SYMBOLS: height-state locs>vregs local-peek-set replaces ;
 
 : end-local-analysis ( basic-block -- )
     replaces get remove-redundant-replaces
-    [ height-state get emit-changes ] keep
+    over kill-block?>> [
+        [ height-state get emit-insns ] keep
+    ] unless
     keys >hash-set >>replaces
     local-peek-set get >>peeks
     dup compute-local-kill-set >>kills drop ;

basis/compiler/cfg/stacks/stacks-docs.factor

@@ -15,10 +15,6 @@ HELP: end-stack-analysis
 { $values { "cfg" cfg } }
 { $description "Ends the stack analysis of the current cfg. This is the last step of the cfg construction (but comes before all optimization passes)." } ;
 
-HELP: adjust-d
-{ $values { "n" integer } }
-{ $description "Changes the current height of the data stack. The word is used when other instructions which adjust the stack height are emitted, such as " { $link ##call } " and " { $link ##alien-invoke } ". Since the stack height is adjusted without emitting " { ##inc } " instructions, the " { $link inc-stack } " word can't be used by them." } ;
-
 HELP: ds-drop
 { $description "Used to signal to the stack analysis that the datastacks height is decreased by one." } ;
 

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

@@ -3,15 +3,7 @@ compiler.cfg.stacks compiler.cfg.stacks.local compiler.test kernel literals
 namespaces tools.test ;
 IN: compiler.cfg.stacks.tests
 
-! adjust-d
-{
-    { { 6 2 } { 3 4 } }
-    { { -4 2 } { 3 4 } }
-} [
-    { { 1 2 } { 3 4 } } [ height-state set 5 adjust-d ] keep
-    { { 1 2 } { 3 4 } } [ height-state set -5 adjust-d ] keep
-] unit-test
-
+! store-vregs
 {
     H{ { D: 1 4 } { D: 2 3 } { D: 0 5 } }
     { { 0 0 } { 0 0 } }

basis/compiler/cfg/stacks/stacks.factor

@@ -59,6 +59,3 @@ IN: compiler.cfg.stacks
 
 : unary-op ( quot -- )
     [ ds-pop ] dip call ds-push ; inline
-
-: adjust-d ( n -- )
-    0 height-state get first [ + ] change-nth ;