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 ] [
: 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
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 ;
: 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 -- ? )
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 ;