compiler.cfg.linear-scan: Working on resolve pass

db4
Slava Pestov 2009-06-21 00:20:01 -05:00
parent c1839200dd
commit 5a78956956
4 changed files with 429 additions and 355 deletions

View File

@ -40,16 +40,23 @@ ERROR: already-spilled ;
2dup key? [ already-spilled ] [ set-at ] if ;
: insert-spill ( live-interval -- )
[ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri _spill ;
{
[ reg>> ]
[ vreg>> reg-class>> ]
[ spill-to>> ]
[ end>> ]
} cleave f swap \ _spill boa , ;
: handle-spill ( live-interval -- )
dup spill-to>> [ [ record-spill ] [ insert-spill ] bi ] [ drop ] if ;
: insert-copy ( live-interval -- )
[ split-next>> reg>> ]
[ reg>> ]
[ vreg>> reg-class>> ]
tri _copy ;
{
[ split-next>> reg>> ]
[ reg>> ]
[ vreg>> reg-class>> ]
[ end>> ]
} cleave f swap \ _copy boa , ;
: handle-copy ( live-interval -- )
dup [ spill-to>> not ] [ split-next>> ] bi and
@ -68,7 +75,12 @@ ERROR: already-reloaded ;
2dup key? [ delete-at ] [ already-reloaded ] if ;
: insert-reload ( live-interval -- )
[ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri _reload ;
{
[ reg>> ]
[ vreg>> reg-class>> ]
[ reload-from>> ]
[ end>> ]
} cleave f swap \ _reload boa , ;
: handle-reload ( live-interval -- )
dup reload-from>> [ [ record-reload ] [ insert-reload ] bi ] [ drop ] if ;
@ -141,6 +153,6 @@ M: insn assign-registers-in-insn drop ;
] V{ } make
] change-instructions drop ;
: assign-registers ( rpo live-intervals -- )
init-assignment
: assign-registers ( live-intervals rpo -- )
[ init-assignment ] dip
[ assign-registers-in-block ] each ;

View File

