compiler.cfg.ssa.interference: cleanup
							parent
							
								
									67fd6b34dc
								
							
						
					
					
						commit
						ba55633b19
					
				| 
						 | 
				
			
			@ -35,12 +35,7 @@ SYMBOL: copies
 | 
			
		|||
 | 
			
		||||
: classes-interfere? ( vreg1 vreg2 -- ? )
 | 
			
		||||
    [ leader ] bi@ 2dup eq? [ 2drop f ] [
 | 
			
		||||
        [ class-elements flatten ] bi@
 | 
			
		||||
        '[
 | 
			
		||||
            _ [
 | 
			
		||||
                interferes?
 | 
			
		||||
            ] with any?
 | 
			
		||||
        ] any?
 | 
			
		||||
        [ class-elements flatten ] bi@ sets-interfere?
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: update-leaders ( vreg1 vreg2 -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -36,17 +36,17 @@ V{
 | 
			
		|||
 | 
			
		||||
[ ] [ test-interference ] unit-test
 | 
			
		||||
 | 
			
		||||
[ f ] [ V int-regs 0 V int-regs 1 interferes? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 1 V int-regs 0 interferes? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 2 V int-regs 3 interferes? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 3 V int-regs 2 interferes? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 0 V int-regs 2 interferes? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 2 V int-regs 0 interferes? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 1 V int-regs 3 interferes? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 3 V int-regs 1 interferes? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 3 V int-regs 4 interferes? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 4 V int-regs 3 interferes? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 3 V int-regs 5 interferes? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 5 V int-regs 3 interferes? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 3 V int-regs 6 interferes? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 6 V int-regs 3 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 vregs-interfere? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 2 V int-regs 3 vregs-interfere? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 3 V int-regs 2 vregs-interfere? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 0 V int-regs 2 vregs-interfere? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 2 V int-regs 0 vregs-interfere? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 1 V int-regs 3 vregs-interfere? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 3 V int-regs 1 vregs-interfere? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 3 V int-regs 4 vregs-interfere? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 4 V int-regs 3 vregs-interfere? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 3 V int-regs 5 vregs-interfere? ] unit-test
 | 
			
		||||
[ t ] [ V int-regs 5 V int-regs 3 vregs-interfere? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 3 V int-regs 6 vregs-interfere? ] unit-test
 | 
			
		||||
[ f ] [ V int-regs 6 V int-regs 3 vregs-interfere? ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			@ -39,7 +39,7 @@ IN: compiler.cfg.ssa.interference
 | 
			
		|||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: interferes? ( vreg1 vreg2 -- ? )
 | 
			
		||||
: vregs-interfere? ( vreg1 vreg2 -- ? )
 | 
			
		||||
    2dup [ def-of ] bi@ {
 | 
			
		||||
        { [ 2dup eq? ] [ interferes-same-block? ] }
 | 
			
		||||
        { [ 2dup dominates? ] [ interferes-first-dominates? ] }
 | 
			
		||||
| 
						 | 
				
			
			@ -48,11 +48,12 @@ PRIVATE>
 | 
			
		|||
    } cond ;
 | 
			
		||||
 | 
			
		||||
! Debug this stuff later
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: quadratic-test? ( seq1 seq2 -- ? ) [ length ] bi@ + 10 < ;
 | 
			
		||||
 | 
			
		||||
: quadratic-test ( seq1 seq2 -- ? )
 | 
			
		||||
    '[ _ [ interferes? ] with any? ] any? ;
 | 
			
		||||
    '[ _ [ vregs-interfere? ] with any? ] any? ;
 | 
			
		||||
 | 
			
		||||
: sort-vregs-by-bb ( vregs -- alist )
 | 
			
		||||
    defs get
 | 
			
		||||
| 
						 | 
				
			
			@ -64,15 +65,22 @@ PRIVATE>
 | 
			
		|||
: find-parent ( dom current -- parent )
 | 
			
		||||
    over empty? [ 2drop f ] [
 | 
			
		||||
        over last over dominates? [ drop last ] [
 | 
			
		||||
            [ pop* ] dip find-parent
 | 
			
		||||
            over pop* find-parent
 | 
			
		||||
        ] if
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
:: linear-test ( seq1 seq2 -- ? )
 | 
			
		||||
    ! Instead of sorting, SSA destruction should keep equivalence
 | 
			
		||||
    ! classes sorted by merging them on append
 | 
			
		||||
    V{ } clone :> dom
 | 
			
		||||
    seq1 seq2 append sort-vregs-by-bb [| pair |
 | 
			
		||||
        pair first :> current
 | 
			
		||||
        dom current find-parent
 | 
			
		||||
        dup [ current interferes? ] when
 | 
			
		||||
        dup [ current vregs-interfere? ] when
 | 
			
		||||
        [ t ] [ current dom push f ] if
 | 
			
		||||
    ] any? ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: sets-interfere? ( seq1 seq2 -- ? )
 | 
			
		||||
    quadratic-test ;
 | 
			
		||||
		Loading…
	
		Reference in New Issue