Fixing register allocator prspilling
Slava Pestov
parent
b3f30fb807
commit
c0d89b061e
|
|
@ -329,8 +329,7 @@ M: #terminate emit-node
|
|||
stack-frame new
|
||||
swap
|
||||
[ return>> return-size >>return ]
|
||||
[ alien-parameters parameter-sizes drop >>params ] bi
|
||||
dup [ params>> ] [ return>> ] bi + >>size ;
|
||||
[ alien-parameters parameter-sizes drop >>params ] bi ;
|
||||
|
||||
: alien-stack-frame ( params -- )
|
||||
<alien-stack-frame> ##stack-frame ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors namespaces assocs sequences sets fry ;
|
||||
USING: kernel arrays accessors namespaces assocs sequences sets fry ;
|
||||
IN: compiler.cfg
|
||||
|
||||
TUPLE: cfg entry word label ;
|
||||
|
|
@ -19,7 +19,7 @@ successors ;
|
|||
V{ } clone >>instructions
|
||||
V{ } clone >>successors ;
|
||||
|
||||
TUPLE: mr instructions word label ;
|
||||
TUPLE: mr { instructions array } word label spill-counts ;
|
||||
|
||||
: <mr> ( instructions word label -- mr )
|
||||
mr new
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: kernel words sequences quotations namespaces io
|
|||
accessors prettyprint prettyprint.config
|
||||
compiler.tree.builder compiler.tree.optimizer
|
||||
compiler.cfg.builder compiler.cfg.linearization
|
||||
compiler.cfg.stack-frame ;
|
||||
compiler.cfg.stack-frame compiler.cfg.linear-scan ;
|
||||
IN: compiler.cfg.debugger
|
||||
|
||||
GENERIC: test-cfg ( quot -- cfgs )
|
||||
|
|
@ -16,7 +16,7 @@ M: word test-cfg
|
|||
[ build-tree-from-word nip optimize-tree ] keep build-cfg ;
|
||||
|
||||
: test-mr ( quot -- mrs )
|
||||
test-cfg [ build-mr build-stack-frame ] map ;
|
||||
test-cfg [ build-mr ] map ;
|
||||
|
||||
: mr. ( mrs -- )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -19,10 +19,10 @@ INSN: ##inc-r { n integer } ;
|
|||
|
||||
! Subroutine calls
|
||||
TUPLE: stack-frame
|
||||
{ size integer }
|
||||
{ params integer }
|
||||
{ return integer }
|
||||
{ total-size integer } ;
|
||||
{ total-size integer }
|
||||
spill-counts ;
|
||||
|
||||
INSN: ##stack-frame stack-frame ;
|
||||
: ##simple-stack-frame ( -- ) T{ stack-frame } ##stack-frame ;
|
||||
|
|
@ -125,8 +125,8 @@ M: _cond-branch uses-vregs src>> 1array ;
|
|||
M: _if-intrinsic defs-vregs intrinsic-defs-vregs ;
|
||||
M: _if-intrinsic uses-vregs intrinsic-uses-vregs ;
|
||||
|
||||
INSN: _spill-integer { src vreg } n ;
|
||||
INSN: _reload-integer { dst vreg } n ;
|
||||
|
||||
INSN: _spill-float { src vreg } n ;
|
||||
INSN: _reload-float { dst vreg } n ;
|
||||
! These instructions operate on machine registers and not
|
||||
! virtual registers
|
||||
INSN: _spill src class n ;
|
||||
INSN: _reload dst class n ;
|
||||
INSN: _spill-counts counts ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 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
|
||||
accessors vectors fry heaps cpu.architecture combinators
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.linear-scan.live-intervals ;
|
||||
IN: compiler.cfg.linear-scan.allocation
|
||||
|
|
@ -24,25 +24,11 @@ SYMBOL: active-intervals
|
|||
: delete-active ( live-interval -- )
|
||||
active-intervals get delete ;
|
||||
|
||||
: expired-interval? ( n interval -- ? )
|
||||
[ end>> ] [ start>> ] bi or > ;
|
||||
|
||||
: expire-old-intervals ( n -- )
|
||||
active-intervals get
|
||||
[ expired-interval? ] with partition
|
||||
[ end>> > ] with partition
|
||||
[ [ deallocate-register ] each ] [ active-intervals set ] bi* ;
|
||||
|
||||
: expire-old-uses ( n -- )
|
||||
active-intervals get
|
||||
swap '[
|
||||
uses>> [
|
||||
dup peek _ < [ pop* ] [ drop ] if
|
||||
] unless-empty
|
||||
] each ;
|
||||
|
||||
: update-state ( live-interval -- )
|
||||
start>> [ expire-old-intervals ] [ expire-old-uses ] bi ;
|
||||
|
||||
! Minheap of live intervals which still need a register allocation
|
||||
SYMBOL: unhandled-intervals
|
||||
|
||||
|
|
@ -64,8 +50,25 @@ SYMBOL: progress
|
|||
[ [ start>> ] keep ] { } map>assoc
|
||||
unhandled-intervals get heap-push-all ;
|
||||
|
||||
: assign-free-register ( live-interval registers -- )
|
||||
pop >>reg add-active ;
|
||||
! Splitting
|
||||
: find-use ( live-interval n quot -- i elt )
|
||||
[ uses>> ] 2dip curry find ; inline
|
||||
|
||||
: split-before ( live-interval i -- before )
|
||||
[ clone dup uses>> ] dip
|
||||
[ head >>uses ] [ 1- swap nth >>end ] 2bi ;
|
||||
|
||||
: split-after ( live-interval i -- after )
|
||||
[ clone dup uses>> ] dip
|
||||
[ tail >>uses ] [ swap nth >>start ] 2bi
|
||||
f >>reg ;
|
||||
|
||||
: split-interval ( live-interval n -- before after )
|
||||
[ drop ] [ [ > ] find-use drop ] 2bi
|
||||
[ split-before ] [ split-after ] 2bi ;
|
||||
|
||||
: record-split ( live-interval before after -- )
|
||||
[ >>split-before ] [ >>split-after ] bi* drop ;
|
||||
|
||||
! Spilling
|
||||
SYMBOL: spill-counts
|
||||
|
|
@ -73,37 +76,20 @@ SYMBOL: spill-counts
|
|||
: next-spill-location ( reg-class -- n )
|
||||
spill-counts get [ dup 1+ ] change-at ;
|
||||
|
||||
: interval-to-spill ( -- live-interval )
|
||||
: interval-to-spill ( active-intervals current -- live-interval )
|
||||
#! We spill the interval with the most distant use location.
|
||||
active-intervals get
|
||||
[ uses>> empty? not ] filter
|
||||
unclip-slice [
|
||||
[ [ uses>> peek ] bi@ > ] most
|
||||
] reduce ;
|
||||
|
||||
: check-split ( live-interval -- )
|
||||
[ start>> ] [ end>> ] bi = [ "Cannot split any further" throw ] when ;
|
||||
|
||||
: split-interval ( live-interval -- before after )
|
||||
#! Split the live interval at the location of its first use.
|
||||
#! 'Before' now starts and ends on the same instruction.
|
||||
[ check-split ]
|
||||
[ clone [ uses>> delete-all ] [ dup start>> >>end ] bi ]
|
||||
[ clone f >>reg dup uses>> peek >>start ]
|
||||
tri ;
|
||||
|
||||
: record-split ( live-interval before after -- )
|
||||
[ >>split-before ] [ >>split-after ] bi* drop ;
|
||||
start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc
|
||||
unclip-slice [ [ [ second ] bi@ > ] most ] reduce first ;
|
||||
|
||||
: assign-spill ( before after -- before after )
|
||||
#! If it has been spilled already, reuse spill location.
|
||||
USE: cpu.architecture ! XXX
|
||||
over reload-from>>
|
||||
[ int-regs next-spill-location ] unless*
|
||||
[ over vreg>> reg-class>> next-spill-location ] unless*
|
||||
tuck [ >>spill-to ] [ >>reload-from ] 2bi* ;
|
||||
|
||||
: split-and-spill ( live-interval -- before after )
|
||||
dup split-interval [ record-split ] [ assign-spill ] 2bi ;
|
||||
: split-and-spill ( new existing -- before after )
|
||||
dup rot start>> split-interval
|
||||
[ record-split ] [ assign-spill ] 2bi ;
|
||||
|
||||
: reuse-register ( new existing -- )
|
||||
reg>> >>reg add-active ;
|
||||
|
|
@ -114,30 +100,30 @@ SYMBOL: spill-counts
|
|||
#! interval, then process the new interval and the tail end
|
||||
#! of the existing interval again.
|
||||
[ reuse-register ]
|
||||
[ delete-active ]
|
||||
[ split-and-spill [ drop ] [ add-unhandled ] bi* ] tri ;
|
||||
[ nip delete-active ]
|
||||
[ split-and-spill [ drop ] [ add-unhandled ] bi* ] 2tri ;
|
||||
|
||||
: spill-new ( new existing -- )
|
||||
#! Our new interval will be used after the active interval
|
||||
#! with the most distant use location. Split the new
|
||||
#! interval, then process both parts of the new interval
|
||||
#! again.
|
||||
[ split-and-spill add-unhandled ] dip spill-existing ;
|
||||
[ dup split-and-spill add-unhandled ] dip spill-existing ;
|
||||
|
||||
: spill-existing? ( new existing -- ? )
|
||||
over uses>> empty? [ 2drop t ] [ [ uses>> peek ] bi@ < ] if ;
|
||||
#! Test if 'new' will be used before 'existing'.
|
||||
over start>> '[ _ [ > ] find-use nip -1 or ] bi@ < ;
|
||||
|
||||
: assign-blocked-register ( live-interval -- )
|
||||
interval-to-spill
|
||||
2dup spill-existing?
|
||||
[ spill-existing ] [ spill-new ] if ;
|
||||
: assign-blocked-register ( new -- )
|
||||
[ active-intervals get ] keep interval-to-spill
|
||||
2dup spill-existing? [ spill-existing ] [ spill-new ] if ;
|
||||
|
||||
: assign-register ( live-interval -- )
|
||||
dup vreg>> free-registers-for [
|
||||
assign-blocked-register
|
||||
] [
|
||||
assign-free-register
|
||||
] if-empty ;
|
||||
: assign-free-register ( new registers -- )
|
||||
pop >>reg add-active ;
|
||||
|
||||
: assign-register ( new -- )
|
||||
dup vreg>> free-registers-for
|
||||
[ assign-blocked-register ] [ assign-free-register ] if-empty ;
|
||||
|
||||
! Main loop
|
||||
: init-allocator ( registers -- )
|
||||
|
|
@ -148,7 +134,10 @@ SYMBOL: spill-counts
|
|||
-1 progress set ;
|
||||
|
||||
: handle-interval ( live-interval -- )
|
||||
[ start>> progress set ] [ update-state ] [ assign-register ] tri ;
|
||||
[ start>> progress set ]
|
||||
[ start>> expire-old-intervals ]
|
||||
[ assign-register ]
|
||||
tri ;
|
||||
|
||||
: (allocate-registers) ( -- )
|
||||
unhandled-intervals get [ handle-interval ] slurp-heap ;
|
||||
|
|
|
|||
|
|
@ -35,13 +35,8 @@ SYMBOL: unhandled-intervals
|
|||
[ add-unhandled ] each ;
|
||||
|
||||
: insert-spill ( live-interval -- )
|
||||
[ reg>> ] [ spill-to>> ] [ vreg>> reg-class>> ] tri
|
||||
over [
|
||||
{
|
||||
{ int-regs [ _spill-integer ] }
|
||||
{ double-float-regs [ _spill-float ] }
|
||||
} case
|
||||
] [ 3drop ] if ;
|
||||
[ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri
|
||||
dup [ _spill ] [ 3drop ] if ;
|
||||
|
||||
: expire-old-intervals ( n -- )
|
||||
active-intervals get
|
||||
|
|
@ -50,13 +45,8 @@ SYMBOL: unhandled-intervals
|
|||
[ insert-spill ] each ;
|
||||
|
||||
: insert-reload ( live-interval -- )
|
||||
[ reg>> ] [ reload-from>> ] [ vreg>> reg-class>> ] tri
|
||||
over [
|
||||
{
|
||||
{ int-regs [ _reload-integer ] }
|
||||
{ double-float-regs [ _reload-float ] }
|
||||
} case
|
||||
] [ 3drop ] if ;
|
||||
[ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri
|
||||
dup [ _reload ] [ 3drop ] if ;
|
||||
|
||||
: activate-new-intervals ( n -- )
|
||||
#! Any live intervals which start on the current instruction
|
||||
|
|
|
|||
|
|
@ -7,49 +7,209 @@ compiler.cfg.instructions
|
|||
compiler.cfg.registers
|
||||
compiler.cfg.linear-scan
|
||||
compiler.cfg.linear-scan.live-intervals
|
||||
compiler.cfg.linear-scan.allocation
|
||||
compiler.cfg.linear-scan.debugger ;
|
||||
|
||||
[ 7 ] [
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 2 } } }
|
||||
{ start 0 }
|
||||
{ end 10 }
|
||||
{ uses V{ 0 1 3 7 10 } }
|
||||
}
|
||||
4 [ >= ] find-use nip
|
||||
] unit-test
|
||||
|
||||
[ 4 ] [
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 2 } } }
|
||||
{ start 0 }
|
||||
{ end 10 }
|
||||
{ uses V{ 0 1 3 4 10 } }
|
||||
}
|
||||
4 [ >= ] find-use nip
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 2 } } }
|
||||
{ start 0 }
|
||||
{ end 10 }
|
||||
{ uses V{ 0 1 3 4 10 } }
|
||||
}
|
||||
100 [ >= ] find-use nip
|
||||
] unit-test
|
||||
|
||||
[
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 0 }
|
||||
{ end 1 }
|
||||
{ uses V{ 0 1 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 5 }
|
||||
{ end 5 }
|
||||
{ uses V{ 5 } }
|
||||
}
|
||||
] [
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 0 }
|
||||
{ end 5 }
|
||||
{ uses V{ 0 1 5 } }
|
||||
} 2 split-interval
|
||||
] unit-test
|
||||
|
||||
[
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 0 }
|
||||
{ end 0 }
|
||||
{ uses V{ 0 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 1 }
|
||||
{ end 5 }
|
||||
{ uses V{ 1 5 } }
|
||||
}
|
||||
] [
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 0 }
|
||||
{ end 5 }
|
||||
{ uses V{ 0 1 5 } }
|
||||
} 0 split-interval
|
||||
] unit-test
|
||||
|
||||
[
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 3 }
|
||||
{ end 10 }
|
||||
{ uses V{ 3 10 } }
|
||||
}
|
||||
] [
|
||||
{
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 1 }
|
||||
{ end 15 }
|
||||
{ uses V{ 1 3 7 10 15 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 3 }
|
||||
{ end 8 }
|
||||
{ uses V{ 3 4 8 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 3 }
|
||||
{ end 10 }
|
||||
{ uses V{ 3 10 } }
|
||||
}
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 5 }
|
||||
{ end 5 }
|
||||
{ uses V{ 5 } }
|
||||
}
|
||||
interval-to-spill
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 5 }
|
||||
{ end 15 }
|
||||
{ uses V{ 5 10 15 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 1 }
|
||||
{ end 20 }
|
||||
{ uses V{ 1 20 } }
|
||||
}
|
||||
spill-existing?
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 5 }
|
||||
{ end 15 }
|
||||
{ uses V{ 5 10 15 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 1 }
|
||||
{ end 20 }
|
||||
{ uses V{ 1 7 20 } }
|
||||
}
|
||||
spill-existing?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 5 }
|
||||
{ end 5 }
|
||||
{ uses V{ 5 } }
|
||||
}
|
||||
T{ live-interval
|
||||
{ vreg T{ vreg { reg-class int-regs } { n 1 } } }
|
||||
{ start 1 }
|
||||
{ end 20 }
|
||||
{ uses V{ 1 7 20 } }
|
||||
}
|
||||
spill-existing?
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
{
|
||||
T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
|
||||
T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
|
||||
}
|
||||
H{ { f { "A" } } }
|
||||
H{ { int-regs { "A" } } }
|
||||
check-linear-scan
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
{
|
||||
T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 10 } { uses V{ 10 } } }
|
||||
T{ live-interval { vreg T{ vreg { n 2 } } } { start 11 } { end 20 } { uses V{ 20 } } }
|
||||
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 } } }
|
||||
}
|
||||
H{ { f { "A" } } }
|
||||
H{ { int-regs { "A" } } }
|
||||
check-linear-scan
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
{
|
||||
T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
|
||||
T{ live-interval { vreg T{ vreg { n 2 } } } { start 30 } { end 60 } { uses V{ 60 } } }
|
||||
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 } } }
|
||||
}
|
||||
H{ { f { "A" } } }
|
||||
H{ { int-regs { "A" } } }
|
||||
check-linear-scan
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
{
|
||||
T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
|
||||
T{ live-interval { vreg T{ vreg { n 2 } } } { start 30 } { end 200 } { uses V{ 200 } } }
|
||||
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 } } }
|
||||
}
|
||||
H{ { f { "A" } } }
|
||||
H{ { int-regs { "A" } } }
|
||||
check-linear-scan
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
|
||||
T{ live-interval { vreg T{ vreg { n 2 } } } { start 30 } { end 100 } { uses V{ 100 } } }
|
||||
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 } } }
|
||||
}
|
||||
H{ { f { "A" } } }
|
||||
H{ { int-regs { "A" } } }
|
||||
check-linear-scan
|
||||
] must-fail
|
||||
|
||||
|
|
@ -81,15 +241,15 @@ SYMBOL: max-uses
|
|||
max-insns get [ dup ] H{ } map>assoc available set
|
||||
[
|
||||
live-interval new
|
||||
swap f swap vreg boa >>vreg
|
||||
swap int-regs swap vreg boa >>vreg
|
||||
max-uses get random 2 max [ not-taken ] replicate natural-sort
|
||||
unclip [ >vector >>uses ] [ >>start ] bi*
|
||||
dup uses>> first >>end
|
||||
[ >>uses ] [ first >>start ] bi
|
||||
dup uses>> peek >>end
|
||||
] map
|
||||
] with-scope ;
|
||||
|
||||
: random-test ( num-intervals max-uses max-registers max-insns -- )
|
||||
over >r random-live-intervals r> f associate check-linear-scan ;
|
||||
over >r random-live-intervals r> int-regs associate check-linear-scan ;
|
||||
|
||||
[ ] [ 30 2 1 60 random-test ] unit-test
|
||||
[ ] [ 60 2 2 60 random-test ] unit-test
|
||||
|
|
@ -118,3 +278,29 @@ USING: math.private compiler.cfg.debugger ;
|
|||
} clone
|
||||
1array (linear-scan) first regs>> values all-equal?
|
||||
] 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
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors namespaces
|
||||
USING: kernel accessors namespaces make
|
||||
cpu.architecture
|
||||
compiler.cfg
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.linear-scan.live-intervals
|
||||
compiler.cfg.linear-scan.allocation
|
||||
compiler.cfg.linear-scan.assignment ;
|
||||
|
|
@ -28,6 +29,10 @@ IN: compiler.cfg.linear-scan
|
|||
|
||||
: linear-scan ( mr -- mr' )
|
||||
[
|
||||
[ (linear-scan) ] change-instructions
|
||||
! spill-counts get >>spill-counts
|
||||
[
|
||||
[
|
||||
(linear-scan) %
|
||||
spill-counts get _spill-counts
|
||||
] { } make
|
||||
] change-instructions
|
||||
] with-scope ;
|
||||
|
|
|
|||
|
|
@ -4,16 +4,20 @@ USING: namespaces kernel assocs accessors sequences math fry
|
|||
compiler.cfg.instructions compiler.cfg.registers ;
|
||||
IN: compiler.cfg.linear-scan.live-intervals
|
||||
|
||||
TUPLE: live-interval < identity-tuple
|
||||
TUPLE: live-interval
|
||||
vreg
|
||||
reg spill-to reload-from split-before split-after
|
||||
start end uses ;
|
||||
|
||||
: add-use ( n live-interval -- )
|
||||
[ (>>end) ] [ uses>> push ] 2bi ;
|
||||
|
||||
: <live-interval> ( start vreg -- live-interval )
|
||||
live-interval new
|
||||
V{ } clone >>uses
|
||||
swap >>vreg
|
||||
swap >>start
|
||||
V{ } clone >>uses ;
|
||||
over >>start
|
||||
[ add-use ] keep ;
|
||||
|
||||
M: live-interval hashcode*
|
||||
nip [ start>> ] [ end>> 1000 * ] bi + ;
|
||||
|
|
@ -24,25 +28,18 @@ M: live-interval clone
|
|||
! Mapping from vreg to live-interval
|
||||
SYMBOL: live-intervals
|
||||
|
||||
: add-use ( n vreg live-intervals -- )
|
||||
at [ (>>end) ] [ uses>> push ] 2bi ;
|
||||
|
||||
: new-live-interval ( n vreg live-intervals -- )
|
||||
2dup key? [ "Multiple defs" throw ] when
|
||||
[ [ <live-interval> ] keep ] dip set-at ;
|
||||
|
||||
: compute-live-intervals* ( insn n -- )
|
||||
live-intervals get
|
||||
[ [ uses-vregs ] 2dip '[ _ swap _ add-use ] each ]
|
||||
[ [ uses-vregs ] 2dip '[ _ swap _ at add-use ] each ]
|
||||
[ [ defs-vregs ] 2dip '[ _ swap _ new-live-interval ] each ]
|
||||
3bi ;
|
||||
|
||||
: finalize-live-intervals ( assoc -- seq' )
|
||||
#! Reverse uses lists so that we can pop values off.
|
||||
values dup [ uses>> reverse-here ] each ;
|
||||
|
||||
: compute-live-intervals ( instructions -- live-intervals )
|
||||
H{ } clone [
|
||||
live-intervals set
|
||||
[ compute-live-intervals* ] each-index
|
||||
] keep finalize-live-intervals ;
|
||||
] keep values ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces accessors math.order assocs kernel sequences
|
||||
combinators make compiler.cfg.instructions
|
||||
combinators make cpu.architecture compiler.cfg.instructions
|
||||
compiler.cfg.instructions.syntax compiler.cfg.registers ;
|
||||
IN: compiler.cfg.stack-frame
|
||||
|
||||
|
|
@ -9,35 +9,31 @@ SYMBOL: frame-required?
|
|||
|
||||
SYMBOL: spill-counts
|
||||
|
||||
: init-stack-frame-builder ( -- )
|
||||
frame-required? off
|
||||
T{ stack-frame } clone stack-frame set ;
|
||||
|
||||
GENERIC: compute-stack-frame* ( insn -- )
|
||||
|
||||
: max-stack-frame ( frame1 frame2 -- frame3 )
|
||||
{
|
||||
[ [ size>> ] bi@ max ]
|
||||
[ [ params>> ] bi@ max ]
|
||||
[ [ return>> ] bi@ max ]
|
||||
[ [ total-size>> ] bi@ max ]
|
||||
} 2cleave
|
||||
stack-frame boa ;
|
||||
[ stack-frame new ] 2dip
|
||||
[ [ params>> ] bi@ max >>params ]
|
||||
[ [ return>> ] bi@ max >>return ]
|
||||
2bi ;
|
||||
|
||||
M: ##stack-frame compute-stack-frame*
|
||||
frame-required? on
|
||||
stack-frame>> stack-frame [ max-stack-frame ] change ;
|
||||
|
||||
M: _spill-integer compute-stack-frame*
|
||||
M: _spill compute-stack-frame*
|
||||
drop frame-required? on ;
|
||||
|
||||
M: _spill-float compute-stack-frame*
|
||||
drop frame-required? on ;
|
||||
M: _spill-counts compute-stack-frame*
|
||||
counts>> stack-frame get (>>spill-counts) ;
|
||||
|
||||
M: insn compute-stack-frame* drop ;
|
||||
|
||||
: compute-stack-frame ( insns -- )
|
||||
[ compute-stack-frame* ] each ;
|
||||
frame-required? off
|
||||
T{ stack-frame } clone stack-frame set
|
||||
[ compute-stack-frame* ] each
|
||||
stack-frame get dup stack-frame-size >>total-size drop ;
|
||||
|
||||
GENERIC: insert-pro/epilogues* ( insn -- )
|
||||
|
||||
|
|
@ -56,7 +52,6 @@ M: insn insert-pro/epilogues* , ;
|
|||
|
||||
: build-stack-frame ( mr -- mr )
|
||||
[
|
||||
init-stack-frame-builder
|
||||
[
|
||||
[ compute-stack-frame ]
|
||||
[ insert-pro/epilogues ]
|
||||
|
|
|
|||
|
|
@ -0,0 +1,23 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: compiler.cfg.value-numbering.expressions
|
||||
|
||||
! Referentially-transparent expressions.
|
||||
|
||||
TUPLE: expr op ;
|
||||
|
||||
! op is always %peek
|
||||
TUPLE: peek-expr < expr loc ;
|
||||
TUPLE: unary-expr < expr in ;
|
||||
TUPLE: load-literal-expr < expr obj ;
|
||||
|
||||
GENERIC: >expr ( insn -- expr )
|
||||
|
||||
M: ##peek >expr
|
||||
[ class ] [ loc>> ] bi peek-expr boa ;
|
||||
|
||||
M: ##load-literal >expr
|
||||
[ class ] [ obj>> ] bi load-literal-expr boa ;
|
||||
|
||||
M: ##unary >expr
|
||||
[ class ] [ src>> vreg>vn ] bi unary-expr boa ;
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: compiler.cfg.value-numbering.graph
|
||||
|
||||
SYMBOL: vn-counter
|
||||
|
||||
: next-vn ( -- vn ) vn-counter [ dup 1 + ] change ;
|
||||
|
||||
! biassoc mapping expressions to value numbers
|
||||
SYMBOL: exprs>vns
|
||||
|
||||
: expr>vn ( expr -- vn ) exprs>vns get [ drop next-vn ] cache ;
|
||||
|
||||
: vn>expr ( vn -- expr ) exprs>vns get value-at ;
|
||||
|
||||
! biassoc mapping vregs to value numbers
|
||||
SYMBOL: vregs>vns
|
||||
|
||||
: vreg>vn ( vreg -- vn ) vregs>vns get at ;
|
||||
|
||||
: vn>vreg ( vn -- vreg ) vregs>vns get value-at ;
|
||||
|
||||
: set-vn ( vn vreg -- ) vregs>vns get set-at ;
|
||||
|
||||
: init-value-graph ( -- )
|
||||
0 vn-counter set
|
||||
<bihash> exprs>vns set
|
||||
<bihash> vregs>vns set ;
|
||||
|
||||
: reset-value-graph ( -- )
|
||||
exprs>vns get clear-assoc
|
||||
vregs>vns get clear-assoc ;
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: compiler.cfg.value-numbering.liveness
|
||||
|
||||
! A set of VNs which are (transitively) used by side-effecting
|
||||
! instructions.
|
||||
SYMBOL: live-vns
|
||||
|
||||
GENERIC: live-expr ( expr -- )
|
||||
|
||||
: live-vn ( vn -- )
|
||||
#! Mark a VN and all VNs used in its computation as live.
|
||||
dup live-vns get key? [ drop ] [
|
||||
[ live-vns get conjoin ] [ vn>expr live-expr ] bi
|
||||
] if ;
|
||||
|
||||
M: peek-expr live-expr drop ;
|
||||
M: unary-expr live-expr in>> live-vn ;
|
||||
M: load-literal-expr live-expr in>> live-vn ;
|
||||
|
||||
: live-vreg ( vreg -- ) vreg>vn live-vn ;
|
||||
|
||||
: live? ( vreg -- ? )
|
||||
dup vreg>vn tuck vn>vreg =
|
||||
[ live-vns get key? ] [ drop f ] if ;
|
||||
|
||||
: init-liveness ( -- )
|
||||
H{ } clone live-vns set ;
|
||||
|
||||
GENERIC: eliminate ( insn -- insn/f )
|
||||
|
||||
: (eliminate) ( insn -- insn/f )
|
||||
dup dst>> >vreg live? [ drop f ] unless ;
|
||||
|
||||
M: ##peek eliminate (eliminate) ;
|
||||
M: ##unary eliminate (eliminate) ;
|
||||
M: ##load-literal eliminate (eliminate) ;
|
||||
M: insn eliminate ;
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: compiler.cfg.value-numbering.propagate
|
||||
|
||||
! If two vregs compute the same value, replace references to
|
||||
! the latter with the former.
|
||||
|
||||
: resolve ( vreg -- vreg' ) vreg>vn vn>vreg ;
|
||||
|
||||
GENERIC: propogate ( insn -- insn )
|
||||
|
||||
M: ##cond-branch propagate [ resolve ] change-src ;
|
||||
|
||||
M: ##unary propogate [ resolve ] change-src ;
|
||||
|
||||
M: ##nullary propagate ;
|
||||
|
||||
M: ##replace propagate [ resolve ] change-src ;
|
||||
|
||||
M: ##inc-d propagate ;
|
||||
|
||||
M: ##inc-r propagate ;
|
||||
|
||||
M: ##stack-frame propagate ;
|
||||
|
||||
M: ##call propagate ;
|
||||
|
||||
M: ##jump propagate ;
|
||||
|
||||
M: ##return propagate ;
|
||||
|
||||
M: ##intrinsic propagate
|
||||
[ [ resolve ] assoc-map ] change-defs-vregs
|
||||
[ [ resolve ] assoc-map ] change-uses-vregs ;
|
||||
|
||||
M: ##dispatch propagate [ resolve ] change-src ;
|
||||
|
||||
M: ##dispatch-label propagate ;
|
||||
|
||||
M: ##write-barrier propagate [ resolve ] change-src ;
|
||||
|
||||
M: ##alien-invoke propagate ;
|
||||
|
||||
M: ##alien-indirect propagate ;
|
||||
|
||||
M: ##alien-callback propagate ;
|
||||
|
||||
M: ##callback-return propagate ;
|
||||
|
||||
M: ##prologue propagate ;
|
||||
|
||||
M: ##epilogue propagate ;
|
||||
|
||||
M: ##branch propagate ;
|
||||
|
||||
M: ##if-intrinsic propagate
|
||||
[ [ resolve ] assoc-map ] change-defs-vregs
|
||||
[ [ resolve ] assoc-map ] change-uses-vregs ;
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: compiler.cfg.value-numbering
|
||||
|
||||
: insn>vn ( insn -- vn ) >expr simplify ; inline
|
||||
|
||||
GENERIC: make-value-node ( insn -- )
|
||||
|
||||
M: ##cond-branch make-value-node src>> live-vreg ;
|
||||
M: ##unary make-value-node [ insn>vn ] [ dst>> ] bi set-vn ;
|
||||
M: ##nullary make-value-node drop ;
|
||||
M: ##load-literal make-value-node [ insn>vn ] [ dst>> ] bi set-vn ;
|
||||
M: ##peek make-value-node [ insn>vn ] [ dst>> ] bi set-vn ;
|
||||
M: ##replace make-value-node reset-value-graph ;
|
||||
M: ##inc-d make-value-node reset-value-graph ;
|
||||
M: ##inc-r make-value-node reset-value-graph ;
|
||||
M: ##stack-frame make-value-node reset-value-graph ;
|
||||
M: ##call make-value-node reset-value-graph ;
|
||||
M: ##jump make-value-node reset-value-graph ;
|
||||
M: ##return make-value-node reset-value-graph ;
|
||||
M: ##intrinsic make-value-node uses-vregs [ live-vreg ] each ;
|
||||
M: ##dispatch make-value-node reset-value-graph ;
|
||||
M: ##dispatch-label make-value-node reset-value-graph ;
|
||||
M: ##allot make-value-node drop ;
|
||||
M: ##write-barrier make-value-node drop ;
|
||||
M: ##gc make-value-node reset-value-graph ;
|
||||
M: ##replace make-value-node reset-value-graph ;
|
||||
M: ##alien-invoke make-value-node reset-value-graph ;
|
||||
M: ##alien-indirect make-value-node reset-value-graph ;
|
||||
M: ##alien-callback make-value-node reset-value-graph ;
|
||||
M: ##callback-return make-value-node reset-value-graph ;
|
||||
M: ##prologue make-value-node reset-value-graph ;
|
||||
M: ##epilogue make-value-node reset-value-graph ;
|
||||
M: ##branch make-value-node reset-value-graph ;
|
||||
M: ##if-intrinsic make-value-node uses-vregs [ live-vreg ] each ;
|
||||
|
||||
: init-value-numbering ( -- )
|
||||
init-value-graph
|
||||
init-expressions
|
||||
init-liveness ;
|
||||
|
||||
: value-numbering ( instructions -- instructions )
|
||||
init-value-numbering
|
||||
[ [ make-value-node ] [ propagate ] bi ] map
|
||||
[ eliminate ] map
|
||||
sift ;
|
||||
|
|
@ -72,11 +72,7 @@ M: _label generate-insn
|
|||
id>> lookup-label , ;
|
||||
|
||||
M: _prologue generate-insn
|
||||
stack-frame>>
|
||||
[ stack-frame set ]
|
||||
[ dup size>> stack-frame-size >>total-size drop ]
|
||||
[ total-size>> %prologue ]
|
||||
tri ;
|
||||
stack-frame>> [ stack-frame set ] [ total-size>> %prologue ] bi ;
|
||||
|
||||
M: _epilogue generate-insn
|
||||
stack-frame>> total-size>> %epilogue ;
|
||||
|
|
@ -439,3 +435,17 @@ M: ##alien-callback generate-insn
|
|||
[ wrap-callback-quot %alien-callback ]
|
||||
[ alien-return [ %unnest-stacks ] [ %callback-value ] if-void ]
|
||||
tri ;
|
||||
|
||||
M: _spill generate-insn
|
||||
[ src>> ] [ n>> ] [ class>> ] tri {
|
||||
{ int-regs [ %spill-integer ] }
|
||||
{ double-float-regs [ %spill-float ] }
|
||||
} case ;
|
||||
|
||||
M: _reload generate-insn
|
||||
[ dst>> ] [ n>> ] [ class>> ] tri {
|
||||
{ int-regs [ %reload-integer ] }
|
||||
{ double-float-regs [ %reload-float ] }
|
||||
} case ;
|
||||
|
||||
M: _spill-counts generate-insn drop ;
|
||||
|
|
|
|||
|
|
@ -61,18 +61,6 @@ SYMBOL: +failed+
|
|||
: frontend ( word -- effect nodes )
|
||||
[ build-tree-from-word ] [ fail ] recover optimize-tree ;
|
||||
|
||||
: finish ( effect word -- )
|
||||
[ swap save-effect ]
|
||||
[ compiled-unxref ]
|
||||
[
|
||||
dup crossref?
|
||||
[
|
||||
dependencies get >alist
|
||||
generic-dependencies get >alist
|
||||
compiled-xref
|
||||
] [ drop ] if
|
||||
] tri ;
|
||||
|
||||
! Only switch this off for debugging.
|
||||
SYMBOL: compile-dependencies?
|
||||
|
||||
|
|
@ -92,6 +80,18 @@ t compile-dependencies? set-global
|
|||
save-asm
|
||||
] each ;
|
||||
|
||||
: finish ( effect word -- )
|
||||
[ swap save-effect ]
|
||||
[ compiled-unxref ]
|
||||
[
|
||||
dup crossref?
|
||||
[
|
||||
dependencies get >alist
|
||||
generic-dependencies get >alist
|
||||
compiled-xref
|
||||
] [ drop ] if
|
||||
] tri ;
|
||||
|
||||
: (compile) ( word -- )
|
||||
'[
|
||||
_ {
|
||||
|
|
|
|||
Loading…
Reference in New Issue