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

Inserting spills and reloads

db4
Slava Pestov 2008-09-15 02:59:24 -05:00
parent 89ce8e1f3e
commit f7cb6e3051
8 changed files with 139 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
unfinished/compiler/cfg/instructions/instructions.factor
View File

@ -6,15 +6,16 @@ IN: compiler.cfg.instructions
! Virtual CPU instructions, used by CFG and machine IRs
INSN: %cond-branch vreg ;
INSN: %cond-branch src ;
INSN: %unary dst src ;
INSN: %nullary dst ;
! Stack operations
INSN: %peek vreg loc ;
INSN: %replace vreg loc ;
INSN: %load-literal < %nullary obj ;
INSN: %peek < %nullary loc ;
INSN: %replace src loc ;
INSN: %inc-d n ;
INSN: %inc-r n ;
INSN: %load-literal obj vreg ;
! Calling convention
INSN: %return ;
@ -22,7 +23,7 @@ INSN: %return ;
! Subroutine calls
INSN: %call word ;
INSN: %jump word ;
INSN: %intrinsic quot vregs ;
INSN: %intrinsic quot regs ;
! Jump tables
INSN: %dispatch-label label ;
@ -49,17 +50,13 @@ INSN: %alien-callback params ;
GENERIC: defs-vregs ( insn -- seq )
GENERIC: uses-vregs ( insn -- seq )
M: insn defs-vregs drop f ;
M: insn uses-vregs drop f ;
M: %peek defs-vregs vreg>> 1array ;
M: %replace uses-vregs vreg>> 1array ;
M: %load-literal defs-vregs vreg>> 1array ;
M: %nullary defs-vregs dst>> 1array ;
M: %unary defs-vregs dst>> 1array ;
M: insn defs-vregs drop f ;
M: %replace uses-vregs src>> 1array ;
M: %unary uses-vregs src>> 1array ;
M: insn uses-vregs drop f ;
! M: %intrinsic uses-vregs vregs>> values ;
@ -72,9 +69,9 @@ INSN: %branch ;
INSN: %branch-f < %cond-branch ;
INSN: %branch-t < %cond-branch ;
INSN: %if-intrinsic quot vregs ;
INSN: %boolean-intrinsic quot vregs out ;
INSN: %boolean-intrinsic quot vregs dst ;
M: %cond-branch uses-vregs vreg>> 1array ;
M: %cond-branch uses-vregs src>> 1array ;
! M: %if-intrinsic uses-vregs vregs>> values ;
@ -97,12 +94,15 @@ INSN: _label label ;
: resolve-label ( label/name -- )
dup label? [ get ] unless _label ;
TUPLE: _cond-branch vreg label ;
TUPLE: _cond-branch src label ;
INSN: _branch label ;
INSN: _branch-f < _cond-branch ;
INSN: _branch-t < _cond-branch ;
INSN: _if-intrinsic label quot vregs ;
M: _cond-branch uses-vregs vreg>> 1array ;
M: _cond-branch uses-vregs src>> 1array ;
! M: _if-intrinsic uses-vregs vregs>> values ;
INSN: _spill src n ;
INSN: _reload dst n ;

39
unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
View File

