Merge branch 'master' of git://factorcode.org/git/factor

db4
Philipp Winkler 2009-06-05 08:48:28 -07:00
commit 16d576e337
4 changed files with 314 additions and 99 deletions

View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces sequences math math.order kernel assocs
accessors vectors fry heaps cpu.architecture combinators
compiler.cfg.registers
compiler.cfg.linear-scan.live-intervals ;
accessors vectors fry heaps cpu.architecture sorting locals
combinators compiler.cfg.registers
compiler.cfg.linear-scan.live-intervals hints ;
IN: compiler.cfg.linear-scan.allocation
! Mapping from register classes to sequences of machine registers
@ -27,13 +27,61 @@ SYMBOL: active-intervals
: delete-active ( live-interval -- )
dup vreg>> active-intervals-for delq ;
: expire-old-intervals ( n -- )
active-intervals swap '[
[
[ end>> _ < ] partition
[ [ deallocate-register ] each ] dip
] assoc-map
] change ;
! Vector of inactive live intervals
SYMBOL: inactive-intervals
: inactive-intervals-for ( vreg -- seq )
reg-class>> inactive-intervals get at ;
: add-inactive ( live-interval -- )
dup vreg>> inactive-intervals-for push ;
! Vector of handled live intervals
SYMBOL: handled-intervals
: add-handled ( live-interval -- )
handled-intervals get push ;
: finished? ( n live-interval -- ? ) end>> swap < ;
: finish ( n live-interval -- keep? )
nip [ deallocate-register ] [ add-handled ] bi f ;
: activate ( n live-interval -- keep? )
nip add-active f ;
: deactivate ( n live-interval -- keep? )
nip add-inactive f ;
: don't-change ( n live-interval -- keep? ) 2drop t ;
! Moving intervals between active and inactive sets
: process-intervals ( n symbol quots -- )
! symbol stores an alist mapping register classes to vectors
[ get values ] dip '[ [ _ cond ] with filter-here ] with each ; inline
: covers? ( insn# live-interval -- ? )
ranges>> [ [ from>> ] [ to>> ] bi between? ] with any? ;
: deactivate-intervals ( n -- )
! Any active intervals which have ended are moved to handled
! Any active intervals which cover the current position
! are moved to inactive
active-intervals {
{ [ 2dup finished? ] [ finish ] }
{ [ 2dup covers? not ] [ deactivate ] }
[ don't-change ]
} process-intervals ;
: activate-intervals ( n -- )
! Any inactive intervals which have ended are moved to handled
! Any inactive intervals which do not cover the current position
! are moved to active
inactive-intervals {
{ [ 2dup finished? ] [ finish ] }
{ [ 2dup covers? ] [ activate ] }
[ don't-change ]
} process-intervals ;
! Minheap of live intervals which still need a register allocation
SYMBOL: unhandled-intervals
@ -66,29 +114,64 @@ SYMBOL: progress
: coalesce ( live-interval -- )
dup copy-from>> active-interval
[ [ add-active ] [ delete-active ] bi* ]
[ [ add-active ] [ [ delete-active ] [ add-handled ] bi ] bi* ]
[ reg>> >>reg drop ]
2bi ;
! Splitting
: find-use ( live-interval n quot -- i elt )
[ uses>> ] 2dip curry find ; inline
: split-range ( live-range n -- before after )
[ [ from>> ] dip <live-range> ]
[ 1 + swap to>> <live-range> ]
2bi ;
: split-before ( live-interval i -- before )
[ clone dup uses>> ] dip
[ head >>uses ] [ 1- swap nth >>end ] 2bi ;
: split-last-range? ( last n -- ? )
swap to>> <= ;
: split-after ( live-interval i -- after )
[ clone dup uses>> ] dip
[ tail >>uses ] [ swap nth >>start ] 2bi
f >>reg f >>copy-from ;
: split-last-range ( before after last n -- before' after' )
split-range [ [ but-last ] dip suffix ] [ prefix ] bi-curry* bi* ;
: split-interval ( live-interval n -- before after )
[ drop ] [ [ > ] find-use drop ] 2bi
[ split-before ] [ split-after ] 2bi ;
: split-ranges ( live-ranges n -- before after )
[ '[ from>> _ <= ] partition ]
[
pick empty? [ drop ] [
[ over last ] dip 2dup split-last-range?
[ split-last-range ] [ 2drop ] if
] if
] bi ;
: split-uses ( uses n -- before after )
'[ _ <= ] partition ;
: record-split ( live-interval before after -- )
[ >>split-before ] [ >>split-after ] bi* drop ;
[ >>split-before ] [ >>split-after ] bi* drop ; inline
: check-split ( live-interval -- )
[ end>> ] [ start>> ] bi - 0 =
[ "BUG: splitting atomic interval" throw ] when ; inline
: split-before ( before -- before' )
[ [ ranges>> last ] [ uses>> last ] bi >>to drop ]
[ compute-start/end ]
[ ]
tri ; inline
: split-after ( after -- after' )
[ [ ranges>> first ] [ uses>> first ] bi >>from drop ]
[ compute-start/end ]
[ ]
tri ; inline
:: split-interval ( live-interval n -- before after )
live-interval check-split
live-interval clone :> before
live-interval clone f >>copy-from f >>reg :> after
live-interval uses>> n split-uses before after [ (>>uses) ] bi-curry@ bi*
live-interval ranges>> n split-ranges before after [ (>>ranges) ] bi-curry@ bi*
live-interval before after record-split
before split-before
after split-after ;
HINTS: split-interval live-interval object ;
! Spilling
SYMBOL: spill-counts
@ -96,6 +179,9 @@ SYMBOL: spill-counts
: next-spill-location ( reg-class -- n )
spill-counts get [ dup 1+ ] change-at ;
: find-use ( live-interval n quot -- i elt )
[ uses>> ] 2dip curry find ; inline
: interval-to-spill ( active-intervals current -- live-interval )
#! We spill the interval with the most distant use location.
start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc
@ -108,8 +194,7 @@ SYMBOL: spill-counts
[ >>spill-to ] [ >>reload-from ] bi-curry bi* ;
: split-and-spill ( new existing -- before after )
dup rot start>> split-interval
[ record-split ] [ assign-spill ] 2bi ;
swap start>> split-interval assign-spill ;
: reuse-register ( new existing -- )
reg>> >>reg add-active ;
@ -121,7 +206,7 @@ SYMBOL: spill-counts
#! of the existing interval again.
[ reuse-register ]
[ nip delete-active ]
[ split-and-spill [ drop ] [ add-unhandled ] bi* ] 2tri ;
[ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] 2tri ;
: spill-new ( new existing -- )
#! Our new interval will be used after the active interval
@ -141,37 +226,78 @@ SYMBOL: spill-counts
: assign-free-register ( new registers -- )
pop >>reg add-active ;
: assign-register ( new -- )
dup coalesce? [
coalesce
: next-intersection ( new inactive -- n )
2drop 0 ;
: intersecting-inactive ( new -- live-intervals )
dup vreg>> inactive-intervals-for
[ tuck next-intersection ] with { } map>assoc ;
: fits-in-hole ( new pair -- )
first reuse-register ;
: split-before-use ( new pair -- before after )
! Find optimal split position
second split-interval ;
: assign-inactive-register ( new live-intervals -- )
! If there is an interval which is inactive for the entire lifetime
! if the new interval, reuse its vreg. Otherwise, split new so that
! the first half fits.
sort-values last
2dup [ end>> ] [ second ] bi* < [
fits-in-hole
] [
dup vreg>> free-registers-for
[ assign-blocked-register ]
[ assign-free-register ]
[ split-before-use ] keep
'[ _ fits-in-hole ] [ add-unhandled ] bi*
] if ;
: assign-register ( new -- )
dup coalesce? [ coalesce ] [
dup vreg>> free-registers-for [
dup intersecting-inactive
[ assign-blocked-register ]
[ assign-inactive-register ]
if-empty
] [ assign-free-register ]
if-empty
] if ;
! Main loop
: reg-classes ( -- seq ) { int-regs double-float-regs } ; inline
: reg-class-assoc ( quot -- assoc )
[ reg-classes ] dip { } map>assoc ; inline
: init-allocator ( registers -- )
<min-heap> unhandled-intervals set
[ reverse >vector ] assoc-map free-registers set
reg-classes [ 0 ] { } map>assoc spill-counts set
reg-classes [ V{ } clone ] { } map>assoc active-intervals set
[ 0 ] reg-class-assoc spill-counts set
<min-heap> unhandled-intervals set
[ V{ } clone ] reg-class-assoc active-intervals set
[ V{ } clone ] reg-class-assoc inactive-intervals set
V{ } clone handled-intervals set
-1 progress set ;
: handle-interval ( live-interval -- )
[ start>> progress set ]
[ start>> expire-old-intervals ]
[ assign-register ]
tri ;
[
start>>
[ progress set ]
[ deactivate-intervals ]
[ activate-intervals ] tri
] [ assign-register ] bi ;
: (allocate-registers) ( -- )
unhandled-intervals get [ handle-interval ] slurp-heap ;
: finish-allocation ( -- )
! Sanity check: all live intervals should've been processed
active-intervals inactive-intervals
[ get values [ handled-intervals get push-all ] each ] bi@ ;
: allocate-registers ( live-intervals machine-registers -- live-intervals )
#! This modifies the input live-intervals.
init-allocator
dup init-unhandled
(allocate-registers) ;
init-unhandled
(allocate-registers)
finish-allocation
handled-intervals get ;

View File

@ -25,12 +25,7 @@ TUPLE: active-intervals seq ;
SYMBOL: unhandled-intervals
: add-unhandled ( live-interval -- )
dup split-before>> [
[ split-before>> ] [ split-after>> ] bi
[ add-unhandled ] bi@
] [
dup start>> unhandled-intervals get heap-push
] if ;
dup start>> unhandled-intervals get heap-push ;
: init-unhandled ( live-intervals -- )
[ add-unhandled ] each ;

View File

@ -12,6 +12,60 @@ compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation
compiler.cfg.linear-scan.debugger ;
[
{ T{ live-range f 1 10 } T{ live-range f 15 15 } }
{ T{ live-range f 16 20 } }
] [
{
T{ live-range f 1 10 }
T{ live-range f 15 20 }
} 15 split-ranges
] unit-test
[
{ T{ live-range f 1 10 } T{ live-range f 15 16 } }
{ T{ live-range f 17 20 } }
] [
{
T{ live-range f 1 10 }
T{ live-range f 15 20 }
} 16 split-ranges
] unit-test
[
{ T{ live-range f 1 10 } }
{ T{ live-range f 15 20 } }
] [
{
T{ live-range f 1 10 }
T{ live-range f 15 20 }
} 12 split-ranges
] unit-test
[
{ T{ live-range f 1 10 } T{ live-range f 15 17 } }
{ T{ live-range f 18 20 } }
] [
{
T{ live-range f 1 10 }
T{ live-range f 15 20 }
} 17 split-ranges
] unit-test
[
{ }
{ T{ live-range f 1 10 } }
] [
{ T{ live-range f 1 10 } } 0 split-ranges
] unit-test
[
{ T{ live-range f 0 0 } }
{ T{ live-range f 1 5 } }
] [
{ T{ live-range f 0 5 } } 0 split-ranges
] unit-test
[ 7 ] [
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 2 } } }
@ -44,23 +98,26 @@ compiler.cfg.linear-scan.debugger ;
[
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 0 }
{ end 1 }
{ uses V{ 0 1 } }
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 0 }
{ end 1 }
{ uses V{ 0 1 } }
{ ranges V{ T{ live-range f 0 1 } } }
}
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 5 }
{ end 5 }
{ uses V{ 5 } }
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 5 }
{ end 5 }
{ uses V{ 5 } }
{ ranges V{ T{ live-range f 5 5 } } }
}
] [
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 0 }
{ end 5 }
{ uses V{ 0 1 5 } }
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 0 }
{ end 5 }
{ uses V{ 0 1 5 } }
{ ranges V{ T{ live-range f 0 5 } } }
} 2 split-interval
] unit-test
@ -70,12 +127,14 @@ compiler.cfg.linear-scan.debugger ;
{ start 0 }
{ end 0 }
{ uses V{ 0 } }
{ ranges V{ T{ live-range f 0 0 } } }
}
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 1 }
{ end 5 }
{ uses V{ 1 5 } }
{ ranges V{ T{ live-range f 1 5 } } }
}
] [
T{ live-interval
@ -83,6 +142,7 @@ compiler.cfg.linear-scan.debugger ;
{ start 0 }
{ end 5 }
{ uses V{ 0 1 5 } }
{ ranges V{ T{ live-range f 0 5 } } }
} 0 split-interval
] unit-test
@ -173,7 +233,13 @@ compiler.cfg.linear-scan.debugger ;
[ ] [
{
T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
T{ live-interval
{ vreg T{ vreg { n 1 } { reg-class int-regs } } }
{ start 0 }
{ end 100 }
{ uses V{ 0 100 } }
{ ranges V{ T{ live-range f 0 100 } } }
}
}
H{ { int-regs { "A" } } }
check-linear-scan
@ -181,8 +247,20 @@ compiler.cfg.linear-scan.debugger ;
[ ] [
{
T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 10 } { uses V{ 0 10 } } }
T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 11 } { end 20 } { uses V{ 11 20 } } }
T{ live-interval
{ vreg T{ vreg { n 1 } { reg-class int-regs } } }
{ start 0 }
{ end 10 }
{ uses V{ 0 10 } }
{ ranges V{ T{ live-range f 0 10 } } }
}
T{ live-interval
{ vreg T{ vreg { n 2 } { reg-class int-regs } } }
{ start 11 }
{ end 20 }
{ uses V{ 11 20 } }
{ ranges V{ T{ live-range f 11 20 } } }
}
}
H{ { int-regs { "A" } } }
check-linear-scan
@ -190,8 +268,20 @@ compiler.cfg.linear-scan.debugger ;
[ ] [
{
T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 30 } { end 60 } { uses V{ 30 60 } } }
T{ live-interval
{ vreg T{ vreg { n 1 } { reg-class int-regs } } }
{ start 0 }
{ end 100 }
{ uses V{ 0 100 } }
{ ranges V{ T{ live-range f 0 100 } } }
}
T{ live-interval
{ vreg T{ vreg { n 2 } { reg-class int-regs } } }
{ start 30 }
{ end 60 }
{ uses V{ 30 60 } }
{ ranges V{ T{ live-range f 30 60 } } }
}
}
H{ { int-regs { "A" } } }
check-linear-scan
@ -199,8 +289,20 @@ compiler.cfg.linear-scan.debugger ;
[ ] [
{
T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 30 } { end 200 } { uses V{ 30 200 } } }
T{ live-interval
{ vreg T{ vreg { n 1 } { reg-class int-regs } } }
{ start 0 }
{ end 100 }
{ uses V{ 0 100 } }
{ ranges V{ T{ live-range f 0 100 } } }
}
T{ live-interval
{ vreg T{ vreg { n 2 } { reg-class int-regs } } }
{ start 30 }
{ end 200 }
{ uses V{ 30 200 } }
{ ranges V{ T{ live-range f 30 200 } } }
}
}
H{ { int-regs { "A" } } }
check-linear-scan
@ -208,8 +310,20 @@ compiler.cfg.linear-scan.debugger ;
[
{
T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 30 } { end 100 } { uses V{ 30 100 } } }
T{ live-interval
{ vreg T{ vreg { n 1 } { reg-class int-regs } } }
{ start 0 }
{ end 100 }
{ uses V{ 0 100 } }
{ ranges V{ T{ live-range f 0 100 } } }
}
T{ live-interval
{ vreg T{ vreg { n 2 } { reg-class int-regs } } }
{ start 30 }
{ end 100 }
{ uses V{ 30 100 } }
{ ranges V{ T{ live-range f 30 100 } } }
}
}
H{ { int-regs { "A" } } }
check-linear-scan
@ -272,31 +386,10 @@ USING: math.private compiler.cfg.debugger ;
test-cfg first optimize-cfg linear-scan drop
] unit-test
[ 0 1 ] [
{
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 0 }
{ end 5 }
{ uses V{ 0 1 5 } }
}
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 2 } } }
{ start 3 }
{ end 4 }
{ uses V{ 3 4 } }
}
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 3 } } }
{ start 2 }
{ end 6 }
{ uses V{ 2 4 6 } }
}
} [ clone ] map
H{ { int-regs { "A" "B" } } }
allocate-registers
first split-before>> [ start>> ] [ end>> ] bi
] unit-test
: fake-live-ranges ( seq -- seq' )
[
clone dup [ start>> ] [ end>> ] bi <live-range> 1vector >>ranges
] map ;
! Coalescing interacted badly with splitting
[ ] [
@ -345,7 +438,7 @@ USING: math.private compiler.cfg.debugger ;
{ end 10 }
{ uses V{ 9 10 } }
}
}
} fake-live-ranges
{ { int-regs { 0 1 2 3 } } }
allocate-registers drop
] unit-test
@ -1100,7 +1193,7 @@ USING: math.private compiler.cfg.debugger ;
{ end 109 }
{ uses V{ 103 109 } }
}
}
} fake-live-ranges
{ { int-regs { 0 1 2 3 4 } } }
allocate-registers drop
] unit-test
@ -1193,7 +1286,7 @@ USING: math.private compiler.cfg.debugger ;
{ end 92 }
{ uses V{ 42 45 78 80 92 } }
}
}
} fake-live-ranges
{ { int-regs { 0 1 2 3 } } }
allocate-registers drop
] unit-test

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel assocs accessors sequences math math.order fry
compiler.cfg.instructions compiler.cfg.registers
binary-search compiler.cfg.instructions compiler.cfg.registers
compiler.cfg.def-use compiler.cfg.liveness compiler.cfg ;
IN: compiler.cfg.linear-scan.live-intervals
@ -109,6 +109,7 @@ M: ##copy-float compute-live-intervals*
: compute-start/end ( live-interval -- )
dup ranges>> [ first from>> ] [ last to>> ] bi
2dup > [ "BUG: start > end" throw ] when
[ >>start ] [ >>end ] bi* drop ;
: finish-live-intervals ( live-intervals -- )