1 ! Copyright (C) 2008, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel math assocs namespaces sequences heaps
4 fry make combinators combinators.short-circuit sets locals arrays
5 cpu.architecture layouts
9 compiler.cfg.liveness.ssa
10 compiler.cfg.registers
11 compiler.cfg.instructions
12 compiler.cfg.linearization
13 compiler.cfg.ssa.destruction
14 compiler.cfg.renaming.functor
15 compiler.cfg.linear-scan.allocation
16 compiler.cfg.linear-scan.allocation.state
17 compiler.cfg.linear-scan.live-intervals ;
18 FROM: namespaces => set ;
19 IN: compiler.cfg.linear-scan.assignment
21 ! This contains both active and inactive intervals; any interval
22 ! such that start <= insn# <= end is in this set.
23 SYMBOL: pending-interval-heap
24 SYMBOL: pending-interval-assoc
26 : add-pending ( live-interval -- )
27 [ dup end>> pending-interval-heap get heap-push ]
28 [ [ reg>> ] [ vreg>> ] bi pending-interval-assoc get set-at ]
31 : remove-pending ( live-interval -- )
32 vreg>> pending-interval-assoc get delete-at ;
34 :: vreg>reg ( vreg -- reg )
35 ! If a live vreg is not in the pending set, then it must
38 leader pending-interval-assoc get at* [
39 drop leader vreg rep-of lookup-spill-slot
42 ERROR: not-spilled-error vreg ;
44 : vreg>spill-slot ( vreg -- spill-slot )
45 dup vreg>reg dup spill-slot? [ nip ] [ drop leader not-spilled-error ] if ;
47 : vregs>regs ( vregs -- assoc )
48 [ f ] [ [ dup vreg>reg ] H{ } map>assoc ] if-empty ;
50 ! Minheap of live intervals which still need a register allocation
51 SYMBOL: unhandled-intervals
53 : add-unhandled ( live-interval -- )
54 dup start>> unhandled-intervals get heap-push ;
56 : init-unhandled ( live-intervals -- )
57 [ add-unhandled ] each ;
59 ! Liveness info is used by resolve pass
61 ! Mapping from basic blocks to values which are live at the start
62 ! on all incoming CFG edges
63 SYMBOL: machine-live-ins
65 : machine-live-in ( bb -- assoc )
66 machine-live-ins get at ;
68 : compute-live-in ( bb -- )
69 [ live-in keys vregs>regs ] keep machine-live-ins get set-at ;
71 ! Mapping from basic blocks to predecessors to values which are
72 ! live on a particular incoming edge
73 SYMBOL: machine-edge-live-ins
75 : machine-edge-live-in ( predecessor bb -- assoc )
76 machine-edge-live-ins get at at ;
78 : compute-edge-live-in ( bb -- )
79 [ edge-live-ins get at [ keys vregs>regs ] assoc-map ] keep
80 machine-edge-live-ins get set-at ;
82 ! Mapping from basic blocks to values which are live at the end
83 SYMBOL: machine-live-outs
85 : machine-live-out ( bb -- assoc )
86 machine-live-outs get at ;
88 : compute-live-out ( bb -- )
89 [ live-out keys vregs>regs ] keep machine-live-outs get set-at ;
91 : init-assignment ( live-intervals -- )
92 <min-heap> pending-interval-heap set
93 H{ } clone pending-interval-assoc set
94 <min-heap> unhandled-intervals set
95 H{ } clone machine-live-ins set
96 H{ } clone machine-edge-live-ins set
97 H{ } clone machine-live-outs set
100 : insert-spill ( live-interval -- )
101 [ reg>> ] [ spill-rep>> ] [ spill-to>> ] tri ##spill ;
103 : handle-spill ( live-interval -- )
104 dup spill-to>> [ insert-spill ] [ drop ] if ;
106 : expire-interval ( live-interval -- )
107 [ remove-pending ] [ handle-spill ] bi ;
109 : (expire-old-intervals) ( n heap -- )
110 dup heap-empty? [ 2drop ] [
111 2dup heap-peek nip <= [ 2drop ] [
112 dup heap-pop drop expire-interval
113 (expire-old-intervals)
117 : expire-old-intervals ( n -- )
118 pending-interval-heap get (expire-old-intervals) ;
120 : insert-reload ( live-interval -- )
121 [ reg>> ] [ reload-rep>> ] [ reload-from>> ] tri ##reload ;
123 : handle-reload ( live-interval -- )
124 dup reload-from>> [ insert-reload ] [ drop ] if ;
126 : activate-interval ( live-interval -- )
127 [ add-pending ] [ handle-reload ] bi ;
129 : (activate-new-intervals) ( n heap -- )
130 dup heap-empty? [ 2drop ] [
131 2dup heap-peek nip = [
132 dup heap-pop drop activate-interval
133 (activate-new-intervals)
137 : activate-new-intervals ( n -- )
138 unhandled-intervals get (activate-new-intervals) ;
140 : prepare-insn ( n -- )
141 [ expire-old-intervals ] [ activate-new-intervals ] bi ;
143 GENERIC: assign-registers-in-insn ( insn -- )
145 RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
147 M: vreg-insn assign-registers-in-insn
148 [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ;
150 M: gc-map-insn assign-registers-in-insn
151 [ [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ]
152 [ gc-map>> [ [ vreg>spill-slot ] map ] change-gc-roots drop ]
155 M: insn assign-registers-in-insn drop ;
157 : begin-block ( bb -- )
160 [ block-from activate-new-intervals ]
161 [ compute-edge-live-in ]
165 :: assign-registers-in-block ( bb -- )
172 [ insn#>> 1 - prepare-insn ]
173 [ insn#>> prepare-insn ]
174 [ assign-registers-in-insn ]
180 ] change-instructions drop
183 : assign-registers ( live-intervals cfg -- )
184 [ init-assignment ] dip
185 linearization-order [ assign-registers-in-block ] each ;