@ -6,15 +6,6 @@ compiler.cfg.linear-scan.live-intervals
compiler.backend ;
IN: compiler.cfg.linear-scan.allocation
! Vector of live intervals we have already processed
SYMBOL: retired-intervals
: retire-interval ( live-interval -- )
retired-intervals get push ;
: retire-intervals ( live-intervals -- )
retired-intervals get push-all ;
! Mapping from register classes to sequences of machine registers
SYMBOL: free-registers
@ -37,7 +28,7 @@ SYMBOL: active-intervals
active-intervals get
swap '[ end>> _ < ] partition
active-intervals set
[ [ retire-interval ] [ deallocate-register ] bi ] each ;
[ deallocate-register ] each ;
: expire-old-uses ( n -- )
active-intervals get
@ -112,9 +103,7 @@ SYMBOL: spill-counter
: reuse-register ( new existing -- )
reg>> >>reg
dup uses>> empty? [
[ retire-interval ] [ deallocate-register ] bi
] [ add-active ] if ;
dup uses>> empty? [ deallocate-register ] [ add-active ] if ;
: spill-existing ( new existing -- )
#! Our new interval will be used before the active interval
@ -123,12 +112,7 @@ SYMBOL: spill-counter
#! of the existing interval again.
[ reuse-register ]
[ delete-active ]
[
split-and-spill
[ retire-interval ]
[ add-unhandled ]
bi*
] tri ;
[ split-and-spill [ drop ] [ add-unhandled ] bi* ] tri ;
: spill-new ( new existing -- )
#! Our new interval will be used after the active interval
@ -153,13 +137,7 @@ SYMBOL: spill-counter
] if-empty ;
! Main loop
: slurp-heap ( heap quot: ( elt -- ) -- )
over heap-empty? [ 2drop ] [
[ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi
] if ; inline recursive
: init-allocator ( registers -- )
V{ } clone retired-intervals set
V{ } clone active-intervals set
<min-heap> unhandled-intervals set
[ >vector ] assoc-map free-registers set
@ -172,17 +150,10 @@ SYMBOL: spill-counter
: (allocate-registers) ( -- )
unhandled-intervals get [ handle-interval ] slurp-heap ;
: finish-allocator ( -- live-intervals )
#! After register allocation is done, we retire all
#! live intervals which are still active.
active-intervals get retire-intervals
retired-intervals get ;
: allocate-registers ( live-intervals machine-registers -- live-intervals' )
#! This destroys the input live-intervals.
: allocate-registers ( live-intervals machine-registers -- )
#! This modifies the input live-intervals.
[
init-allocator
init-unhandled
(allocate-registers)
finish-allocator
] with-scope ;

19
unfinished/compiler/cfg/linear-scan/debugger/debugger.factor
View File

@ -11,28 +11,13 @@ IN: compiler.cfg.linear-scan.debugger
[ "Not all intervals have registers" throw ] unless
] each ;
: check-split ( live-intervals -- )
[
split-before>>
[ "Split intervals returned" throw ] when
] each ;
: split-children ( live-interval -- seq )
dup split-before>> [
[ split-before>> ] [ split-after>> ] bi
[ split-children ] bi@
append
] [
1array
] if ;
: check-retired ( original live-intervals -- )
#! All original live intervals should have either been
#! split, or ended up in the output set.
[ [ split-children ] map concat ] dip
2dup subset? [ "We lost some intervals" throw ] unless
swap subset? [ "We didn't record all splits" throw ] unless ;
] [ 1array ] if ;
: check-linear-scan ( live-intervals machine-registers -- )
[ [ clone ] map dup ] dip allocate-registers
[ check-assigned ] [ check-split ] [ check-retired ] tri ;
[ split-children ] map concat check-assigned ;

12
unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
View File

