steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.cfg.ssa.interference: cleanup

db4
Slava Pestov 2009-08-02 10:35:02 -05:00
parent 67fd6b34dc
commit ba55633b19
3 changed files with 27 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/compiler/cfg/ssa/destruction/destruction.factor
View File

@ -35,12 +35,7 @@ SYMBOL: copies
: classes-interfere? ( vreg1 vreg2 -- ? ) : classes-interfere? ( vreg1 vreg2 -- ? )
[ leader ] bi@ 2dup eq? [ 2drop f ] [ [ leader ] bi@ 2dup eq? [ 2drop f ] [
[ class-elements flatten ] bi@ [ class-elements flatten ] bi@ sets-interfere?
'[
_ [
interferes?
] with any?
] any?
] if ; ] if ;
: update-leaders ( vreg1 vreg2 -- ) : update-leaders ( vreg1 vreg2 -- )

28
basis/compiler/cfg/ssa/interference/interference-tests.factor
View File

@ -36,17 +36,17 @@ V{
[ ] [ test-interference ] unit-test [ ] [ test-interference ] unit-test
[ f ] [ V int-regs 0 V int-regs 1 interferes? ] unit-test [ f ] [ V int-regs 0 V int-regs 1 vregs-interfere? ] unit-test
[ f ] [ V int-regs 1 V int-regs 0 interferes? ] unit-test [ f ] [ V int-regs 1 V int-regs 0 vregs-interfere? ] unit-test
[ f ] [ V int-regs 2 V int-regs 3 interferes? ] unit-test [ f ] [ V int-regs 2 V int-regs 3 vregs-interfere? ] unit-test
[ f ] [ V int-regs 3 V int-regs 2 interferes? ] unit-test [ f ] [ V int-regs 3 V int-regs 2 vregs-interfere? ] unit-test
[ t ] [ V int-regs 0 V int-regs 2 interferes? ] unit-test [ t ] [ V int-regs 0 V int-regs 2 vregs-interfere? ] unit-test
[ t ] [ V int-regs 2 V int-regs 0 interferes? ] unit-test [ t ] [ V int-regs 2 V int-regs 0 vregs-interfere? ] unit-test
[ f ] [ V int-regs 1 V int-regs 3 interferes? ] unit-test [ f ] [ V int-regs 1 V int-regs 3 vregs-interfere? ] unit-test
[ f ] [ V int-regs 3 V int-regs 1 interferes? ] unit-test [ f ] [ V int-regs 3 V int-regs 1 vregs-interfere? ] unit-test
[ t ] [ V int-regs 3 V int-regs 4 interferes? ] unit-test [ t ] [ V int-regs 3 V int-regs 4 vregs-interfere? ] unit-test
[ t ] [ V int-regs 4 V int-regs 3 interferes? ] unit-test [ t ] [ V int-regs 4 V int-regs 3 vregs-interfere? ] unit-test
[ t ] [ V int-regs 3 V int-regs 5 interferes? ] unit-test [ t ] [ V int-regs 3 V int-regs 5 vregs-interfere? ] unit-test
[ t ] [ V int-regs 5 V int-regs 3 interferes? ] unit-test [ t ] [ V int-regs 5 V int-regs 3 vregs-interfere? ] unit-test
[ f ] [ V int-regs 3 V int-regs 6 interferes? ] unit-test [ f ] [ V int-regs 3 V int-regs 6 vregs-interfere? ] unit-test
[ f ] [ V int-regs 6 V int-regs 3 interferes? ] unit-test [ f ] [ V int-regs 6 V int-regs 3 vregs-interfere? ] unit-test

16
basis/compiler/cfg/ssa/interference/interference.factor
View File

@ -39,7 +39,7 @@ IN: compiler.cfg.ssa.interference
PRIVATE> PRIVATE>
: interferes? ( vreg1 vreg2 -- ? ) : vregs-interfere? ( vreg1 vreg2 -- ? )
2dup [ def-of ] bi@ { 2dup [ def-of ] bi@ {
{ [ 2dup eq? ] [ interferes-same-block? ] } { [ 2dup eq? ] [ interferes-same-block? ] }
{ [ 2dup dominates? ] [ interferes-first-dominates? ] } { [ 2dup dominates? ] [ interferes-first-dominates? ] }
@ -48,11 +48,12 @@ PRIVATE>
} cond ; } cond ;
! Debug this stuff later ! Debug this stuff later
<PRIVATE
: quadratic-test? ( seq1 seq2 -- ? ) [ length ] bi@ + 10 < ; : quadratic-test? ( seq1 seq2 -- ? ) [ length ] bi@ + 10 < ;
: quadratic-test ( seq1 seq2 -- ? ) : quadratic-test ( seq1 seq2 -- ? )
'[ _ [ interferes? ] with any? ] any? ; '[ _ [ vregs-interfere? ] with any? ] any? ;
: sort-vregs-by-bb ( vregs -- alist ) : sort-vregs-by-bb ( vregs -- alist )
defs get defs get
@ -64,15 +65,22 @@ PRIVATE>
: find-parent ( dom current -- parent ) : find-parent ( dom current -- parent )
over empty? [ 2drop f ] [ over empty? [ 2drop f ] [
over last over dominates? [ drop last ] [ over last over dominates? [ drop last ] [
[ pop* ] dip find-parent over pop* find-parent
] if ] if
] if ; ] if ;
:: linear-test ( seq1 seq2 -- ? ) :: linear-test ( seq1 seq2 -- ? )
! Instead of sorting, SSA destruction should keep equivalence
! classes sorted by merging them on append
V{ } clone :> dom V{ } clone :> dom
seq1 seq2 append sort-vregs-by-bb [| pair | seq1 seq2 append sort-vregs-by-bb [| pair |
pair first :> current pair first :> current
dom current find-parent dom current find-parent
dup [ current interferes? ] when dup [ current vregs-interfere? ] when
[ t ] [ current dom push f ] if [ t ] [ current dom push f ] if
] any? ; ] any? ;
PRIVATE>
: sets-interfere? ( seq1 seq2 -- ? )
quadratic-test ;