compute-liveness
dup reverse-post-order
{ { int-regs regs } } (linear-scan)
+ cfg-changed
flatten-cfg 1array mr.
] with-scope ;
[ ] [ { 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
[ 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
[ 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{
[ 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
init-mapping
dup reverse-post-order machine-registers (linear-scan)
spill-counts get >>spill-counts
+ cfg-changed
] with-scope ;
+++ /dev/null
-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
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 ;
[ 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 <simple-block>
+ 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 ;
! 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 -- ? )
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
- <basic-block> instructions >>instructions
- insert-basic-block
- ] assoc-each ;
+: <simple-block> ( insns -- bb )
+ <basic-block>
+ swap >vector
+ \ ##branch new-insn over push
+ >>instructions ;
+: insert-basic-blocks ( bb -- )
+ [ added-instructions get ] dip
+ '[ [ _ ] dip <simple-block> insert-basic-block ] assoc-each ;