compiler.cfg.instructions compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.live-intervals compiler.cfg.renaming.functor
compiler.cfg.ssa.destruction.leaders cpu.architecture
-fry heaps kernel locals make math namespaces sequences sets ;
+fry heaps kernel make math namespaces sequences sets ;
FROM: namespaces => set ;
IN: compiler.cfg.linear-scan.assignment
: remove-pending ( live-interval -- )
vreg>> pending-interval-assoc get delete-at ;
-:: vreg>reg ( vreg -- reg )
- vreg leader :> leader
- leader pending-interval-assoc get at* [
- drop leader vreg rep-of lookup-spill-slot
- ] unless ;
+: vreg>reg ( vreg -- reg/spill-slot )
+ dup leader dup pending-interval-assoc get at
+ [ 2nip ] [ swap rep-of lookup-spill-slot ] if* ;
ERROR: not-spilled-error vreg ;
dup vreg>reg dup spill-slot? [ nip ] [ drop leader not-spilled-error ] if ;
: vregs>regs ( vregs -- assoc )
- [ f ] [ [ dup vreg>reg ] H{ } map>assoc ] if-empty ;
+ [ dup vreg>reg ] H{ } map>assoc ;
SYMBOL: unhandled-intervals
-! Liveness info is used by resolve pass
SYMBOL: machine-live-ins
: machine-live-in ( bb -- assoc )
: compute-live-in ( bb -- )
[ live-in keys vregs>regs ] keep machine-live-ins get set-at ;
-! Mapping from basic blocks to predecessors to values which are
-! live on a particular incoming edge
SYMBOL: machine-edge-live-ins
: machine-edge-live-in ( predecessor bb -- assoc )
: compute-live-out ( bb -- )
[ live-out keys vregs>regs ] keep machine-live-outs get set-at ;
-: init-assignment ( live-intervals -- )
- [ [ start>> ] map ] keep zip >min-heap unhandled-intervals set
- <min-heap> pending-interval-heap set
- H{ } clone pending-interval-assoc set
- H{ } clone machine-live-ins set
- H{ } clone machine-edge-live-ins set
- H{ } clone machine-live-outs set ;
-
: heap-pop-while ( heap quot: ( key -- ? ) -- values )
'[ dup heap-empty? [ f f ] [ dup heap-peek @ ] if ]
[ over heap-pop* ] produce 2nip ; inline
[ compute-live-in ]
} cleave ;
-:: assign-registers-in-block ( bb -- )
- bb begin-block
- bb [
+: assign-registers-in-block ( bb -- )
+ dup begin-block
+ [
[
[
{
} cleave
] each
] V{ } make
- ] change-instructions drop
- bb compute-live-out ;
+ ] change-instructions compute-live-out ;
+
+: init-assignment ( live-intervals -- )
+ [ [ start>> ] map ] keep zip >min-heap unhandled-intervals set
+ <min-heap> pending-interval-heap set
+ H{ } clone pending-interval-assoc set
+ H{ } clone machine-live-ins set
+ H{ } clone machine-edge-live-ins set
+ H{ } clone machine-live-outs set ;
: assign-registers ( cfg live-intervals -- )
init-assignment
- linearization-order [ kill-block?>> not ] filter
+ linearization-order [ kill-block?>> ] reject
[ assign-registers-in-block ] each ;