diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index e8b4b67cf0..20f8570f84 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -1509,6 +1509,7 @@ SYMBOL: linear-scan-result compute-liveness dup reverse-post-order { { int-regs regs } } (linear-scan) + cfg-changed flatten-cfg 1array mr. ] with-scope ; @@ -1803,7 +1804,7 @@ test-diamond [ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test -[ _spill ] [ 2 get instructions>> first class ] unit-test +[ _spill ] [ 2 get successors>> first instructions>> first class ] unit-test [ _spill ] [ 3 get instructions>> second class ] unit-test @@ -1859,7 +1860,7 @@ V{ [ t ] [ 2 get instructions>> [ _spill? ] any? ] unit-test -[ t ] [ 3 get instructions>> [ _spill? ] any? ] unit-test +[ t ] [ 3 get predecessors>> first instructions>> [ _spill? ] any? ] unit-test [ t ] [ 5 get instructions>> [ _reload? ] any? ] unit-test @@ -1926,7 +1927,7 @@ V{ [ V{ 3 2 1 } ] [ 9 get instructions>> [ _reload? ] filter [ n>> ] map ] unit-test ! Resolve pass should insert this -[ _reload ] [ 5 get instructions>> first class ] unit-test +[ _reload ] [ 5 get predecessors>> first instructions>> first class ] unit-test ! Some random bug V{ @@ -2484,7 +2485,7 @@ test-diamond [ 1 ] [ 2 get instructions>> [ _spill? ] count ] unit-test -[ 1 ] [ 3 get instructions>> [ _spill? ] count ] unit-test +[ 1 ] [ 3 get predecessors>> first instructions>> [ _spill? ] count ] unit-test [ 1 ] [ 4 get instructions>> [ _reload? ] count ] unit-test diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor index 77d66c274d..c17aa23e83 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan.factor @@ -40,4 +40,5 @@ IN: compiler.cfg.linear-scan init-mapping dup reverse-post-order machine-registers (linear-scan) spill-counts get >>spill-counts + cfg-changed ] with-scope ; diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor deleted file mode 100644 index b5e95258bf..0000000000 --- a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor +++ /dev/null @@ -1,7 +0,0 @@ -USING: arrays compiler.cfg.linear-scan.resolve kernel -tools.test ; -IN: compiler.cfg.linear-scan.resolve.tests - -[ { 1 2 3 4 5 6 } ] [ - { 3 4 } V{ 1 2 } clone [ { 5 6 } 3append-here ] keep >array -] unit-test diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor index 7b7f242e4e..f7ed994f18 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor @@ -3,6 +3,7 @@ USING: accessors arrays assocs combinators combinators.short-circuit fry kernel locals make math sequences +compiler.cfg.utilities compiler.cfg.instructions compiler.cfg.linear-scan.assignment compiler.cfg.linear-scan.mapping compiler.cfg.liveness ; @@ -30,42 +31,14 @@ IN: compiler.cfg.linear-scan.resolve [ resolve-value-data-flow ] with with each ] { } make ; -: fork? ( from to -- ? ) - { - [ drop successors>> length 1 >= ] - [ nip predecessors>> length 1 = ] - } 2&& ; inline - -: insert-position/fork ( from to -- before after ) - nip instructions>> [ >array ] [ dup delete-all ] bi swap ; - -: join? ( from to -- ? ) - { - [ drop successors>> length 1 = ] - [ nip predecessors>> length 1 >= ] - } 2&& ; inline - -: insert-position/join ( from to -- before after ) - drop instructions>> dup pop 1array ; - -: insert-position ( bb to -- before after ) - { - { [ 2dup fork? ] [ insert-position/fork ] } - { [ 2dup join? ] [ insert-position/join ] } - } cond ; - -: 3append-here ( seq2 seq1 seq3 -- ) - #! Mutate seq1 - swap '[ _ push-all ] bi@ ; - -: perform-mappings ( mappings bb to -- ) - pick empty? [ 3drop ] [ - [ mapping-instructions ] 2dip - insert-position 3append-here +: perform-mappings ( bb to mappings -- ) + dup empty? [ 3drop ] [ + mapping-instructions + insert-basic-block ] if ; : resolve-edge-data-flow ( bb to -- ) - [ compute-mappings ] [ perform-mappings ] 2bi ; + 2dup compute-mappings perform-mappings ; : resolve-block-data-flow ( bb -- ) dup successors>> [ resolve-edge-data-flow ] with each ; diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index 0e08607331..288fa403dd 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs combinators combinators.short-circuit compiler.cfg compiler.cfg.instructions cpu.architecture kernel -layouts locals make math namespaces sequences sets vectors ; +layouts locals make math namespaces sequences sets vectors fry ; IN: compiler.cfg.utilities : value-info-small-fixnum? ( value-info -- ? ) @@ -74,12 +74,12 @@ SYMBOL: added-instructions to predecessors>> [ dup from eq? [ drop bb ] when ] change-each from successors>> [ dup to eq? [ drop bb ] when ] change-each ; -:: insert-basic-blocks ( bb -- ) - added-instructions get - [| predecessor instructions | - \ ##branch new-insn instructions push - predecessor bb - instructions >>instructions - insert-basic-block - ] assoc-each ; +: ( insns -- bb ) + + swap >vector + \ ##branch new-insn over push + >>instructions ; +: insert-basic-blocks ( bb -- ) + [ added-instructions get ] dip + '[ [ _ ] dip insert-basic-block ] assoc-each ;