@ -10,6 +10,8 @@ compiler.cfg.registers
compiler.cfg.liveness
compiler.cfg.predecessors
compiler.cfg.rpo
compiler.cfg.linearization
compiler.cfg.debugger
compiler.cfg.linear-scan
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation
@ -410,7 +412,7 @@ SYMBOL: max-uses
[ ] [ 10 20 2 400 random-test ] unit-test
[ ] [ 10 20 4 300 random-test ] unit-test
USING: math.private compiler.cfg.debugger ;
USING: math.private ;
[ ] [
[ float+ float>fixnum 3 fixnum*fast ]
@ -1415,196 +1417,152 @@ USING: math.private compiler.cfg.debugger ;
intersect-inactive
] unit-test
: test-bb ( insns n -- )
[ <basic-block> swap >>number swap >>instructions ] keep set ;
! Bug in live spill slots calculation
T{ basic-block
{ id 205651 }
{ number 0 }
{ instructions V{ T{ ##prologue } T{ ##branch } } }
} 0 set
V{ T{ ##prologue } T{ ##branch } } 0 test-bb
T{ basic-block
{ id 205652 }
{ number 1 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 703128 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 703129 }
{ loc D 0 }
}
T{ ##copy
{ dst V int-regs 703134 }
{ src V int-regs 703128 }
}
T{ ##copy
{ dst V int-regs 703135 }
{ src V int-regs 703129 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 703128 }
{ src2 5 }
{ cc cc/= }
}
}
}
} 1 set
V{
T{ ##peek
{ dst V int-regs 703128 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 703129 }
{ loc D 0 }
}
T{ ##copy
{ dst V int-regs 703134 }
{ src V int-regs 703128 }
}
T{ ##copy
{ dst V int-regs 703135 }
{ src V int-regs 703129 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 703128 }
{ src2 5 }
{ cc cc/= }
}
} 1 test-bb
T{ basic-block
{ id 205653 }
{ number 2 }
{ instructions
V{
T{ ##copy
{ dst V int-regs 703134 }
{ src V int-regs 703129 }
}
T{ ##copy
{ dst V int-regs 703135 }
{ src V int-regs 703128 }
}
T{ ##branch }
}
}
} 2 set
V{
T{ ##copy
{ dst V int-regs 703134 }
{ src V int-regs 703129 }
}
T{ ##copy
{ dst V int-regs 703135 }
{ src V int-regs 703128 }
}
T{ ##branch }
} 2 test-bb
T{ basic-block
{ id 205655 }
{ number 3 }
{ instructions
V{
T{ ##replace
{ src V int-regs 703134 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 703135 }
{ loc D 1 }
}
T{ ##epilogue }
T{ ##return }
}
}
} 3 set
V{
T{ ##replace
{ src V int-regs 703134 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 703135 }
{ loc D 1 }
}
T{ ##epilogue }
T{ ##return }
} 3 test-bb
1 get 1vector 0 get (>>successors)
2 get 3 get V{ } 2sequence 1 get (>>successors)
3 get 1vector 2 get (>>successors)
SYMBOL: linear-scan-result
:: test-linear-scan-on-cfg ( regs -- )
[ ] [
cfg new 0 get >>entry
compute-predecessors
compute-liveness
reverse-post-order
dup reverse-post-order
{ { int-regs regs } } (linear-scan)
flatten-cfg 1array mr.
] unit-test ;
{ 1 2 } test-linear-scan-on-cfg
! Bug in inactive interval handling
! [ rot dup [ -rot ] when ]
T{ basic-block
{ id 201486 }
{ number 0 }
{ instructions V{ T{ ##prologue } T{ ##branch } } }
} 0 set
V{ T{ ##prologue } T{ ##branch } } 0 test-bb
T{ basic-block
{ id 201487 }
{ number 1 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 689473 }
{ loc D 2 }
}
T{ ##peek
{ dst V int-regs 689474 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 689475 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 689473 }
{ src2 5 }
{ cc cc/= }
}
}
}
} 1 set
V{
T{ ##peek
{ dst V int-regs 689473 }
{ loc D 2 }
}
T{ ##peek
{ dst V int-regs 689474 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 689475 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 689473 }
{ src2 5 }
{ cc cc/= }
}
} 1 test-bb
T{ basic-block
{ id 201488 }
{ number 2 }
{ instructions
V{
T{ ##copy
{ dst V int-regs 689481 }
{ src V int-regs 689475 }
}
T{ ##copy
{ dst V int-regs 689482 }
{ src V int-regs 689474 }
}
T{ ##copy
{ dst V int-regs 689483 }
{ src V int-regs 689473 }
}
T{ ##branch }
}
}
} 2 set
V{
T{ ##copy
{ dst V int-regs 689481 }
{ src V int-regs 689475 }
}
T{ ##copy
{ dst V int-regs 689482 }
{ src V int-regs 689474 }
}
T{ ##copy
{ dst V int-regs 689483 }
{ src V int-regs 689473 }
}
T{ ##branch }
} 2 test-bb
T{ basic-block
{ id 201489 }
{ number 3 }
{ instructions
V{
T{ ##copy
{ dst V int-regs 689481 }
{ src V int-regs 689473 }
}
T{ ##copy
{ dst V int-regs 689482 }
{ src V int-regs 689475 }
}
T{ ##copy
{ dst V int-regs 689483 }
{ src V int-regs 689474 }
}
T{ ##branch }
}
}
} 3 set
V{
T{ ##copy
{ dst V int-regs 689481 }
{ src V int-regs 689473 }
}
T{ ##copy
{ dst V int-regs 689482 }
{ src V int-regs 689475 }
}
T{ ##copy
{ dst V int-regs 689483 }
{ src V int-regs 689474 }
}
T{ ##branch }
} 3 test-bb
T{ basic-block
{ id 201490 }
{ number 4 }
{ instructions
V{
T{ ##replace
{ src V int-regs 689481 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 689482 }
{ loc D 1 }
}
T{ ##replace
{ src V int-regs 689483 }
{ loc D 2 }
}
T{ ##epilogue }
T{ ##return }
}
}
} 4 set
V{
T{ ##replace
{ src V int-regs 689481 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 689482 }
{ loc D 1 }
}
T{ ##replace
{ src V int-regs 689483 }
{ loc D 2 }
}
T{ ##epilogue }
T{ ##return }
} 4 test-bb
: test-diamond ( -- )
1 get 1vector 0 get (>>successors)
@ -1625,102 +1583,78 @@ T{ basic-block
{ instructions V{ T{ ##prologue } T{ ##branch } } }
} 0 set
T{ basic-block
{ id 201538 }
{ number 1 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 689600 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 689601 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 689600 }
{ src2 5 }
{ cc cc/= }
}
}
}
} 1 set
V{
T{ ##peek
{ dst V int-regs 689600 }
{ loc D 1 }
}
T{ ##peek
{ dst V int-regs 689601 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 689600 }
{ src2 5 }
{ cc cc/= }
}
} 1 test-bb
T{ basic-block
{ id 201539 }
{ number 2 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 689604 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 689607 }
{ src V int-regs 689604 }
}
T{ ##copy
{ dst V int-regs 689608 }
{ src V int-regs 689600 }
}
T{ ##copy
{ dst V int-regs 689610 }
{ src V int-regs 689601 }
}
T{ ##branch }
}
}
} 2 set
V{
T{ ##peek
{ dst V int-regs 689604 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 689607 }
{ src V int-regs 689604 }
}
T{ ##copy
{ dst V int-regs 689608 }
{ src V int-regs 689600 }
}
T{ ##copy
{ dst V int-regs 689610 }
{ src V int-regs 689601 }
}
T{ ##branch }
} 2 test-bb
T{ basic-block
{ id 201540 }
{ number 3 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 689609 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 689607 }
{ src V int-regs 689600 }
}
T{ ##copy
{ dst V int-regs 689608 }
{ src V int-regs 689601 }
}
T{ ##copy
{ dst V int-regs 689610 }
{ src V int-regs 689609 }
}
T{ ##branch }
}
}
} 3 set
V{
T{ ##peek
{ dst V int-regs 689609 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 689607 }
{ src V int-regs 689600 }
}
T{ ##copy
{ dst V int-regs 689608 }
{ src V int-regs 689601 }
}
T{ ##copy
{ dst V int-regs 689610 }
{ src V int-regs 689609 }
}
T{ ##branch }
} 3 test-bb
T{ basic-block
{ id 201541 }
{ number 4 }
{ instructions
V{
T{ ##replace
{ src V int-regs 689607 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 689608 }
{ loc D 1 }
}
T{ ##replace
{ src V int-regs 689610 }
{ loc D 2 }
}
T{ ##epilogue }
T{ ##return }
}
}
} 4 set
V{
T{ ##replace
{ src V int-regs 689607 }
{ loc D 0 }
}
T{ ##replace
{ src V int-regs 689608 }
{ loc D 1 }
}
T{ ##replace
{ src V int-regs 689610 }
{ loc D 2 }
}
T{ ##epilogue }
T{ ##return }
} 4 test-bb
test-diamond
@ -1729,76 +1663,130 @@ test-diamond
! compute-live-registers was inaccurate since it didn't take
! lifetime holes into account
T{ basic-block
{ id 0 }
{ number 0 }
{ instructions V{ T{ ##prologue } T{ ##branch } } }
} 0 set
V{ T{ ##prologue } T{ ##branch } } 0 test-bb
T{ basic-block
{ id 1 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 0 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 0 }
{ src2 5 }
{ cc cc/= }
}
}
}
} 1 set
V{
T{ ##peek
{ dst V int-regs 0 }
{ loc D 0 }
}
T{ ##compare-imm-branch
{ src1 V int-regs 0 }
{ src2 5 }
{ cc cc/= }
}
} 1 test-bb
T{ basic-block
{ id 2 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 1 }
{ loc D 1 }
}
T{ ##copy
{ dst V int-regs 2 }
{ src V int-regs 1 }
}
T{ ##branch }
}
}
} 2 set
V{
T{ ##peek
{ dst V int-regs 1 }
{ loc D 1 }
}
T{ ##copy
{ dst V int-regs 2 }
{ src V int-regs 1 }
}
T{ ##branch }
} 2 test-bb
T{ basic-block
{ id 3 }
{ instructions
V{
T{ ##peek
{ dst V int-regs 3 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 2 }
{ src V int-regs 3 }
}
T{ ##branch }
}
}
} 3 set
V{
T{ ##peek
{ dst V int-regs 3 }
{ loc D 2 }
}
T{ ##copy
{ dst V int-regs 2 }
{ src V int-regs 3 }
}
T{ ##branch }
} 3 test-bb
T{ basic-block
{ id 4 }
{ instructions
V{
T{ ##replace
{ src V int-regs 2 }
{ loc D 0 }
}
T{ ##return }
}
}
} 4 set
V{
T{ ##replace
{ src V int-regs 2 }
{ loc D 0 }
}
T{ ##return }
} 4 test-bb
test-diamond
{ 1 2 3 4 } test-linear-scan-on-cfg
{ 1 2 3 4 } test-linear-scan-on-cfg
! Inactive interval handling: splitting active interval
! if it fits in lifetime hole only partially
V{ T{ ##peek f V int-regs 3 R 1 } T{ ##branch } } 0 test-bb
V{
T{ ##peek f V int-regs 2 R 0 }
T{ ##compare-imm-branch f V int-regs 2 5 cc= }
} 1 test-bb
V{
T{ ##peek f V int-regs 0 D 0 }
T{ ##branch }
} 2 test-bb
V{
T{ ##peek f V int-regs 1 D 1 }
T{ ##peek f V int-regs 0 D 0 }
T{ ##replace f V int-regs 1 D 2 }
T{ ##branch }
} 3 test-bb
V{
T{ ##replace f V int-regs 3 R 2 }
T{ ##replace f V int-regs 0 D 0 }
T{ ##return }
} 4 test-bb
test-diamond
{ 1 2 } test-linear-scan-on-cfg
USING: classes ;
[ ] [
1 get instructions>> first regs>> V int-regs 0 swap at
2 get instructions>> first regs>> V int-regs 1 swap at assert=
] unit-test
[ _copy ] [ 3 get instructions>> second class ] unit-test
! Resolve pass; make sure the spilling is done correctly
V{ T{ ##peek f V int-regs 3 R 1 } T{ ##branch } } 0 test-bb
V{
T{ ##peek f V int-regs 2 R 0 }
T{ ##compare-imm-branch f V int-regs 2 5 cc= }
} 1 test-bb
V{
T{ ##branch }
} 2 test-bb
V{
T{ ##replace f V int-regs 3 R 1 }
T{ ##peek f V int-regs 1 D 1 }
T{ ##peek f V int-regs 0 D 0 }
T{ ##replace f V int-regs 1 D 2 }
T{ ##replace f V int-regs 0 D 2 }
T{ ##branch }
} 3 test-bb
V{
T{ ##replace f V int-regs 3 R 2 }
T{ ##return }
} 4 test-bb
test-diamond
{ 1 2 } test-linear-scan-on-cfg
[ _spill ] [ 2 get instructions>> first class ] unit-test
[ _spill ] [ 3 get instructions>> second class ] unit-test
[ _reload ] [ 4 get instructions>> first class ] unit-test

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors namespaces make
USING: kernel accessors namespaces make locals
cpu.architecture
compiler.cfg
compiler.cfg.rpo
@ -9,7 +9,8 @@ compiler.cfg.linear-scan.numbering
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation
compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.assignment ;
compiler.cfg.linear-scan.assignment
compiler.cfg.linear-scan.resolve ;
IN: compiler.cfg.linear-scan
! References:
@ -26,12 +27,11 @@ IN: compiler.cfg.linear-scan
! by Omri Traub, Glenn Holloway, Michael D. Smith
! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.34.8435
: (linear-scan) ( rpo machine-registers -- )
[
dup number-instructions
dup compute-live-intervals
] dip
allocate-registers assign-registers ;
:: (linear-scan) ( rpo machine-registers -- )
rpo number-instructions
rpo compute-live-intervals machine-registers allocate-registers
rpo assign-registers
rpo resolve-data-flow ;
: linear-scan ( cfg -- cfg' )
[

View File

@ -1,34 +1,108 @@
! Copyright (C) 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel math namespaces sequences
compiler.cfg.linear-scan.live-intervals compiler.cfg.liveness ;
classes.tuple classes.parser parser fry words make arrays
combinators compiler.cfg.linear-scan.live-intervals
compiler.cfg.liveness compiler.cfg.instructions ;
IN: compiler.cfg.linear-scan.resolve
<<
TUPLE: operation from to reg-class ;
SYNTAX: OPERATION:
CREATE-CLASS dup save-location
[ operation { } define-tuple-class ]
[
[ scan-word scan-word ] keep
'[
[ [ _ execute ] [ _ execute ] bi* ]
[ vreg>> reg-class>> ]
bi _ boa ,
] (( from to -- )) define-declared
] bi ;
>>
OPERATION: memory->memory spill-to>> reload-from>>
OPERATION: register->memory reg>> reload-from>>
OPERATION: memory->register spill-to>> reg>>
OPERATION: register->register reg>> reg>>
: add-mapping ( from to -- )
2drop
;
dup reload-from>> [
over spill-to>> [ memory->memory ] [ register->memory ] if
] [
over spill-to>> [ memory->register ] [ register->register ] if
] if ;
: resolve-value-data-flow ( bb to vreg -- )
live-intervals get at
[ [ block-to ] dip child-interval-at ]
[ [ block-from ] dip child-interval-at ]
bi-curry bi* 2dup = [ 2drop ] [
add-mapping
bi-curry bi* 2dup eq? [ 2drop ] [ add-mapping ] if ;
: compute-mappings ( bb to -- mappings )
[
dup live-in keys
[ resolve-value-data-flow ] with with each
] { } make ;
GENERIC: >insn ( operation -- )
: >operation< ( operation -- from to reg-class )
[ from>> ] [ to>> ] [ reg-class>> ] tri ; inline
M: memory->memory >insn
[ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ;
M: register->memory >insn
[ from>> ] [ reg-class>> ] [ to>> ] tri _spill ;
M: memory->register >insn
[ to>> ] [ reg-class>> ] [ from>> ] tri _reload ;
M: register->register >insn
[ to>> ] [ from>> ] [ reg-class>> ] tri _copy ;
: mapping-instructions ( mappings -- insns )
[ [ >insn ] each ] { } make ;
: fork? ( from to -- ? )
[ successors>> length 1 >= ]
[ predecessors>> length 1 = ] bi* and ; inline
: insert-position/fork ( from to -- before after )
nip instructions>> [ >array ] [ dup delete-all ] bi swap ;
: join? ( from to -- ? )
[ successors>> length 1 = ]
[ predecessors>> length 1 >= ] bi* and ; inline
: insert-position/join ( from to -- before after )
drop instructions>> { } ;
: 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
] if ;
: resolve-mappings ( bb to -- )
2drop
;
: resolve-edge-data-flow ( bb to -- )
[ dup live-in [ resolve-value-data-flow ] with with each ]
[ resolve-mappings ]
2bi ;
[ compute-mappings ] [ perform-mappings ] 2bi ;
: resolve-block-data-flow ( bb -- )
dup successors>> [
resolve-edge-data-flow
] with each ;
dup successors>> [ resolve-edge-data-flow ] with each ;
: resolve-data-flow ( rpo -- )
[ resolve-block-data-flow ] each ;