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

compiler.cfg.linear-scan: fix bad interaction between split position calculation and register-clobbering instructions

db4
Slava Pestov 2010-07-18 17:38:29 -04:00
parent 80d0ed0110
commit b776a92546
3 changed files with 43 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -48,52 +48,33 @@ IN: compiler.cfg.linear-scan.allocation
2dup spill-at-sync-point?
[ swap n>> spill f ] [ 2drop t ] if ;
: handle-interval ( live-interval -- )
GENERIC: handle ( obj -- )
M: live-interval handle
[ start>> deactivate-intervals ]
[ start>> activate-intervals ]
[ assign-register ]
tri ;
: (handle-sync-point) ( sync-point -- )
: handle-sync-point ( sync-point -- )
active-intervals get values
[ [ spill-at-sync-point ] with filter! drop ] with each ;
: handle-sync-point ( sync-point -- )
M: sync-point handle ( sync-point -- )
[ n>> deactivate-intervals ]
[ (handle-sync-point) ]
[ handle-sync-point ]
[ n>> activate-intervals ]
tri ;
: smallest-heap ( heap1 heap2 -- heap )
[ [ heap-peek nip ] bi@ <= ] most ;
:: (allocate-registers-step) ( unhandled-intervals unhandled-sync-points -- )
{
{
[ unhandled-intervals heap-empty? ]
[ unhandled-sync-points heap-pop drop handle-sync-point ]
}
{
[ unhandled-sync-points heap-empty? ]
[ unhandled-intervals heap-pop drop handle-interval ]
}
[
unhandled-intervals heap-peek :> ( i ik )
unhandled-sync-points heap-peek :> ( s sk )
{
{
[ ik sk < ]
[ unhandled-intervals heap-pop* i handle-interval ]
}
{
[ ik sk > ]
[ unhandled-sync-points heap-pop* s handle-sync-point ]
}
[
unhandled-intervals heap-pop*
i handle-interval
s (handle-sync-point)
]
} cond
]
} cond ;
{ [ unhandled-intervals heap-empty? ] [ unhandled-sync-points ] }
{ [ unhandled-sync-points heap-empty? ] [ unhandled-intervals ] }
[ unhandled-sync-points unhandled-intervals smallest-heap ]
} cond heap-pop drop handle ;
: (allocate-registers) ( unhandled-intervals unhandled-sync-points -- )
2dup [ heap-empty? ] both? [ 2drop ] [

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

@ -79,12 +79,13 @@ ERROR: bad-live-ranges interval ;
: split-for-spill ( live-interval n -- before after )
split-interval [ spill-before ] [ spill-after ] bi* ;
: find-use-position ( live-interval new -- n )
[ uses>> ] [ start>> '[ n>> _ >= ] ] bi* find nip
: find-next-use ( live-interval new -- n )
[ uses>> ] [ start>> ] bi*
'[ [ spill-slot?>> not ] [ n>> ] bi _ >= and ] find nip
[ n>> ] [ 1/0. ] if* ;
: find-use-positions ( live-intervals new assoc -- )
'[ [ _ find-use-position ] [ reg>> ] bi _ add-use-position ] each ;
'[ [ _ find-next-use ] [ reg>> ] bi _ add-use-position ] each ;
: active-positions ( new assoc -- )
[ [ active-intervals-for ] keep ] dip

36
basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
View File

@ -16,7 +16,7 @@ TUPLE: live-range from to ;
C: <live-range> live-range
TUPLE: vreg-use n def-rep use-rep ;
TUPLE: vreg-use n def-rep use-rep spill-slot? ;
: <vreg-use> ( n -- vreg-use ) vreg-use new swap >>n ;
@ -36,8 +36,10 @@ reg-class ;
: last-use? ( insn# uses -- use/f )
[ drop f ] [ last [ n>> = ] keep and ] if-empty ;
: (add-use) ( insn# live-interval -- use )
uses>> 2dup last-use? dup [ 2nip ] [ drop new-use ] if ;
:: (add-use) ( insn# live-interval spill-slot? -- use )
live-interval uses>> :> uses
insn# uses last-use? [ insn# uses new-use ] unless*
spill-slot? [ t >>spill-slot? ] when ;
GENERIC: covers? ( insn# obj -- ? )
@ -105,28 +107,42 @@ GENERIC: compute-live-intervals* ( insn -- )
M: insn compute-live-intervals* drop ;
:: record-def ( vreg n -- )
:: record-def ( vreg n spill-slot? -- )
vreg live-interval :> live-interval
n live-interval shorten-range
n live-interval (add-use) vreg rep-of >>def-rep drop ;
n live-interval spill-slot? (add-use) vreg rep-of >>def-rep drop ;
:: record-use ( vreg n -- )
:: record-use ( vreg n spill-slot? -- )
vreg live-interval :> live-interval
from get n live-interval add-range
n live-interval (add-use) vreg rep-of >>use-rep drop ;
n live-interval spill-slot? (add-use) vreg rep-of >>use-rep drop ;
:: record-temp ( vreg n -- )
vreg live-interval :> live-interval
n n live-interval add-range
n live-interval (add-use) vreg rep-of >>def-rep drop ;
n live-interval f (add-use) vreg rep-of >>def-rep drop ;
M: vreg-insn compute-live-intervals* ( insn -- )
dup insn#>>
[ [ defs-vregs ] dip '[ _ record-def ] each ]
[ [ uses-vregs ] dip '[ _ record-use ] each ]
[ [ defs-vregs ] dip '[ _ f record-def ] each ]
[ [ uses-vregs ] dip '[ _ f record-use ] each ]
[ [ temp-vregs ] dip '[ _ record-temp ] each ]
2tri ;
M: clobber-insn compute-live-intervals* ( insn -- )
dup insn#>>
[ [ defs-vregs ] dip '[ _ f record-def ] each ]
[ [ uses-vregs ] dip '[ _ t record-use ] each ]
[ [ temp-vregs ] dip '[ _ record-temp ] each ]
2tri ;
M: hairy-clobber-insn compute-live-intervals* ( insn -- )
dup insn#>>
[ [ defs-vregs ] dip '[ _ t record-def ] each ]
[ [ uses-vregs ] dip '[ _ t record-use ] each ]
[ [ temp-vregs ] dip '[ _ record-temp ] each ]
2tri ;