Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /MLRISC/trunk/ra/mem-ra.sml
ViewVC logotype

Annotation of /MLRISC/trunk/ra/mem-ra.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 744 - (view) (download)
Original Path: sml/trunk/src/MLRISC/ra/mem-ra.sml

1 : george 554 (*
2 :     * This module implements the memory coalescing capability of the
3 :     * register allocator.
4 :     *)
5 :     functor MemoryRA(Flowgraph : RA_FLOWGRAPH) : RA_FLOWGRAPH =
6 :     struct
7 :    
8 :     structure G = RAGraph
9 :     structure A = Array
10 :     structure W = Word
11 :    
12 : leunga 585 val debug = false
13 :    
14 : george 554 open G RACore
15 :    
16 :     val ra_spill_coal = MLRiscControl.getCounter "ra-spill-coalescing"
17 :     val ra_spill_prop = MLRiscControl.getCounter "ra-spill-propagation"
18 :    
19 :     local
20 :    
21 :     fun error msg = MLRiscErrorMsg.error("RACore", msg)
22 :    
23 :     (* No overflow checking necessary here *)
24 :     fun x + y = W.toIntX(W.+(W.fromInt x, W.fromInt y))
25 :     fun x - y = W.toIntX(W.-(W.fromInt x, W.fromInt y))
26 :    
27 :     fun concat([], b) = b
28 :     | concat(x::a, b) = concat(a, x::b)
29 :    
30 :     fun chase(NODE{color=ref(ALIASED n),...}) = chase n
31 :     | chase n = n
32 :    
33 :     in
34 :    
35 :     fun isOn(flag,mask) = Word.andb(flag,mask) <> 0w0
36 :    
37 : george 705 fun isMemLoc(SPILLED) = true
38 :     | isMemLoc(SPILL_LOC _) = true
39 :     | isMemLoc(MEMREG _) = true
40 :     | isMemLoc _ = false
41 : george 554 (*
42 :     * Spill coalescing.
43 :     * Coalesce non-interfering moves between spilled nodes,
44 :     * in non-increasing order of move cost.
45 :     *)
46 : george 705 fun spillCoalescing(GRAPH{bitMatrix, ...}) = let
47 :     val member = BM.member(!bitMatrix)
48 : george 554 val addEdge = BM.add(!bitMatrix)
49 : george 705 in
50 :     fn nodesToSpill => let
51 :     (* Find moves between two spilled nodes *)
52 :     fun collectMoves([], mv') = mv'
53 :     | collectMoves(NODE{movelist, color, ...}::ns, mv') = let
54 :     fun ins([], mv') = collectMoves(ns, mv')
55 :     | ins(MV{status=ref(COALESCED | CONSTRAINED), ...}::mvs, mv') =
56 :     ins(mvs, mv')
57 :     | ins((mv as MV{dst, src, ...})::mvs, mv') = let
58 :     val NODE{color=ref cd, number=nd, ...} = chase dst
59 :     val NODE{color=ref cs, number=ns, ...} = chase src
60 :     in
61 :     if nd=ns then ins(mvs, mv')
62 :     else (case (cd, cs)
63 :     of (MEMREG _, MEMREG _) => ins(mvs, mv')
64 :     | _ =>
65 :     if isMemLoc cd andalso isMemLoc cs then
66 :     ins(mvs, MV.add(mv, mv'))
67 :     else
68 :     ins(mvs, mv')
69 :     (*esac*))
70 :     end
71 :     in
72 :     if isMemLoc (!color) then ins(!movelist, mv')
73 :     else collectMoves(ns, mv')
74 :     end
75 : george 554
76 : george 705 (* Coalesce moves between two spilled nodes *)
77 :     fun coalesceMoves(MV.EMPTY) = ()
78 :     | coalesceMoves(MV.TREE(MV{dst, src, cost, ...}, _, l, r)) =
79 :     let val dst as NODE{color=colorDst, ...} = chase dst
80 :     val src = chase src
81 : george 554
82 : george 705 (* Make sure that dst has not been assigned a spill location *)
83 :     val (dst, src) =
84 :     case !colorDst of SPILLED => (dst, src) | _ => (src, dst)
85 : george 554
86 : george 705 val dst as NODE{number=d, color=colorDst, adj=adjDst,
87 :     defs=defsDst, uses=usesDst, ...} = dst
88 :     val src as NODE{number=s, color=colorSrc, adj=adjSrc,
89 :     defs=defsSrc, uses=usesSrc, ...} = src
90 :    
91 :     (* combine adjacency lists *)
92 :     fun union([], adjSrc) = adjSrc
93 :     | union((n as NODE{color, adj=adjT,
94 :     number=t, ...})::adjDst, adjSrc) =
95 :     (case !color of
96 :     (SPILLED | MEMREG _ | SPILL_LOC _ | PSEUDO) =>
97 :     if addEdge(s, t) then
98 :     (adjT := src :: !adjT; union(adjDst, n::adjSrc))
99 :     else union(adjDst, adjSrc)
100 :     | COLORED _ =>
101 :     if addEdge(s, t) then union(adjDst, n::adjSrc)
102 :     else union(adjDst, adjSrc)
103 :     | _ => union(adjDst, adjSrc)
104 :     )
105 :    
106 :     val mvs = MV.merge(l,r)
107 :    
108 :     fun f() =
109 :     ((* print(Int.toString d ^"<->"^Int.toString s^"\n");*)
110 :     ra_spill_coal := !ra_spill_coal + 1;
111 :     (* unify *)
112 :     colorDst := ALIASED src;
113 :     adjSrc := union(!adjDst, !adjSrc);
114 :     defsSrc := concat(!defsDst, !defsSrc);
115 :     usesSrc := concat(!usesDst, !usesSrc);
116 :     coalesceMoves mvs)
117 :     in
118 :     if d = s then coalesceMoves mvs
119 :     else (case !colorDst
120 :     of MEMREG _ => coalesceMoves mvs
121 :     | SPILLED =>
122 :     if member(d,s) then coalesceMoves mvs else f()
123 :     | SPILL_LOC loc =>
124 :     if member(d,s) then coalesceMoves mvs else f()
125 :     | _ => error "coalesceMoves"
126 :     (*esac*))
127 :     end
128 :     in coalesceMoves(collectMoves(nodesToSpill, MV.EMPTY))
129 : george 554 end
130 : george 705 end (*spillCoalesce*)
131 : george 554
132 :     (*
133 :     * Spill propagation.
134 : leunga 585 * This one uses a simple local lookahead algorithm.
135 : george 554 *)
136 :     fun spillPropagation(G as GRAPH{bitMatrix, memRegs, ...}) nodesToSpill =
137 :     let val spillCoalescing = spillCoalescing G
138 :     exception SpillProp
139 : leunga 744 val visited = IntHashTable.mkTable(32, SpillProp)
140 :     : bool IntHashTable.hash_table
141 :     val hasBeenVisited = IntHashTable.find visited
142 :     val hasBeenVisited = fn r => case hasBeenVisited r of NONE => false
143 :     | SOME _ => true
144 : blume 733 val markAsVisited = IntHashTable.insert visited
145 : george 554 val member = BM.member(!bitMatrix)
146 :    
147 :     (* compute savings due to spill coalescing.
148 :     * The move list must be associated with a colorable node.
149 :     * The pinned flag is to prevent the spill node from coalescing
150 :     * two different fixed memory registers.
151 :     *)
152 : leunga 585 fun coalescingSavings
153 :     (node as NODE{number=me, movelist, pri=ref spillcost, ...}) =
154 :     let fun interferes(x,[]) = false
155 :     | interferes(x,NODE{number=y, ...}::ns) =
156 :     x = y orelse member(x,y) orelse interferes(x, ns)
157 :    
158 :     fun moveSavings([], pinned, total) = (pinned, total+total)
159 :     | moveSavings(MV{status=ref(CONSTRAINED | COALESCED), ...}::mvs,
160 :     pinned, total) =
161 :     moveSavings(mvs, pinned, total)
162 :     | moveSavings(MV{dst, src, cost, ...}::mvs, pinned, total) =
163 :     let val NODE{number=d, color=dstCol, ...} = chase dst
164 :     val NODE{number=s, color=srcCol, ...} = chase src
165 :    
166 :     (* How much can be saved by coalescing with the memory
167 :     * location x.
168 :     *)
169 :     fun savings(x) =
170 :     if member(d, s) then
171 :     (if debug then print "interfere\n" else ();
172 :     moveSavings(mvs, pinned, total))
173 :     else if x = ~1 then
174 :     (if debug then print (Int.toString cost^"\n") else ();
175 :     moveSavings(mvs, pinned, total+cost))
176 :     else if pinned >= 0 andalso pinned <> x then
177 :     (* already coalesced with another mem reg *)
178 :     (if debug then print "pinned\n" else ();
179 :     moveSavings(mvs, pinned, total))
180 :     else
181 :     (if debug then print (Int.toString cost^"\n") else ();
182 :     moveSavings(mvs, x, total+cost))
183 :    
184 :     val _ = if debug then
185 :     (print("Savings "^Int.toString d^" <-> "^
186 :     Int.toString s^"=")
187 :     ) else ()
188 :     in if d = s then
189 :     (if debug then print "0 (trivial)\n" else ();
190 :     moveSavings(mvs, pinned, total)
191 :     )
192 :     else
193 :     case (!dstCol, !srcCol) of
194 : george 705 (SPILLED, PSEUDO) => savings(~1)
195 : leunga 744 | (MEMREG(m, _), PSEUDO) => savings(m)
196 : george 705 | (SPILL_LOC s, PSEUDO) => savings(~s)
197 :     | (PSEUDO, SPILLED) => savings(~1)
198 : leunga 744 | (PSEUDO, MEMREG(m, _)) => savings(m)
199 : george 705 | (PSEUDO, SPILL_LOC s) => savings(~s)
200 : leunga 585 | _ => (if debug then print "0 (other)\n" else ();
201 :     moveSavings(mvs, pinned, total))
202 :     end
203 :    
204 :     (* Find initial budget *)
205 :     val _ = if debug then
206 :     print("Trying to propagate "^Int.toString me^
207 :     " spill cost="^Int.toString spillcost^"\n")
208 :     else ()
209 :    
210 :     val (pinned, savings) = moveSavings(!movelist, ~1, 0)
211 :     val budget = spillcost - savings
212 :     val S = [node]
213 :    
214 :     (* Find lookahead nodes *)
215 :     fun lookaheads([], L) = L
216 :     | lookaheads(MV{cost, dst, src, ...}::mvs, L) =
217 :     let val dst as NODE{number=d, ...} = chase dst
218 :     val src as NODE{number=s, ...} = chase src
219 :     fun check(n, node as NODE{color=ref PSEUDO, ...}) =
220 :     if n = me orelse member(n, me) then
221 :     lookaheads(mvs, L)
222 :     else
223 :     add(n, node, L, [])
224 :     | check _ = lookaheads(mvs, L)
225 :     and add(x, x', (l as (c,n' as NODE{number=y, ...}))::L, L') =
226 :     if x = y then
227 :     lookaheads(mvs, (cost+c, n')::List.revAppend(L', L))
228 :     else add(x, x', L, l::L')
229 :     | add(x, x', [], L') =
230 :     lookaheads(mvs, (cost, x')::L')
231 :     in if d = me then check(s, src) else check(d, dst)
232 :     end
233 :    
234 :     (* Now try to improve it by also propagating the lookahead nodes *)
235 :     fun improve([], pinned, budget, S) = (budget, S)
236 :     | improve((cost, node as NODE{number=n, movelist, pri, ...})::L,
237 :     pinned, budget, S) =
238 :     if interferes(n, S) then
239 :     (if debug then
240 :     print ("Excluding "^Int.toString n^" (interferes)\n")
241 :     else ();
242 :     improve(L, pinned, budget, S))
243 :     else
244 :     let val (pinned', savings) = moveSavings(!movelist, pinned, 0)
245 :     val defUseSavings = cost+cost
246 :     val spillcost = !pri
247 :     val budget' = budget - savings - defUseSavings + spillcost
248 :     in if budget' <= budget then
249 :     (if debug then print ("Including "^Int.toString n^"\n")
250 :     else ();
251 :     improve(L, pinned', budget', node::S)
252 :     )
253 : george 554 else
254 : leunga 585 (if debug then print ("Excluding "^Int.toString n^"\n")
255 :     else ();
256 :     improve(L, pinned, budget, S))
257 :     end
258 : george 554
259 : leunga 585 in if budget <= 0 then (budget, S)
260 :     else improve(lookaheads(!movelist, []), pinned, budget, S)
261 :     end
262 :    
263 : george 554 (* Insert all spillable neighbors onto the worklist *)
264 :     fun insert([], worklist) = worklist
265 :     | insert((node as NODE{color=ref PSEUDO, number, ...})::adj, worklist) =
266 :     if hasBeenVisited number
267 :     then insert(adj, worklist)
268 :     else (markAsVisited (number, true);
269 :     insert(adj, node::worklist))
270 :     | insert(_::adj, worklist) = insert(adj, worklist)
271 :    
272 : leunga 585 fun insertAll([], worklist) = worklist
273 :     | insertAll(NODE{adj, ...}::nodes, worklist) =
274 :     insertAll(nodes, insert(!adj, worklist))
275 :    
276 : george 705 val marker = SPILLED
277 : george 554
278 :     (* Process all nodes from the worklist *)
279 :     fun propagate([], spilled) = spilled
280 : leunga 585 | propagate((node as NODE{color=ref PSEUDO, ...})::worklist,
281 : george 554 spilled) =
282 : leunga 585 let val (budget, S) = coalescingSavings(node)
283 :     fun spillNodes([]) = ()
284 :     | spillNodes(NODE{color, ...}::nodes) =
285 :     (ra_spill_prop := !ra_spill_prop + 1;
286 :     color := marker; (* spill the node *)
287 :     spillNodes nodes
288 :     )
289 :    
290 :     in if budget <= 0
291 : george 554 then (* propagate spill *)
292 : leunga 585 (if debug then
293 :     (print("Propagating ");
294 :     app (fn NODE{number=x, ...} => print(Int.toString x^" "))
295 :     S;
296 :     print "\n")
297 :     else ();
298 :     spillNodes S;
299 : george 554 (* run spill coalescing *)
300 : leunga 585 spillCoalescing S;
301 :     propagate(insertAll(S, worklist), List.revAppend(S,spilled))
302 : george 554 )
303 :     else
304 :     propagate(worklist, spilled)
305 :     end
306 :     | propagate(_::worklist, spilled) =
307 :     propagate(worklist, spilled)
308 :    
309 :     (* Initialize worklist *)
310 :     fun init([], worklist) = worklist
311 : george 705 | init(NODE{adj, color=ref(c), ...}::rest, worklist) =
312 :     if isMemLoc (c) then
313 :     init(rest, insert(!adj, worklist))
314 :     else
315 :     init(rest, worklist)
316 : george 554
317 :     (*
318 :     * Iterate between spill coalescing and propagation
319 :     *)
320 :     fun iterate(spillWorkList, spilled) =
321 :     let (* run one round of coalescing first *)
322 :     val _ = spillCoalescing spillWorkList
323 :     val propagationWorkList = init(spillWorkList, [])
324 :     (* iterate on our own spill nodes *)
325 :     val spilled = propagate(propagationWorkList, spilled)
326 :     (* try the memory registers too *)
327 :     val spilled = propagate(!memRegs, spilled)
328 :     in spilled
329 :     end
330 :    
331 :     in iterate(nodesToSpill, nodesToSpill)
332 :     end
333 :    
334 : leunga 585
335 : george 554 (*
336 :     * Spill coloring.
337 :     * Assign logical spill locations to all the spill nodes.
338 :     *
339 :     * IMPORTANT BUG FIX:
340 :     * Spilled copy temporaries are assigned its own set of colors and
341 :     * cannot share with another other nodes. They can share colors with
342 :     * themselves however.
343 : george 705 *
344 :     * spillLoc is the first available (logical) spill location.
345 : george 554 *)
346 :    
347 : george 705 fun spillColoring(GRAPH{spillLoc, copyTmps, mode, ...}) nodesToSpill = let
348 :     val proh = A.array(length nodesToSpill, ~1)
349 :     val firstColor= !spillLoc
350 : george 554
351 : george 705 fun colorCopyTmps(tmps) = let
352 :     fun spillTmp(NODE{color as ref(SPILLED), ...}, found) =
353 :     (color := SPILL_LOC(firstColor); true)
354 :     | spillTmp(_, found) = found
355 :     in
356 :     if List.foldl spillTmp false tmps then
357 :     (spillLoc := !spillLoc + 1; firstColor + 1)
358 :     else firstColor
359 :     end
360 : george 554
361 : george 705 (* color the copy temporaries first *)
362 :     val firstColor =
363 :     if isOn(mode, RACore.HAS_PARALLEL_COPIES) then
364 :     colorCopyTmps(!copyTmps)
365 :     else firstColor
366 : george 554
367 : george 705 fun selectColor([], _, lastLoc) = (spillLoc := lastLoc)
368 :     | selectColor(NODE{color as ref(SPILLED), number, adj, ...}::nodes,
369 :     currLoc, lastLoc) =
370 :     let
371 :     fun neighbors(NODE{color=ref(SPILL_LOC s), ...}) =
372 :     A.update(proh, s - firstColor, number)
373 :     | neighbors(NODE{color=ref(ALIASED n), ...}) = neighbors n
374 :     | neighbors _ = ()
375 :    
376 :     val _ = app neighbors (!adj)
377 :    
378 :     fun findColor(loc, startingPt) =
379 :     if loc = lastLoc then findColor(firstColor, startingPt)
380 :     else if A.sub(proh, loc-firstColor) <> number then (loc, lastLoc)
381 :     else if loc = startingPt then (lastLoc, lastLoc+1)
382 :     else findColor(loc+1, startingPt)
383 :    
384 :     val (loc, lastLoc) = findColor(currLoc + 1, currLoc)
385 :    
386 :     in
387 :     color := SPILL_LOC(loc); (* mark with color *)
388 :     selectColor(nodes, loc, lastLoc)
389 :     end
390 :     | selectColor(_::nodes, currLoc, lastLoc) =
391 :     selectColor(nodes, currLoc, lastLoc)
392 :     in
393 :     (* color the rest of the spilled nodes *)
394 :     selectColor(nodesToSpill, firstColor, !spillLoc + 1)
395 :     end (* spillColoring *)
396 :    
397 : george 554 end (* local *)
398 :    
399 :     structure F = Flowgraph
400 :    
401 :     open F
402 :    
403 :     val SPILL_COALESCING = 0wx100
404 :     val SPILL_COLORING = 0wx200
405 :     val SPILL_PROPAGATION = 0wx400
406 :    
407 :     (*
408 :     * New services that also perform memory allocation
409 :     *)
410 :     fun services f =
411 :     let val {build, spill=spillMethod,
412 :     blockNum, instrNum, programPoint} = F.services f
413 :    
414 :     (* Mark nodes that are immediately aliased to mem regs;
415 :     * These are nodes that need also to be spilled
416 :     *)
417 :     fun markMemRegs [] = ()
418 : george 705 | markMemRegs(NODE{number=r,
419 :     color as ref(ALIASED
420 :     (NODE{color=ref(col), ...})), ...}::ns) =
421 :     (case col of MEMREG _ => color := col | _ => ();
422 :     markMemRegs(ns))
423 : george 554 | markMemRegs(_::ns) = markMemRegs ns
424 :    
425 :     (*
426 :     * Actual spill phase.
427 :     * Perform the memory coalescing phases first, before doing an
428 :     * actual spill.
429 :     *)
430 :     fun spillIt{graph = G as GRAPH{mode, ...}, nodes,
431 :     copyInstr, spill, spillSrc, spillCopyTmp,
432 :     reload, reloadDst, renameSrc, cellkind} =
433 :     let val nodes = if isOn(mode,SPILL_PROPAGATION) then
434 :     spillPropagation G nodes else nodes
435 :     val _ = if isOn(mode,SPILL_COALESCING) then
436 :     spillCoalescing G nodes else ()
437 :     val _ = if isOn(mode,SPILL_COLORING) then
438 :     spillColoring G nodes else ()
439 :     val _ = if isOn(mode,SPILL_COALESCING+SPILL_PROPAGATION)
440 :     then markMemRegs nodes else ()
441 :     in spillMethod
442 :     {graph=G, nodes=nodes, copyInstr=copyInstr,
443 :     spill=spill, spillSrc=spillSrc, spillCopyTmp=spillCopyTmp,
444 :     reload=reload, reloadDst=reloadDst,
445 :     renameSrc=renameSrc, cellkind=cellkind}
446 :     end
447 :     in {build=build, spill=spillIt, programPoint=programPoint,
448 :     blockNum=blockNum, instrNum=instrNum}
449 :     end
450 :    
451 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0