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.

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." } ;

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

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

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 } "." } ;

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> ;

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

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