@ -37,13 +37,11 @@ SYMBOL: live-intervals
[ [ defs-vregs ] 2dip '[ _ swap >vreg _ new-live-interval ] each ]
3bi ;
: finalize-live-intervals ( assoc -- seq' )
: finalize-live-intervals ( -- )
#! Reverse uses lists so that we can pop values off.
values dup [ uses>> reverse-here ] each ;
live-intervals get [ nip uses>> reverse-here ] assoc-each ;
: compute-live-intervals ( instructions -- live-intervals )
H{ } clone [
live-intervals [
: compute-live-intervals ( instructions -- )
H{ } clone live-intervals set
[ compute-live-intervals* ] each-index
] with-variable
] keep finalize-live-intervals ;
finalize-live-intervals ;

4
unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor Normal file
View File

@ -0,0 +1,4 @@
USING: compiler.cfg.linear-scan.rewriting tools.test ;
IN: compiler.cfg.linear-scan.rewriting.tests
\ rewrite-instructions must-infer

100
unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor Normal file
View File

@ -0,0 +1,100 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math assocs namespaces sequences heaps
fry make
compiler.cfg.registers
compiler.cfg.instructions
compiler.cfg.linear-scan.live-intervals ;
IN: compiler.cfg.linear-scan.rewriting
! A vector of live intervals. There is linear searching involved
! but since we never have too many machine registers (around 30
! at most) and we probably won't have that many live at any one
! time anyway, it is not a problem to check each element.
SYMBOL: active-intervals
: add-active ( live-interval -- )
active-intervals get push ;
: lookup-register ( vreg -- reg )
active-intervals get [ vreg>> = ] with find nip reg>> ;
! Minheap of live intervals which still need a register allocation
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 ;
: init-unhandled ( live-intervals -- )
[ add-unhandled ] each ;
: insert-spill ( live-interval -- )
[ reg>> ] [ spill-to>> ] bi dup [ _spill ] [ 2drop ] if ;
: expire-old-intervals ( n -- )
active-intervals get
swap '[ end>> _ = ] partition
active-intervals set
[ insert-spill ] each ;
: insert-reload ( live-interval -- )
[ reg>> ] [ reload-from>> ] bi dup [ _reload ] [ 2drop ] if ;
: activate-new-intervals ( n -- )
#! Any live intervals which start on the current instruction
#! are added to the active set.
unhandled-intervals get dup heap-empty? [ 2drop ] [
2dup heap-peek drop start>> = [
heap-pop drop [ add-active ] [ insert-reload ] bi
activate-new-intervals
] [ 2drop ] if
] if ;
GENERIC: rewrite-instruction ( insn -- )
M: %cond-branch rewrite-instruction
[ lookup-register ] change-vreg
drop ;
M: %unary rewrite-instruction
[ lookup-register ] change-dst
[ lookup-register ] change-src
drop ;
M: %peek rewrite-instruction
[ lookup-register ] change-vreg
drop ;
M: %replace rewrite-instruction
[ lookup-register ] change-vreg
drop ;
M: %load-literal rewrite-instruction
[ lookup-register ] change-vreg
drop ;
: lookup-registers ( assoc -- assoc' )
[ dup vreg? [ lookup-register ] when ] assoc-map ;
M: %intrinsic rewrite-instruction
[ lookup-registers ] change-vregs
drop ;
M: _if-intrinsic rewrite-instruction
[ lookup-registers ] change-vregs
drop ;
: rewrite-instructions ( insns -- insns' )
[
[
[ activate-new-intervals ]
[ drop [ rewrite-instruction ] [ , ] bi ]
[ expire-old-intervals ]
tri
] each-index
] { } make ;

6
unfinished/compiler/cfg/linearization/linearization.factor
View File

@ -56,7 +56,7 @@ M: %branch linearize-insn
dup successors>> first2 swap label>> ; inline
: boolean-conditional ( basic-block insn -- basic-block successor vreg label2 )
[ conditional ] [ vreg>> ] bi* swap ; inline
[ conditional ] [ dst>> ] bi* swap ; inline
M: %branch-f linearize-insn
boolean-conditional _branch-f emit-branch ;
@ -73,10 +73,10 @@ M: %boolean-intrinsic linearize-insn
"false" define-label
"end" define-label
"false" get over [ quot>> ] [ vregs>> ] bi _if-intrinsic
t over out>> %load-literal
dup out>> t %load-literal
"end" get _branch
"false" resolve-label
f over out>> %load-literal
dup out>> f %load-literal
"end" resolve-label
] with-scope
2drop ;

2
unfinished/compiler/cfg/stacks/stacks.factor
View File

@ -127,7 +127,7 @@ M: constant move-spec class ;
{ { f unboxed-c-ptr } [ %move-bug ] }
{ { f unboxed-byte-array } [ %move-bug ] }
{ { f constant } [ value>> swap %load-literal ] }
{ { f constant } [ value>> %load-literal ] }
{ { f float } [ %box-float ] }
{ { f unboxed-alien } [ %box-alien ] }