compiler.cfg.*: new slots ds-height and rs-height

They are used when recording the blocks stacks height instead of the
ds-heights and rs-heights variables. It makes the code a bit simpler.

diff --git a/basis/compiler/cfg/cfg-docs.factor b/basis/compiler/cfg/cfg-docs.factor
index ae45d1c12cac334715d84a5cb1c6a193b664e768..f2362a2a515e9af1ba370820cefa67f5af9eab7e 100644 (file)
--- a/basis/compiler/cfg/cfg-docs.factor
+++ b/basis/compiler/cfg/cfg-docs.factor
@@ -8,11 +8,34 @@ HELP: basic-block
 { $class-description
   "Factors representation of a basic block in the Call Flow Graph (CFG). A basic block is a sequence of instructions that always are executed sequentially and doesn't contain any internal branching. It has the following slots:"
   { $table
-    { { $slot "number" } { "The blocks sequence number. Generated by calling " { $link number-blocks } ". " } }
-    { { $slot "successors" } { "A " { $link vector } " of basic blocks that may be executed directly after this block. Most blocks only have one successor but a block that checks where an if-condition should branch to would have two for example." } }
-    { { $slot "predecessors" } { "The opposite of successors -- a " { $link vector } " of basic blocks from which the execution may have arrived into this block." } }
-    { { $slot "instructions" } { "A " { $link vector } " of " { $link insn } " tuples which form the instructions of the basic block." } }
-    { { $slot "kill-block?" } { "The first and the last block in a cfg and all blocks containing " { $link ##call } " instructions are kill blocks. Kill blocks can't be optimized so they are omitted from certain optimization steps." } }
+    {
+        { $slot "number" }
+        { "The blocks sequence number. Generated by calling " { $link number-blocks } ". " }
+    }
+    {
+        { $slot "successors" }
+        { "A " { $link vector } " of basic blocks that may be executed directly after this block. Most blocks only have one successor but a block that checks where an if-condition should branch to would have two for example." }
+    }
+    {
+        { $slot "predecessors" }
+        { "The opposite of successors -- a " { $link vector } " of basic blocks from which the execution may have arrived into this block." }
+    }
+    {
+        { $slot "instructions" }
+        { "A " { $link vector } " of " { $link insn } " tuples which form the instructions of the basic block." }
+    }
+    {
+        { $slot "kill-block?" }
+        { "The first and the last block in a cfg and all blocks containing " { $link ##call } " instructions are kill blocks. Kill blocks can't be optimized so they are omitted from certain optimization steps." }
+    }
+    {
+        { $slot "ds-height" }
+        "The datastacks height at the entry of the block. Used during cfg construction."
+    }
+    {
+        { $slot "rs-height" }
+        "The retainstacks height at the entry of the block. Used during cfg construction."
+    }
   }
 }
 { $notes "A basic-block is an " { $link identity-tuple } " becase it is used as a hash table key by the compiler." } ;

diff --git a/basis/compiler/cfg/cfg.factor b/basis/compiler/cfg/cfg.factor
index 83f003173b55637c96c6da8621f1fdc8cb6326bf..12806f5bed328abb712e919f6d18de2994b54041 100644 (file)
--- a/basis/compiler/cfg/cfg.factor
+++ b/basis/compiler/cfg/cfg.factor
@@ -9,7 +9,8 @@ TUPLE: basic-block < identity-tuple
     { instructions vector }
     { successors vector }
     { predecessors vector }
-    { kill-block? boolean } ;
+    { kill-block? boolean }
+    ds-height rs-height ;
 
 : <basic-block> ( -- bb )
     basic-block new

diff --git a/basis/compiler/cfg/intrinsics/simd/simd-tests.factor b/basis/compiler/cfg/intrinsics/simd/simd-tests.factor
index deb92f353a8b95a64b4f8f0012bb14f35e203b3c..d1d71e2a8706875846f72c3e800064a86f39d4d0 100644 (file)
--- a/basis/compiler/cfg/intrinsics/simd/simd-tests.factor
+++ b/basis/compiler/cfg/intrinsics/simd/simd-tests.factor
@@ -1,11 +1,10 @@
 ! (c)2009 Joe Groff bsd license
-USING: arrays assocs biassocs byte-arrays byte-arrays.hex
-classes compiler.cfg compiler.cfg.comparisons compiler.cfg.instructions
+USING: accessors arrays assocs biassocs byte-arrays classes
+compiler.cfg compiler.cfg.comparisons compiler.cfg.instructions
 compiler.cfg.intrinsics.simd compiler.cfg.intrinsics.simd.backend
-compiler.cfg.registers compiler.cfg.stacks.height compiler.cfg.stacks.local
-compiler.test compiler.tree compiler.tree.propagation.info
-cpu.architecture fry hashtables kernel locals make namespaces sequences
-system tools.test words ;
+compiler.cfg.stacks.local compiler.test compiler.tree
+compiler.tree.propagation.info cpu.architecture fry kernel locals make
+namespaces sequences system tools.test words ;
 IN: compiler.cfg.intrinsics.simd.tests
 
 :: test-node ( rep -- node )
@@ -50,10 +49,9 @@ IN: compiler.cfg.intrinsics.simd.tests
 
 : test-compiler-env ( -- x )
     H{ } clone
-    T{ basic-block }
-    [ \ basic-block pick set-at ]
-    [ 0 swap associate \ ds-heights pick set-at ]
-    [ 0 swap associate \ rs-heights pick set-at ] tri
+    T{ basic-block } 0 >>ds-height 0 >>rs-height
+    \ basic-block pick set-at
+
     initial-height-state \ height-state pick set-at
     HS{ } clone \ local-peek-set pick set-at
     H{ } clone \ replaces pick set-at

diff --git a/basis/compiler/cfg/stacks/height/height-docs.factor b/basis/compiler/cfg/stacks/height/height-docs.factor
index 4cf18c7ccedf67b2152d0df178572dd23d6e0a5a..dd78c9d5b214bd57d7554581dcc9a41b3714bf37 100644 (file)
--- a/basis/compiler/cfg/stacks/height/height-docs.factor
+++ b/basis/compiler/cfg/stacks/height/height-docs.factor
@@ -4,9 +4,3 @@ IN: compiler.cfg.stacks.height
 HELP: record-stack-heights
 { $values { "ds-height" number } { "rs-height" number } { "bb" basic-block } }
 { $description "Sets the data and retain stack heights in relation to the cfg of this basic block." } ;
-
-HELP: ds-heights
-{ $var-description "Assoc that records the data stacks height at the entry of each " { $link basic-block } "." } ;
-
-HELP: rs-heights
-{ $var-description "Assoc that records the retain stacks height at the entry of each " { $link basic-block } "." } ;

diff --git a/basis/compiler/cfg/stacks/height/height.factor b/basis/compiler/cfg/stacks/height/height.factor
index 5ad129ee183dd182caac63e12ad465c306f4c6ac..cc1d4f86bed6b7c93cd79e34fb5c8ef102697dfa 100644 (file)
--- a/basis/compiler/cfg/stacks/height/height.factor
+++ b/basis/compiler/cfg/stacks/height/height.factor
@@ -1,15 +1,14 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs compiler.cfg.registers fry kernel math
-namespaces ;
+USING: accessors compiler.cfg.registers kernel math ;
 IN: compiler.cfg.stacks.height
 
-SYMBOLS: ds-heights rs-heights ;
-
 : record-stack-heights ( ds-height rs-height bb -- )
-    [ ds-heights get set-at ] [ rs-heights get set-at ] bi-curry bi* ;
+    [ rs-height<< ] keep ds-height<< ;
 
 GENERIC# untranslate-loc 1 ( loc bb -- loc' )
 
-M: ds-loc untranslate-loc [ n>> ] [ ds-heights get at ] bi* + <ds-loc> ;
-M: rs-loc untranslate-loc [ n>> ] [ rs-heights get at ] bi* + <rs-loc> ;
+M: ds-loc untranslate-loc ( loc bb -- loc' )
+    [ n>> ] [ ds-height>> ] bi* + <ds-loc> ;
+M: rs-loc untranslate-loc ( loc bb -- loc' )
+    [ n>> ] [ rs-height>> ] bi* + <rs-loc> ;

diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor
index 16250a464c9de4f4e78b2f0586d38468876fb2aa..2b6dade464b8ad277db6c812bedcf56892e99580 100644 (file)
--- a/basis/compiler/cfg/stacks/local/local.factor
+++ b/basis/compiler/cfg/stacks/local/local.factor
@@ -69,8 +69,7 @@ SYMBOLS: local-peek-set replaces ;
     height-state get translate-local-loc replaces get set-at ;
 
 : compute-local-kill-set ( basic-block -- set )
-    [ ds-heights get at ] [ rs-heights get at ] bi
-    height-state get local-kill-set ;
+    [ ds-height>> ] [ rs-height>> ] bi height-state get local-kill-set ;
 
 : begin-local-analysis ( basic-block -- )
     height-state get dup reset-emits

diff --git a/basis/compiler/cfg/stacks/stacks.factor b/basis/compiler/cfg/stacks/stacks.factor
index 7646c2269177b35189602ce8735c4cdc5e6bae5c..5a2d94677b3ba78232de11149e1883d67dff57b5 100644 (file)
--- a/basis/compiler/cfg/stacks/stacks.factor
+++ b/basis/compiler/cfg/stacks/stacks.factor
@@ -8,8 +8,6 @@ IN: compiler.cfg.stacks
 
 : begin-stack-analysis ( -- )
     <bihash> locs>vregs set
-    H{ } clone ds-heights set
-    H{ } clone rs-heights set
     H{ } clone peek-sets set
     H{ } clone replace-sets set
     H{ } clone kill-sets set