diff --git a/basis/compiler/cfg/cfg-docs.factor b/basis/compiler/cfg/cfg-docs.factor index ae45d1c12c..f2362a2a51 100644 --- 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 83f003173b..12806f5bed 100644 --- 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 ; : ( -- 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 deb92f353a..d1d71e2a87 100644 --- 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 4cf18c7cce..dd78c9d5b2 100644 --- 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 5ad129ee18..cc1d4f86be 100644 --- 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* + ; -M: rs-loc untranslate-loc [ n>> ] [ rs-heights get at ] bi* + ; +M: ds-loc untranslate-loc ( loc bb -- loc' ) + [ n>> ] [ ds-height>> ] bi* + ; +M: rs-loc untranslate-loc ( loc bb -- loc' ) + [ n>> ] [ rs-height>> ] bi* + ; diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor index 16250a464c..2b6dade464 100644 --- 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 7646c22691..5a2d94677b 100644 --- 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 ( -- ) 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