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

compiler.cfg.linear-scan: more code cleanups, and working on split-to-fit algorithm

db4
Slava Pestov 2009-07-09 00:20:03 -05:00
parent 4507bdcbc0
commit 5a64290386
4 changed files with 29 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
basis/compiler/cfg/linear-scan/allocation/allocation.factor
View File

@ -28,16 +28,30 @@ IN: compiler.cfg.linear-scan.allocation
: no-free-registers? ( result -- ? )
second 0 = ; inline
: split-to-fit ( new n -- before after )
split-interval
[ [ compute-start/end ] bi@ ]
[ >>split-next drop ]
[ ]
2tri ;
: register-partially-available ( new result -- )
[ second split-to-fit ] keep
'[ _ register-available ] [ add-unhandled ] bi* ;
{
{ [ 2dup second 1 - spill-live-out? ] [ drop spill-live-out ] }
{ [ 2dup second 1 - spill-live-in? ] [ drop spill-live-in ] }
[
[ second 1 - split-to-fit ] keep
'[ _ register-available ] [ add-unhandled ] bi*
]
} cond ;
: assign-register ( new -- )
dup coalesce? [ coalesce ] [
dup register-status {
{ [ dup no-free-registers? ] [ drop assign-blocked-register ] }
{ [ 2dup register-available? ] [ register-available ] }
[ register-partially-available ]
! [ register-partially-available ]
[ drop assign-blocked-register ]
} cond
] if ;

16
basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
View File

@ -80,6 +80,8 @@ ERROR: bad-live-ranges interval ;
[ add-unhandled ]
} cleave ;
: spill-live-out? ( live-interval n -- ? ) [ uses>> last ] dip < ;
: spill-live-out ( live-interval -- )
! The interval has no more usages after the spill location. This
! means it is the first child of an interval that was split. We
@ -91,6 +93,8 @@ ERROR: bad-live-ranges interval ;
[ add-handled ]
} cleave ;
: spill-live-in? ( live-interval n -- ? ) [ uses>> first ] dip > ;
: spill-live-in ( live-interval -- )
! The interval does not have any usages before the spill location.
! This means it is the second child of an interval that was
@ -103,10 +107,10 @@ ERROR: bad-live-ranges interval ;
[ add-unhandled ]
} cleave ;
: (spill-intersecting) ( live-interval new -- )
start>> {
{ [ 2dup [ uses>> last ] dip < ] [ drop spill-live-out ] }
{ [ 2dup [ uses>> first ] dip > ] [ drop spill-live-in ] }
: spill ( live-interval n -- )
{
{ [ 2dup spill-live-out? ] [ drop spill-live-out ] }
{ [ 2dup spill-live-in? ] [ drop spill-live-in ] }
[ split-and-spill [ add-handled ] [ add-unhandled ] bi* ]
} cond ;
@ -115,7 +119,7 @@ ERROR: bad-live-ranges interval ;
! most one) are split and spilled and removed from the inactive
! set.
new vreg>> active-intervals-for [ [ reg>> reg = ] find swap dup ] keep
'[ _ delete-nth new (spill-intersecting) ] [ 2drop ] if ;
'[ _ delete-nth new start>> spill ] [ 2drop ] if ;
:: spill-intersecting-inactive ( new reg -- )
! Any inactive intervals using 'reg' are split and spilled
@ -123,7 +127,7 @@ ERROR: bad-live-ranges interval ;
new vreg>> inactive-intervals-for [
dup reg>> reg = [
dup new intervals-intersect? [
new (spill-intersecting) f
new start>> spill f
] [ drop t ] if
] [ drop t ] if
] filter-here ;

20
basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
View File

@ -61,23 +61,3 @@ ERROR: splitting-atomic-interval ;
after split-after ;
HINTS: split-interval live-interval object ;
: split-between-blocks ( new n -- before after )
split-interval
2dup [ compute-start/end ] bi@ ;
: insert-use-for-copy ( seq n -- seq' )
[ '[ _ < ] filter ]
[ nip dup 1 + 2array ]
[ 1 + '[ _ > ] filter ]
2tri 3append ;
: split-to-fit ( new n -- before after )
1 -
2dup swap covers? [
[ '[ _ insert-use-for-copy ] change-uses ] keep
split-between-blocks
2dup >>split-next drop
] [
split-between-blocks
] if ;

56
basis/compiler/cfg/linear-scan/linear-scan-tests.factor
View File

@ -1,7 +1,7 @@
IN: compiler.cfg.linear-scan.tests
USING: tools.test random sorting sequences sets hashtables assocs
kernel fry arrays splitting namespaces math accessors vectors locals
math.order grouping strings strings.private
math.order grouping strings strings.private classes
cpu.architecture
compiler.cfg
compiler.cfg.optimizer
@ -153,56 +153,6 @@ check-numbering? on
} 10 split-for-spill [ f >>split-next ] bi@
] unit-test
[
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 0 }
{ end 4 }
{ uses V{ 0 1 4 } }
{ ranges V{ T{ live-range f 0 4 } } }
}
T{ live-interval
{ 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 } }
{ ranges V{ T{ live-range f 0 5 } } }
} 5 split-to-fit [ f >>split-next ] bi@
] unit-test
[
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 0 }
{ end 4 }
{ uses V{ 0 1 4 } }
{ ranges V{ T{ live-range f 0 4 } } }
}
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 5 }
{ end 10 }
{ uses V{ 5 10 } }
{ ranges V{ T{ live-range f 5 10 } } }
}
] [
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
{ start 0 }
{ end 10 }
{ uses V{ 0 1 10 } }
{ ranges V{ T{ live-range f 0 10 } } }
} 5 split-to-fit [ f >>split-next ] bi@
] unit-test
[
T{ live-interval
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
@ -225,7 +175,7 @@ check-numbering? on
{ end 10 }
{ uses V{ 0 1 4 5 10 } }
{ ranges V{ T{ live-range f 0 10 } } }
} 5 split-to-fit [ f >>split-next ] bi@
} 4 split-to-fit [ f >>split-next ] bi@
] unit-test
[
@ -1847,8 +1797,6 @@ test-diamond
[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
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=