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 /sml/trunk/src/MLRISC/ra/ra-core.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/ra/ra-core.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 469 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/ra/ra-core.sml

1 : monnier 427 (*
2 :     *
3 : monnier 469 * Overview
4 :     * ========
5 :     * This implementation of iterated coalescing differ from the old one in
6 :     * various substantial ways:
7 :     *
8 :     * 1. The move list is prioritized. Higher ranking moves are coalesced first.
9 :     * This tends to favor coalescing of moves that has higher priority.
10 :     *
11 :     * 2. The freeze list is prioritized. Lower ranking nodes are unfrozen
12 :     * first. Since freeze disable moves, this tends to disable moves
13 :     * of low priority.
14 :     *
15 :     * 3. The simplify worklist is not kept explicitly during the
16 :     * simplify/coalesce/freeze phases. Instead, whenever a non-move
17 :     * related node with degree < K is discovered, we call simplify
18 :     * to remove it from the graph immediately.
19 :     *
20 :     * I think this has a few advantages.
21 :     * (a) There is less bookkeeping.
22 :     * (b) Simplify adds coalescable moves to the move list.
23 :     * By doing simplify eagerly, moves are added to the move list
24 :     * faster, allowing higher ranking moves to ``preempt'' low
25 :     * ranking moves.
26 :     *
27 :     * 4. Support for register pairs
28 :     *
29 :     * Important Invariants
30 :     * ====================
31 :     * 1. Adjacency list
32 :     * a. All nodes on the adjacency list are distinct
33 :     * b. nodes with color ALIASED or REMOVED are NOT consider to be
34 :     * on the adjacency list
35 :     * c. If a node x is COLORED, then we DON'T keep track of
36 :     * its adjacency list
37 :     * d. When a node has been removed, there aren't any moves associated
38 :     * with it.
39 :     * 2. Moves
40 :     * a. Moves marked WORKLIST are on the worklist.
41 :     * b. Moves marked MOVE are NOT on the worklist.
42 :     * c. Moves marked LOST are frozen and are in fact never considered again.
43 :     * d. Moves marked CONSTRAINED cannot be coalesced because the src and dst
44 :     * interfere
45 :     * e. Moves marked COALESCED have been coalesced.
46 :     * f. The movecnt in a node is always the number of nodes
47 :     * currently marked as WORKLIST or MOVE, i.e. the moves that
48 :     * are associated with the node. When this is zero, the node is
49 :     * considered to be non-move related.
50 :     * g. Moves on the move worklist are always distinct.
51 :     * 3.
52 :     *
53 :     * Allen.
54 :     *
55 : monnier 427 *)
56 :    
57 :     structure RACore : RA_CORE =
58 :     struct
59 :    
60 : monnier 469 structure G = RAGraph
61 :     structure A = Array
62 :     structure W = Word
63 :     structure W8A = Word8Array
64 :     structure W8 = Word8
65 : monnier 427
66 : monnier 469 (* For debugging, uncomment Unsafe. *)
67 :     structure UA = Unsafe.Array
68 :     structure UW8A = Unsafe.Word8Array
69 : monnier 427
70 : monnier 469 open G
71 : monnier 427
72 : monnier 469 val verbose = MLRiscControl.getFlag "ra-verbose"
73 :    
74 :     fun error msg = MLRiscErrorMsg.error("RACore", msg)
75 :    
76 :     (* No overflow checking necessary here *)
77 :     fun x + y = W.toIntX(W.+(W.fromInt x, W.fromInt y))
78 :     fun x - y = W.toIntX(W.-(W.fromInt x, W.fromInt y))
79 :    
80 :     (*
81 :     * Bit Matrix routines
82 : monnier 427 *)
83 : monnier 469 structure BM =
84 :     struct
85 :     fun hashFun(i, j, shift, size) =
86 :     W.toIntX(W.andb(W.+(W.<<(W.fromInt i, shift),
87 :     W.fromInt(i+j)), W.fromInt(size -1)))
88 : monnier 427
89 : monnier 469 val empty = BM{table=SMALL(ref(A.array(0, [])), 0w0), elems=ref 0, edges=0}
90 : monnier 427
91 : monnier 469 (*
92 :     val indices = A.array(1024,0)
93 : monnier 427
94 : monnier 469 fun init(i,j) =
95 :     if i < 1024 then
96 :     (A.update(indices, i, j); init(i+1, i+j+1))
97 :     else ()
98 :    
99 :     val _ = init(0, 0)
100 :     *)
101 :    
102 :     fun edges(BM{table=SMALL(ref table, _), ...}) = A.length table
103 :     | edges(BM{table=LARGE(ref table, _), ...}) = A.length table
104 :     (*| edges(BM{table=BITMATRIX _, edges, ...}) = edges *)
105 :    
106 :     fun member(BM{table=SMALL(table, shift), ...}) =
107 :     (fn (NODE{number=i,...}, NODE{number=j,...}) =>
108 :     let val (i,j) = if i < j then (i, j) else (j, i)
109 :     val k = W.+(W.<<(W.fromInt i, 0w15), W.fromInt j)
110 :     fun find [] = false
111 :     | find(k'::b) = k = k' orelse find b
112 :     val tab = !table
113 :     in find(UA.sub(tab, hashFun(i, j, shift, A.length tab))) end
114 :     )
115 :     | member(BM{table=LARGE(table, shift), ...}) =
116 :     (fn (NODE{number=i,...}, NODE{number=j,...}) =>
117 :     let val (i,j) = if i < j then (i, j) else (j, i)
118 :     fun find NIL = false
119 :     | find(B(i',j',b)) = i = i' andalso j = j' orelse find b
120 :     val tab = !table
121 :     in find(UA.sub(tab, hashFun(i, j, shift, A.length tab))) end
122 :     )
123 :     (*
124 :     | member(BM{table=BITMATRIX table, ...}) =
125 :     (fn (NODE{number=i,...}, NODE{number=j,...}) =>
126 :     let val (i,j) = if i > j then (i, j) else (j, i)
127 :     val bit = W.fromInt(UA.sub(indices, i) + j)
128 :     val index = W.toIntX(W.>>(bit, 0w3))
129 :     val mask = W.<<(0w1, W.andb(bit, 0w7))
130 :     in W.andb(W.fromInt(W8.toInt(UW8A.sub(table, index))), mask) <> 0w0
131 :     end
132 :     )
133 :     *)
134 :    
135 :     fun add (BM{table=SMALL(table, shift), elems, ...}) =
136 :     let fun insert(i, j) =
137 :     let val (i,j) = if i < j then (i, j) else (j, i)
138 :     val tab = !table
139 :     val len = A.length tab
140 :     in if !elems < len then
141 :     let val index = hashFun(i, j, shift, len)
142 :     val k = W.+(W.<<(W.fromInt i, 0w15), W.fromInt j)
143 :     fun find [] = false
144 :     | find(k'::b) = k = k' orelse find b
145 :     val b = UA.sub(tab, index)
146 :     in if find b then false
147 :     else (UA.update(tab, index, k::b);
148 :     elems := !elems + 1; true)
149 :     end
150 :     else (* grow table *)
151 :     let val oldTable = tab
152 :     val oldSize = A.length oldTable
153 :     val newSize = oldSize + oldSize
154 :     val newTable = A.array(newSize,[])
155 :     fun enter n =
156 :     if n < oldSize then
157 :     let fun loop([],a,b) =
158 :     (UA.update(newTable, n, a);
159 :     UA.update(newTable, n + oldSize, b);
160 :     enter(n+1))
161 :     | loop(k::l,a,b) =
162 :     let val i = W.toIntX(W.>>(k, 0w15))
163 :     val j = W.toIntX(W.-(k,W.<<(W.fromInt i, 0w15)))
164 :     in if hashFun(i, j, shift, newSize) = n
165 :     then loop(l, k::a, b)
166 :     else loop(l, a, k::b)
167 :     end
168 :     in loop(UA.sub(oldTable, n), [], []) end
169 :     else ()
170 :     in table := newTable;
171 :     enter 0;
172 :     insert(i, j)
173 :     end
174 :     end
175 :     in insert
176 :     end
177 :     | add (BM{table=LARGE(table, shift), elems, ...}) =
178 :     let fun insert(i, j) =
179 :     let val (i,j) = if i < j then (i, j) else (j, i)
180 :     val tab = !table
181 :     val len = A.length tab
182 :     in if !elems < len then
183 :     let val index = hashFun(i, j, shift, len)
184 :     fun find NIL = false
185 :     | find(B(i',j',b)) = i = i' andalso j = j' orelse find b
186 :     val b = UA.sub(tab, index)
187 :     in if find b then false
188 :     else (UA.update(tab, index, B(i,j,b));
189 :     elems := !elems + 1; true)
190 :     end
191 :     else (* grow table *)
192 :     let val oldTable = tab
193 :     val oldSize = A.length oldTable
194 :     val newSize = oldSize + oldSize
195 :     val newTable = A.array(newSize,NIL)
196 :     fun enter n =
197 :     if n < oldSize then
198 :     let fun loop(NIL,a,b) =
199 :     (UA.update(newTable, n, a);
200 :     UA.update(newTable, n + oldSize, b);
201 :     enter(n+1))
202 :     | loop(B(i,j,l),a,b) =
203 :     if hashFun(i, j, shift, newSize) = n
204 :     then loop(l, B(i,j,a), b)
205 :     else loop(l, a, B(i,j,b))
206 :     in loop(UA.sub(oldTable, n), NIL, NIL) end
207 :     else ()
208 :     in table := newTable;
209 :     enter 0;
210 :     insert(i, j)
211 :     end
212 :     end
213 :     in insert
214 :     end
215 :     (*
216 :     | add(BM{table=BITMATRIX table, ...}) =
217 :     (fn (i, j) =>
218 :     let val (i,j) = if i > j then (i, j) else (j, i)
219 :     val bit = W.fromInt(UA.sub(indices, i) + j)
220 :     val index = W.toIntX(W.>>(bit, 0w3))
221 :     val mask = W.<<(0w1, W.andb(bit, 0w7))
222 :     val value = W.fromInt(W8.toInt(UW8A.sub(table, index)))
223 :     in if W.andb(value, mask) <> 0w0 then false
224 :     else (UW8A.update(table, index,
225 :     W8.fromInt(W.toIntX(W.orb(value, mask)))); true)
226 :     end
227 :     )
228 :     *)
229 :    
230 :     fun delete (BM{table=SMALL(table, shift), elems, ...}) =
231 :     (fn (i,j) =>
232 :     let val k = W.+(W.<<(W.fromInt i, 0w15), W.fromInt j)
233 :     fun find [] = []
234 :     | find(k'::b) =
235 :     if k = k' then (elems := !elems - 1; b) else find b
236 :     val tab = !table
237 :     val index = hashFun(i, j, shift, A.length tab)
238 :     val n = !elems
239 :     in UA.update(tab, index, find(UA.sub(tab, index)));
240 :     !elems <> n
241 :     end
242 :     )
243 :     | delete (BM{table=LARGE(table, shift), elems, ...}) =
244 :     (fn (i,j) =>
245 :     let fun find NIL = NIL
246 :     | find(B(i', j', b)) =
247 :     if i = i' andalso j = j' then (elems := !elems - 1; b)
248 :     else B(i', j', find b)
249 :     val tab = !table
250 :     val index = hashFun(i, j, shift, A.length tab)
251 :     val n = !elems
252 :     in UA.update(tab, index, find(UA.sub(tab, index)));
253 :     !elems <> n
254 :     end
255 :     )
256 :     (*
257 :     | delete(BM{table=BITMATRIX table, ...}) =
258 :     (fn (i, j) =>
259 :     let val (i,j) = if i > j then (i, j) else (j, i)
260 :     val bit = W.fromInt(UA.sub(indices, i) + j)
261 :     val index = W.toIntX(W.>>(bit, 0w3))
262 :     val mask = W.-(W.<<(0w1, W.andb(bit, 0w7)), 0w1)
263 :     val value = W.fromInt(W8.toInt(UW8A.sub(table, index)))
264 :     in if W.andb(value, mask) = 0w0 then false
265 :     else (UW8A.update(table, index,
266 :     W8.fromInt(W.toIntX(W.andb(value,W.notb mask))));
267 :     true)
268 :     end
269 :     )
270 :     *)
271 :     end
272 :    
273 :    
274 :     (*
275 :     * Priority Queue. Let's hope the compiler will inline it for performance
276 :     *)
277 :     functor PriQueue(type elem val less : elem * elem -> bool) =
278 :     struct
279 :    
280 :    
281 :     (* A leftist tree is a binary tree with priority ordering
282 :     * with the invariant that the left branch is always the taller one
283 :     *)
284 :     type elem = elem
285 :     datatype pri_queue = TREE of elem * int * pri_queue * pri_queue
286 :     | EMPTY
287 :    
288 :     fun merge'(EMPTY, EMPTY) = (EMPTY, 0)
289 :     | merge'(EMPTY, a as TREE(_, d, _, _)) = (a, d)
290 :     | merge'(a as TREE(_, d, _, _), EMPTY) = (a, d)
291 :     | merge'(a as TREE(x, d, l, r), b as TREE(y, d', l', r')) =
292 :     let val (root, l, r1, r2) =
293 :     if less(x, y) then (x, l, r, b) else (y, l', r', a)
294 :     val (r, d_r) = merge'(r1, r2)
295 :     val d_l = case l of
296 :     EMPTY => 0
297 :     | TREE(_, d, _, _) => d
298 :     val (l, r) = if d_l >= d_r then (l, r) else (r, l)
299 :     val d_t = 1+(if d_l > d_r then d_l else d_r)
300 :     in (TREE(root, d_t, l, r), d_t) end
301 :    
302 :     fun merge(EMPTY, a) = a
303 :     | merge(a, EMPTY) = a
304 :     | merge(a, b) = #1(merge'(a, b))
305 :    
306 :     fun add (x, EMPTY) = TREE(x, 1, EMPTY, EMPTY)
307 :     | add (x, b as TREE(y, d', l', r')) =
308 :     if less(x,y) then TREE(x, d'+1, b, EMPTY)
309 :     else #1(merge'(TREE(x, 1, EMPTY, EMPTY), b))
310 :    
311 :     end
312 :    
313 :     structure FZ = PriQueue
314 :     (type elem=node
315 :     fun less(NODE{movecost=ref p1,...}, NODE{movecost=ref p2,...}) = p1 < p2
316 :     )
317 :     structure MV = PriQueue
318 :     (type elem=G.move
319 :     fun less(MV{cost=p1,...}, MV{cost=p2,...}) = p1 > p2
320 :     )
321 :     type move_queue = MV.pri_queue
322 :     type freeze_queue = FZ.pri_queue
323 :    
324 :    
325 :     (*
326 :     * Utility functions
327 :     *)
328 : monnier 427 fun chase(NODE{color=ref(ALIASED r), ...}) = chase r
329 :     | chase x = x
330 :    
331 : monnier 469 fun nodeNumber(NODE{number,...}) = number
332 : monnier 427
333 : monnier 469 val debug = false
334 :    
335 :     fun colorOf(G.GRAPH{showReg,...}) (NODE{number, color, pri,...}) =
336 :     showReg number^
337 :     (case !color of
338 :     PSEUDO => ""
339 :     | REMOVED => "r"
340 :     | ALIASED _ => "a"
341 :     | COLORED c => "["^showReg c^"]"
342 :     | SPILLED _ => "s"
343 :     | ALIASED_SPILL _ => "as"
344 :     )
345 :    
346 :     fun show G (node as NODE{pri,...}) =
347 :     colorOf G node^(if !verbose then "("^Int.toString(!pri)^")" else "")
348 :    
349 :     (*
350 :     * Dump the interference graph
351 :     *)
352 :     fun dumpGraph(G as G.GRAPH{nodes, showReg, K,...}) stream =
353 :     let fun pr s = TextIO.output(stream, s)
354 :     val show = show G
355 :     val colorOf = colorOf G
356 :     fun prMove(MV{src, dst, status=ref(WORKLIST | MOVE), cost,...}) =
357 :     pr(colorOf(chase dst)^" <- "^colorOf(chase src)^
358 :     "("^Int.toString(cost)^") ")
359 :     | prMove _ = ()
360 :    
361 :     fun prAdj(n, n' as NODE{color=ref(SPILLED _),...}) =
362 :     pr(show n'^" spilled\n")
363 :     | prAdj(n, n' as NODE{adj, degree, color,
364 :     (*pair,*) pri, movecnt, movelist, ...}) =
365 :     (pr(show n');
366 :     (* if pair then pr(" pair ") else (); *)
367 :     if !verbose then pr(" deg="^Int.toString(!degree)) else ();
368 :     pr(" <-->");
369 :     app (fn n => (pr " "; pr(show n))) (!adj);
370 :     pr "\n";
371 :     if !verbose andalso !movecnt > 0 then
372 :     (pr("\tmoves "^Int.toString(!movecnt)^": ");
373 :     app prMove (!movelist);
374 :     pr "\n"
375 :     )
376 :     else ()
377 :     )
378 :     in pr("=========== K="^Int.toString K^" ===========\n");
379 :     app prAdj (ListMergeSort.sort (fn ((x, _),(y, _)) => x > y)
380 :     (Intmap.intMapToList nodes))
381 : monnier 427 end
382 :    
383 : monnier 469
384 :     (*
385 :     * Function to create new nodes.
386 :     * Note: it is up to the caller to remove all dedicated registers.
387 :     *)
388 :     fun newNodes(G.GRAPH{nodes, firstPseudoR, ...}) =
389 :     let val getnode = Intmap.map nodes
390 :     val addnode = Intmap.add nodes
391 :    
392 :     fun defUse{defs, uses, pt, cost} =
393 :     let fun def reg =
394 :     let val node as NODE{pri, defs,...} = getnode reg
395 :     in pri := !pri + cost;(* increment the priority by the cost *)
396 :     defs := pt :: !defs;
397 :     node
398 :     end
399 :     handle _ =>
400 :     let val col = if reg < firstPseudoR then COLORED(reg) else PSEUDO
401 :     val node =
402 :     NODE{number=reg, color=ref col, degree=ref 0,
403 :     adj=ref [], movecnt=ref 0, movelist = ref [],
404 :     movecost=ref 0, (* pair=false, *) pri=ref cost,
405 :     defs=ref [pt], uses=ref []}
406 :     in addnode(reg, node); node
407 :     end
408 :     fun use reg =
409 :     let val node as NODE{pri, uses,...} = getnode reg
410 :     in pri := !pri + cost; (* increment the priority by the cost *)
411 :     uses := pt :: !uses
412 :     end
413 :     handle _ =>
414 :     let val col = if reg < firstPseudoR then COLORED(reg) else PSEUDO
415 :     val node =
416 :     NODE{number=reg, color=ref col, degree=ref 0,
417 :     adj=ref [], movecnt=ref 0, movelist = ref [],
418 :     movecost=ref 0, (* pair=false, *)
419 :     pri=ref cost, defs=ref [], uses=ref[pt]
420 :     }
421 :     in addnode(reg, node)
422 :     end
423 :     fun defAll([],ds) = ds | defAll(r::rs,ds) = defAll(rs,def r::ds)
424 :     fun useAll [] = () | useAll(r::rs) = (use r; useAll rs)
425 :     val defs = defAll(defs,[])
426 :     val _ = useAll uses
427 :     in defs
428 :     end
429 :     in defUse
430 : monnier 427 end
431 :    
432 :    
433 : monnier 469 (*
434 :     * Add an edge (x, y) to the interference graph.
435 :     * Nop if the edge already exists.
436 :     * Note: adjacency lists of colored nodes are not stored
437 :     * within the interference graph to save space.
438 :     *)
439 :     fun addEdge(GRAPH{bitMatrix,...}) =
440 :     let val addBitMatrix = BM.add(!bitMatrix)
441 :     fun add(NODE{color, adj, degree, (* pair=p1, *) number=n1, ...},
442 :     s as NODE{number=n2, (* pair=p2, *) ...}) =
443 :     (case !color of
444 :     PSEUDO => (adj := s :: !adj;
445 :     (* check for pair <-> pair interference *)
446 :     (* if p1 andalso p2 then degree := 2 + !degree
447 :     else *) degree := 1 + !degree
448 :     )
449 :     | COLORED _ => () (* not stored *)
450 :     | ALIASED _ => error "addEdge: ALIASED"
451 :     | REMOVED => error "addEdge: REMOVED"
452 :     | SPILLED _ => error "addEdge: SPILLED"
453 :     | ALIASED_SPILL _ => error "addEdge: ALIASED_SPILL"
454 :     )
455 : monnier 427 in fn (x as NODE{number=xn, ...}, y as NODE{number=yn, ...}) =>
456 :     if xn = yn then ()
457 : monnier 469 else if addBitMatrix(xn, yn) then
458 : monnier 427 (add(x, y); add(y, x))
459 :     else ()
460 :     end
461 :    
462 :     (*
463 : monnier 469 * Remove an edge from the bitmatrix
464 : monnier 427 *)
465 : monnier 469 fun removeEdge(GRAPH{bitMatrix,...}) =
466 :     let val rmvBitMatrix = BM.delete(!bitMatrix)
467 :     fun filter(c,[], adj') = adj'
468 :     | filter(c,(n as NODE{color,...})::adj, adj') =
469 :     filter(c, adj, if c = color then adj' else n::adj')
470 :     fun rmv(NODE{color, adj, degree, (* pair=p1, *)...},
471 :     s as NODE{(* pair=p2, *) color=c2,...}) =
472 :     (case !color of
473 :     PSEUDO => (adj := filter(c2,!adj,[]);
474 :     (* check for pair <-> pair interference *)
475 :     (* if p1 andalso p2 then degree := !degree - 2
476 :     else *) degree := !degree - 1
477 :     )
478 :     | COLORED _ => () (* not stored *)
479 :     | ALIASED _ => error "removeEdge: ALIASED"
480 :     | REMOVED => error "removeEdge: REMOVED"
481 :     | SPILLED _ => error "removeEdge: SPILLED"
482 :     | ALIASED_SPILL _ => error "removeEdge: ALIASED_SPILL"
483 :     )
484 :     in fn (x as NODE{number=xn, ...}, y as NODE{number=yn, ...}) =>
485 :     if xn = yn then ()
486 :     else if rmvBitMatrix(if xn < yn then (xn, yn) else (yn, xn)) then
487 :     (rmv(x, y); rmv(y, x))
488 :     else ()
489 : monnier 427 end
490 :    
491 :     (*
492 : monnier 469 * Initialize a list of worklists
493 : monnier 427 *)
494 : monnier 469 fun initWorkLists
495 :     (GRAPH{nodes, K, bitMatrix, regmap, firstPseudoR, deadCopies, ...})
496 :     {moves, deadCopyElim} =
497 :     let (* Filter moves that already have an interference
498 :     * Also initialize the movelist and movecnt fields at this time.
499 :     *)
500 :     val member = BM.member(!bitMatrix)
501 : monnier 427
502 : monnier 469 fun setInfo(NODE{color=ref PSEUDO, movecost, movecnt, movelist,...},
503 :     mv, cost) =
504 :     (movelist := mv :: !movelist;
505 :     movecnt := !movecnt + 1;
506 :     movecost := !movecost + cost
507 :     )
508 :     | setInfo _ = ()
509 : monnier 427
510 : monnier 469 fun filter([], mvs') = mvs'
511 :     | filter(MV{src=NODE{color=ref(COLORED _),...},
512 :     dst=NODE{color=ref(COLORED _),...},...}::mvs, mvs') =
513 :     filter(mvs, mvs')
514 :     | filter((mv as MV{src, dst, cost,...})::mvs, mvs') =
515 :     if member(src, dst) (* moves that interfere *)
516 :     then filter(mvs, mvs')
517 :     else (setInfo(src, mv, cost);
518 :     setInfo(dst, mv, cost);
519 :     filter(mvs, MV.add(mv, mvs'))
520 :     )
521 : monnier 427
522 : monnier 469 fun decDegree [] = ()
523 :     | decDegree(NODE{color=ref PSEUDO, degree, ...}::adj) =
524 :     (degree := !degree - 1; decDegree adj)
525 :     | decDegree(_::adj) = decDegree adj
526 : monnier 427
527 : monnier 469 fun elimUses([], _, uses, pri, cost) = (uses, pri)
528 :     | elimUses(pt::pts, pt' : int, uses, pri, cost) =
529 :     if pt = pt' then elimUses(pts, pt', uses, pri-cost, cost)
530 :     else elimUses(pts, pt', pt::uses, pri, cost)
531 : monnier 427
532 : monnier 469 fun filter'([], mvs', dead) = (mvs', dead)
533 :     | filter'(MV{src=NODE{color=ref(COLORED _),...},
534 :     dst=NODE{color=ref(COLORED _),...},...}::mvs, mvs', dead) =
535 :     filter'(mvs, mvs', dead)
536 :     | filter'(MV{dst as NODE{number=r, color as ref PSEUDO, defs=ref [pt],
537 :     uses=ref [], adj, ...},
538 :     src as NODE{uses, pri, ...}, cost, ...}::mvs,
539 :     mvs', dead) =
540 :     (* eliminate dead copy *)
541 :     let val (uses', pri') = elimUses(!uses, pt, [], !pri, cost);
542 :     in pri := pri';
543 :     uses := uses';
544 :     color := ALIASED src;
545 :     decDegree(!adj);
546 :     filter'(mvs, mvs', r::dead)
547 : monnier 427 end
548 : monnier 469 | filter'((mv as MV{src, dst, cost,...})::mvs, mvs', dead) =
549 :     if member(src, dst) (* moves that interfere *)
550 :     then filter'(mvs, mvs', dead)
551 :     else (setInfo(src, mv, cost);
552 :     setInfo(dst, mv, cost);
553 :     filter'(mvs, MV.add(mv, mvs'), dead)
554 :     )
555 : monnier 427
556 :    
557 : monnier 469 (*
558 :     * Scan all nodes in the graph and check which worklist they should
559 :     * go into.
560 :     *)
561 :     fun collect([], simp, fz, moves, spill) =
562 :     {simplifyWkl = simp,
563 :     moveWkl = moves,
564 :     freezeWkl = fz,
565 :     spillWkl = spill
566 :     }
567 :     | collect(node::rest, simp, fz, moves, spill) =
568 :     (case node of
569 :     NODE{color=ref PSEUDO, movecnt, degree, ...} =>
570 :     if !degree >= K then
571 :     collect(rest, simp, fz, moves, node::spill)
572 :     else if !movecnt > 0 then
573 :     collect(rest, simp, FZ.add(node, fz), moves, spill)
574 :     else
575 :     collect(rest, node::simp, fz, moves, spill)
576 :     | _ => collect(rest, simp, fz, moves, spill)
577 :     )
578 : monnier 427
579 : monnier 469 (* First build the move priqueue *)
580 :     val mvs = if deadCopyElim then
581 :     let val (mvs, dead) = filter'(moves, MV.EMPTY, [])
582 :     in deadCopies := dead; mvs
583 :     end
584 :     else filter(moves, MV.EMPTY)
585 :    
586 :     (* if copy propagation was done prior to register allocation
587 :     * then some nodes may already be aliased. This function updates the
588 :     * aliasing.
589 :     *)
590 :     fun updateAliases() =
591 :     let val alias = Intmap.mapInt regmap
592 :     val getnode = Intmap.map nodes
593 :     fun fixup(num, NODE{color, ...}) =
594 :     if num < firstPseudoR then ()
595 :     else let val reg = alias num
596 :     in if reg=num then () else
597 :     color := ALIASED(getnode reg)
598 :     end
599 :     in Intmap.app fixup nodes end
600 :    
601 :     in (* updateAliases(); *)
602 :     collect(Intmap.values nodes, [], FZ.EMPTY, mvs, [])
603 :     end
604 :    
605 :     (*
606 :     * Return a regmap that reflects the current interference graph.
607 :     * Spilled registers are given the special value ~1
608 :     *)
609 :     fun regmap(G.GRAPH{nodes,...}) =
610 :     let val getnode = Intmap.map nodes
611 :     fun num(NODE{color=ref(COLORED r),...}) = r
612 :     | num(NODE{color=ref(ALIASED n),...}) = num n
613 :     | num(NODE{color=ref(SPILLED s),number,...}) = ~1
614 :     | num(NODE{color=ref(ALIASED_SPILL s), number, ...}) = ~1
615 :     | num(NODE{number, color=ref PSEUDO,...}) = number
616 :     | num _ = error "regmap"
617 :     fun lookup r = num(getnode r) handle _ => r (* XXX *)
618 :     in lookup
619 :     end
620 :    
621 :     (*
622 :     * Return a regmap that reflects the current interference graph,
623 :     * during spilling.
624 :     *)
625 :     fun spillRegmap(G.GRAPH{nodes,...}) =
626 :     let val getnode = Intmap.map nodes
627 :     fun num(NODE{color=ref(COLORED r),...}) = r
628 :     | num(NODE{color=ref(ALIASED n),...}) = num n
629 :     | num(NODE{color=ref(SPILLED _),number,...}) = number
630 :     | num(NODE{color=ref(ALIASED_SPILL _), number, ...}) = number
631 :     | num(NODE{number, color=ref PSEUDO,...}) = number
632 :     | num _ = error "spillRegmap"
633 :     fun lookup r = num(getnode r) handle _ => r (* XXX *)
634 :     in lookup
635 :     end
636 :    
637 :     (*
638 :     * Return a regmap that returns the current spill location
639 :     * during spilling.
640 :     *)
641 :     fun spillLoc(G.GRAPH{nodes,...}) =
642 :     let val getnode = Intmap.map nodes
643 :     fun num(NODE{color=ref(ALIASED n), ...}) = num n
644 :     | num(NODE{color=ref(SPILLED ~1), number, ...}) = number
645 :     | num(NODE{color=ref(SPILLED c), ...}) = c
646 :     | num(NODE{color=ref(ALIASED_SPILL n), ...}) = num n
647 :     | num(NODE{number, ...}) = number
648 :     fun lookup r = num(getnode r) handle _ => r (* XXX *)
649 :     in lookup
650 :     end
651 :    
652 :     (*
653 :     * Core phases:
654 :     * Simplify, coalesce, freeze.
655 :     *
656 :     * NOTE: When a node's color is REMOVED or ALIASED,
657 :     * it is not considered to be part of the adjacency list
658 :     *
659 :     * 1. The move list has no duplicate
660 :     * 2. The freeze list may have duplicates
661 :     *)
662 :     fun iteratedCoalescingPhases
663 :     (G as GRAPH{K, bitMatrix, spillFlag, trail, stamp, ...}) =
664 :     let val member = BM.member(!bitMatrix)
665 : monnier 427 val addEdge = addEdge G
666 : monnier 469 val show = show G
667 : monnier 427
668 : monnier 469 (*
669 :     * SIMPLIFY node:
670 :     * precondition: node must be part of the interference graph (PSEUDO)
671 :     *)
672 :     fun simplify(node as NODE{color, number, adj, (* pair, *)...},
673 :     mv, fz, stack) =
674 :     let val _ = if debug then print("Simplifying "^show node^"\n") else ()
675 :     fun forallAdj([], mv, fz, stack) = (mv, fz, stack)
676 :     | forallAdj(n::adj, mv, fz, stack) =
677 :     (case n of
678 :     NODE{(* pair=p2, *) color=ref PSEUDO,...} =>
679 :     let val (mv, fz, stack) =
680 :     decDegree(n, (* pair andalso p2, *) mv, fz, stack)
681 :     in forallAdj(adj, mv, fz, stack) end
682 :     | _ => forallAdj(adj, mv, fz, stack)
683 :     )
684 :     in color := REMOVED;
685 :     forallAdj(!adj, mv, fz, node::stack) (* push onto stack *)
686 :     end (* simplify *)
687 :    
688 :     (*
689 :     * Decrement the degree of a pseudo node.
690 :     * precondition: node must be part of the interference graph
691 :     * If the degree of the node is now K-1.
692 :     * Then if (a) the node is move related, freeze it.
693 :     * (b) the node is non-move related, simplify it
694 :     *
695 :     * node -- the node to decrement degree
696 :     * mv -- queue of move candidates to be coalesced
697 :     * fz -- queue of freeze candidates
698 :     * stack -- stack of removed nodes
699 :     *)
700 :     and decDegree(node as NODE{degree as ref d, movecnt, adj, color,...},
701 :     (* false, *) mv, fz, stack) = (* normal edge *)
702 :     (if debug then
703 :     print("DecDegree "^show node^" d="^Int.toString(d-1)^"\n") else ();
704 :     degree := d - 1;
705 :     if d = K then
706 :     (* node is now low degree!!! *)
707 :     let val mv = enableMoves(node :: !adj, mv)
708 :     in if !movecnt > 0 then (* move related *)
709 :     (mv, FZ.add(node, fz), stack)
710 :     else (* non-move related, simplify now! *)
711 :     simplify(node, mv, fz, stack)
712 :     end
713 :     else
714 :     (mv, fz, stack)
715 :     )
716 :     (*
717 :     | decDegree(node as NODE{degree as ref d, movecnt, adj, color,...},
718 :     true, mv, fz, stack) = (* register pair edge *)
719 :     (degree := d - 2;
720 :     if d >= K andalso !degree < K then
721 :     (* node is now low degree!!! *)
722 :     let val mv = enableMoves(node :: !adj, mv)
723 :     in if !movecnt > 0 then (* move related *)
724 :     (mv, FZ.add(node, fz), stack)
725 :     else (* non-move related, simplify now! *)
726 :     simplify(node, mv, fz, stack)
727 :     end
728 :     else
729 :     (mv, fz, stack)
730 :     )
731 :     *)
732 :    
733 :     (*
734 :     * Enable moves:
735 :     * given: a list of nodes (some of which are not in the graph)
736 :     * do: all moves associated with these nodes are inserted
737 :     * into the move worklist
738 :     *)
739 :     and enableMoves([], mv) = mv
740 :     | enableMoves(n::ns, mv) =
741 :     let (* add valid moves onto the worklist.
742 :     * there are no duplicates on the move worklist!
743 : monnier 427 *)
744 : monnier 469 fun addMv([], mv) = mv
745 :     | addMv((m as MV{status,dst,src,...})::rest, mv) =
746 :     (case !status of
747 :     MOVE => (status := WORKLIST;
748 :     addMv(rest, MV.add(m, mv)))
749 :     | _ => addMv(rest, mv)
750 :     )
751 :     in (* make sure the nodes are actually in the graph *)
752 :     case n of
753 :     NODE{movelist, color=ref PSEUDO, movecnt,...} =>
754 :     if !movecnt > 0 then (* is it move related? *)
755 :     enableMoves(ns, addMv(!movelist, mv))
756 :     else
757 :     enableMoves(ns, mv)
758 :     | _ => enableMoves(ns, mv)
759 :     end (* enableMoves *)
760 :    
761 :     (*
762 :     * Simplify a list of nodes
763 :     *)
764 :     fun simplifyAll([], mv, fz, stack) = (mv, fz, stack)
765 :     | simplifyAll(n::ns, mv, fz, stack) =
766 :     let val (mv, fz, stack) = simplify(n, mv, fz, stack)
767 :     in simplifyAll(ns, mv, fz, stack) end
768 :    
769 :     (*
770 :     * Brigg's conservative coalescing test:
771 :     * given: an unconstrained move (x, y)
772 :     * return: true or false
773 :     *)
774 :     fun conservative(x as NODE{degree=ref dx, adj=xadj, (* pair=px, *) ...},
775 :     y as NODE{degree=ref dy, adj=yadj, (* pair=py, *) ...}) =
776 :     dx + dy < K orelse
777 :     let (*
778 :     * K-k -- is the number of nodes with deg > K
779 :     * n -- the number of nodes that have deg = K but not
780 :     * neighbors of both x and y.
781 :     * We use the movecnt as a flag indicating whether
782 :     * a node has been visited. A negative count is used to mark
783 :     * a visited node.
784 : monnier 427 *)
785 : monnier 469 fun undo([], v) = v
786 :     | undo(movecnt::tr, v) = (movecnt := ~1 - !movecnt; undo(tr, v))
787 :     fun loop([], [], 0, _, tr) = undo(tr, false)
788 :     | loop([], [], k, n, tr) = undo(tr, k > n)
789 :     | loop([], yadj, k, n, tr) = loop(yadj, [], k, n, tr)
790 :     | loop(NODE{color, movecnt as ref m, degree=ref deg, ...}::vs,
791 :     yadj, k, n, tr) =
792 :     (case !color of
793 :     COLORED _ =>
794 :     if m < 0 then
795 :     (* node has been visited before *)
796 :     if deg = K then loop(vs, yadj, k, n-1, tr)
797 :     else loop(vs, yadj, k, n, tr)
798 :     else
799 :     (movecnt := ~1 - m; (* mark as visited *)
800 :     loop(vs, yadj, k-1, n, movecnt::tr))
801 :     | PSEUDO =>
802 :     if deg < K then loop(vs, yadj, k, n, tr)
803 :     else if m >= 0 then
804 :     (* node has never been visited before *)
805 :     (movecnt := ~1 - m; (* mark as visited *)
806 :     if deg = K
807 :     then loop(vs, yadj, k, n+1, movecnt::tr)
808 :     else loop(vs, yadj, k-1, n, movecnt::tr)
809 :     )
810 :     else
811 :     (* node has been visited before *)
812 :     if deg = K then loop(vs, yadj, k, n-1, tr)
813 :     else loop(vs, yadj, k, n, tr)
814 :     | _ => loop(vs, yadj, k, n, tr) (* REMOVED/ALIASED *)
815 :     )
816 :     in loop(!xadj, !yadj, K, 0, []) end
817 :    
818 :     (*
819 :     * Heuristic used to determine whether a pseudo and machine register
820 :     * can be coalesced.
821 :     * Precondition:
822 :     * The two nodes are assumed not to interfere.
823 :     *)
824 :     fun safe(r, NODE{adj, ...}) =
825 :     let fun loop [] = true
826 :     | loop(n::adj) =
827 :     (case n of
828 :     NODE{color=ref(COLORED _),...} => loop adj (* can't be r! *)
829 :     | NODE{color=ref(ALIASED _),...} => loop adj (* not real *)
830 :     | NODE{color=ref(SPILLED _),...} => loop adj (* gone! *)
831 :     | NODE{color=ref(ALIASED_SPILL _),...} => loop adj (* gone! *)
832 :     | NODE{degree,...} => (* PSEUDO or REMOVED *)
833 :     (!degree < K orelse member(n, r)) andalso loop adj
834 :     )
835 :     in loop(!adj) end
836 :    
837 :     (*
838 :     * Decrement the active move count of a node.
839 :     * When the move count reaches 0 and the degree < K
840 :     * simplify the node immediately.
841 :     * Precondition: node must be a node in the interference graph
842 :     * The node can become a non-move related node.
843 :     *)
844 :     fun decMoveCnt
845 :     (node as NODE{movecnt, color=ref PSEUDO, degree, movecost,...},
846 :     cnt, cost, mv, fz, stack) =
847 :     let val newCnt = !movecnt - cnt
848 :     in movecnt := newCnt;
849 :     movecost := !movecost - cost;
850 :     if newCnt = 0 andalso !degree < K (* low degree and movecnt = 0 *)
851 :     then simplify(node, mv, fz, stack)
852 :     else (mv, fz, stack)
853 :     end
854 :     | decMoveCnt(_, _, _, mv, fz, stack) = (mv, fz, stack)
855 :    
856 :     (*
857 :     * Combine two nodes u and v into one.
858 :     * v is replaced by u
859 :     * u is the new combined node
860 :     * Precondition: u <> v and u and v must be unconstrained
861 :     *
862 :     * u, v -- two nodes to be merged, must be distinct!
863 :     * mvcost -- the cost of the move that has been eliminated
864 :     * mv -- the queue of moves
865 :     * fz -- the queue of freeze candidates
866 :     * stack -- stack of removed nodes
867 :     *)
868 :     fun combine(u, v, mvcost, mv, fz, stack) =
869 :     let val NODE{color=vcol, pri=pv, movecnt=cntv, movelist=movev, adj=adjv,
870 :     defs=defsv, uses=usesv, ...} = v
871 :     val NODE{color=ucol, pri=pu, movecnt=cntu, movelist=moveu, adj=adju,
872 :     defs=defsu, uses=usesu, ...} = u
873 : monnier 427
874 : monnier 469 (* merge movelists together, taking the opportunity
875 :     * to prune the lists
876 :     *)
877 :     fun mergeMoveList([], mv) = mv
878 :     | mergeMoveList((m as MV{status,...})::rest, mv) =
879 :     (case !status of
880 :     (MOVE | WORKLIST) => mergeMoveList(rest, m::mv)
881 :     | _ => mergeMoveList(rest, mv)
882 :     )
883 :    
884 :     (* Form combined node; add the adjacency list of v to u *)
885 :     fun union([], mv, fz, stack) = (mv, fz, stack)
886 :     | union((t as NODE{color, (* pair=pt, *) ...})::adj, mv, fz, stack) =
887 :     (case !color of
888 :     COLORED _ => (addEdge(t, u); union(adj, mv, fz, stack))
889 :     | PSEUDO =>
890 :     (addEdge(t, u);
891 :     let val (mv, fz, stack) = decDegree(t, mv, fz, stack)
892 :     in union(adj, mv, fz, stack) end
893 :     )
894 :     | _ => union(adj, mv, fz, stack)
895 :     )
896 :    
897 :     in vcol := ALIASED u;
898 :     (* combine the priority of both:
899 :     * note that since the mvcost has been counted twice
900 :     * in the original priority, we substract it twice
901 :     * from the new priority.
902 :     *)
903 :     pu := !pu + !pv;
904 :     (* combine the def/use pts of both nodes.
905 :     * Strictly speaking, the def/use points of the move
906 :     * should also be removed. But since we never spill
907 :     * a coalesced node and only spilling makes use of these
908 :     * def/use points, we are safe for now. (NOTE to SELF:
909 :     * I think it is not necessary to maintain these.
910 :     *)
911 :     (* defsu := !defsu @ !defsv;
912 :     usesu := !usesu @ !usesv; *)
913 :     case !ucol of
914 :     PSEUDO =>
915 :     (if !cntv > 0 then moveu := mergeMoveList(!movev, !moveu) else ();
916 :     movev := []; (* XXX kill the list to free space *)
917 :     cntu := !cntu + !cntv
918 :     )
919 :     | _ => ()
920 :     ;
921 :     cntv := 0;
922 :    
923 :     (* Update the move count of the combined node *)
924 :     let val (mv, fz, stack) = union(!adjv, mv, fz, stack)
925 :     in decMoveCnt(u, 2, mvcost + mvcost, mv, fz, stack)
926 :     end
927 :     end
928 :    
929 :     (*
930 :     * COALESCE:
931 :     * Repeat coalescing and simplification until mv is empty.
932 :     *)
933 :     fun coalesce(MV.EMPTY, fz, stack, undo) = (fz, stack, undo)
934 :     | coalesce(MV.TREE(MV{src, dst, status, cost, ...}, _, l, r),
935 :     fz, stack, undo)=
936 :     let val u = chase src
937 :     val v as NODE{color=ref vcol, ...} = chase dst
938 :     (* make u the colored one *)
939 :     val (u as NODE{number=u', color=ref ucol, ...},
940 :     v as NODE{number=v', color=ref vcol, ...}) =
941 :     case vcol of
942 :     COLORED _ => (v, u)
943 :     | _ => (u, v)
944 :     val _ = if debug then print ("Coalescing "^show u^"<->"^show v
945 :     ^" ("^Int.toString cost^")") else ()
946 :     val mv = MV.merge(l, r)
947 :     fun coalesceIt(status, v, undo) =
948 :     (status := COALESCED;
949 :     if !spillFlag then UNDO(v, status, undo) else undo
950 :     )
951 :    
952 :     (* mark u and v as constrained *)
953 :     fun constrained(status, u, v, mv, fz, stack, undo) =
954 :     let val _ = status := CONSTRAINED
955 :     val (mv, fz, stack) = decMoveCnt(u, 1, cost, mv, fz, stack)
956 :     val (mv, fz, stack) = decMoveCnt(v, 1, cost, mv, fz, stack)
957 :     in (mv, fz, stack, undo) end
958 :    
959 :     (* coalesce u and v *)
960 :     fun union(status, u, v, mv, fz, stack, undo) =
961 :     let val undo = coalesceIt(status, v, undo)
962 :     val (mv, fz, stack) = combine(u, v, cost, mv, fz, stack)
963 :     in (mv, fz, stack, undo) end
964 :    
965 :     in if u' = v' then (* trivial move *)
966 :     let val undo = coalesceIt(status, v, undo)
967 :     val (mv, fz, stack) =
968 :     decMoveCnt(u, 2, cost+cost, mv, fz, stack)
969 :     val _ = if debug then print(" Trivial\n") else ()
970 :     in coalesce(mv, fz, stack, undo) end
971 :     else
972 :     (case vcol of
973 :     COLORED _ =>
974 :     (* two colored nodes cannot be coalesced *)
975 :     (if debug then print(" Both Colored\n") else ();
976 :     status := CONSTRAINED;
977 :     coalesce(mv, fz, stack, undo))
978 :     | _ =>
979 :     if member(u, v) then
980 :     (* u and v interfere *)
981 :     (if debug then print(" Interfere\n") else ();
982 :     coalesce(constrained(status, u, v, mv, fz, stack, undo)))
983 :     else
984 :     case ucol of
985 :     COLORED _ => (* u is colored, v is not *)
986 :     if safe(u, v) then
987 :     (if debug then print(" Safe\n") else ();
988 :     coalesce(union(status, u, v, mv, fz, stack, undo)))
989 :     else
990 :     (status := MOVE; (* remove it from the move list *)
991 :     if debug then print(" Unsafe\n") else ();
992 :     coalesce(mv, fz, stack, undo)
993 :     )
994 :     | _ => (* u, v are not colored *)
995 :     if conservative(u, v) then
996 :     (if debug then print(" OK\n") else ();
997 :     coalesce(union(status, u, v, mv, fz, stack, undo)))
998 :     else (* conservative test failed *)
999 :     (status := MOVE; (* remove it from the move list *)
1000 :     if debug then print(" Non-conservative\n") else ();
1001 :     coalesce(mv, fz, stack, undo)
1002 :     )
1003 :     )
1004 :     end
1005 :    
1006 :     (* mark a node n as frozen:
1007 :     * Go thru all the moves (n, m), decrement the move count of m
1008 :     * precondition: degree must be < K
1009 :     * movecnt must be > 0
1010 :     * node -- the node to be frozen
1011 :     * fz -- a queue of freeze candidates
1012 :     * stack -- stack of removed nodes
1013 :     *)
1014 :     fun markAsFrozen(node as NODE{number=me, movelist, movecnt as ref mc,...},
1015 :     fz, stack) =
1016 :     let val _ = if debug then print("Mark as frozen "^Int.toString me^"\n")
1017 :     else ()
1018 :     (* eliminate all moves, return a list of nodes that
1019 :     * can be simplified
1020 :     *)
1021 :     fun elimMoves([], simp) = simp
1022 :     | elimMoves(MV{status, src, dst, ...}::mvs, simp) =
1023 :     case !status of
1024 :     WORKLIST => error "elimMoves"
1025 :     | MOVE => (* mark move as lost *)
1026 :     let val _ = status := LOST
1027 :     val src as NODE{number=s,...} = chase src
1028 :     val dst = chase dst
1029 :     val you = if s = me then dst else src
1030 :     in case you of
1031 :     NODE{color=ref(COLORED _),...} =>
1032 :     elimMoves(mvs, simp)
1033 :     | NODE{movecnt as ref c, degree, ...} => (* pseudo *)
1034 :     (movecnt := c - 1;
1035 :     if c = 1 andalso !degree < K then
1036 :     elimMoves(mvs, you::simp)
1037 :     else
1038 :     elimMoves(mvs, simp)
1039 :     )
1040 :     end
1041 :     | _ => elimMoves(mvs, simp)
1042 :    
1043 :     val (mv, fz, stack) =
1044 :     if mc = 0 then (MV.EMPTY, fz, stack)
1045 :     else
1046 :     let val _ = movecnt := 0;
1047 :     val simp = elimMoves(!movelist, [])
1048 :     in simplifyAll(simp, MV.EMPTY, fz, stack) end
1049 :     in simplify(node, mv, fz, stack)
1050 : monnier 427 end
1051 :    
1052 : monnier 469 (*
1053 :     * FREEZE:
1054 :     * Repeat picking
1055 :     * a node with degree < K from the freeze list and freeze it.
1056 :     * fz -- queue of freezable nodes
1057 :     * stack -- stack of removed nodes
1058 :     * undo -- trail of coalesced moves after potential spill
1059 : monnier 427 *)
1060 : monnier 469 fun freeze(fz, stack, undo) =
1061 :     let fun loop(FZ.EMPTY, FZ.EMPTY, stack, undo) = (stack, undo)
1062 :     | loop(FZ.EMPTY, newFz, _, _) = error "no freeze candidate"
1063 :     (*
1064 :     let fun loop(FZ.TREE(n,_,l,r)) =
1065 :     (print("Non candidate "^show n^"\n");
1066 :     loop(FZ.merge(l,r)))
1067 :     | loop(FZ.EMPTY) = ()
1068 :     in dumpGraph G TextIO.stdOut;
1069 :     loop newFz;
1070 :     error "no freeze candidate"
1071 :     end
1072 :     *)
1073 :     | loop(FZ.TREE(node, _, l, r), newFz, stack, undo) =
1074 :     let val fz = FZ.merge(l, r)
1075 :     in case node of
1076 :     (* This node has not been simplified
1077 :     * This must be a move-related node.
1078 :     *)
1079 :     NODE{color=ref PSEUDO, degree, movecnt, movecost, ...} =>
1080 :     if !degree >= K (* can't be frozen? *)
1081 :     then (* if !movecnt = 0 (* non-freeze candidate *)
1082 :     then loop(fz, newFz, stack, undo)
1083 :     else *) loop(fz, FZ.add(node, newFz), stack, undo)
1084 :     else (* freeze node *)
1085 :     let val _ = if debug then
1086 :     print("Freezing "^show node
1087 :     ^" movecnt="^Int.toString(!movecnt)^
1088 :     " ("^Int.toString(!movecost)^")\n")
1089 :     else ()
1090 :     val (mv, fz, stack) = markAsFrozen(node, fz, stack)
1091 :     val (fz, stack, undo) = coalesce(mv, fz, stack, undo)
1092 :     in loop(FZ.merge(fz, newFz), FZ.EMPTY, stack, undo)
1093 :     end
1094 :     | _ => loop(fz, newFz, stack, undo)
1095 :     end
1096 :     in loop(fz, FZ.EMPTY, stack, undo)
1097 : monnier 427 end
1098 : monnier 469
1099 :     (*
1100 :     * Iterate over simplify, coalesce, freeze
1101 :     *)
1102 :     fun iterate{simplifyWkl, moveWkl, freezeWkl, stack} =
1103 :     let (* simplify everything *)
1104 :     val (mv, fz, stack) =
1105 :     simplifyAll(simplifyWkl, moveWkl, freezeWkl, stack)
1106 :     val (fz, stack, undo) = coalesce(mv, fz, stack, !trail)
1107 :     val (stack, undo) = freeze(fz, stack, undo)
1108 :     in trail := undo;
1109 :     {stack=stack}
1110 :     end
1111 :     in {markAsFrozen=markAsFrozen, iterate=iterate}
1112 : monnier 427 end
1113 :    
1114 : monnier 469 (*
1115 :     * The main entry point for the iterated coalescing algorithm
1116 :     *)
1117 :     fun iteratedCoalescing G =
1118 :     let val {iterate,...} = iteratedCoalescingPhases G
1119 :     in iterate end
1120 : monnier 427
1121 : monnier 469
1122 :     (*
1123 :     * Potential Spill:
1124 :     * Find some node on the spill list and just optimistically
1125 :     * remove it from the graph.
1126 :     *)
1127 :     fun potentialSpillNode (G as G.GRAPH{spillFlag,...}) =
1128 :     let val {markAsFrozen,...} = iteratedCoalescingPhases G
1129 :     in fn {node, stack} =>
1130 :     let val _ = spillFlag := true (* potential spill found *)
1131 :     val (mv, fz, stack) = markAsFrozen(node, FZ.EMPTY, stack)
1132 :     in {moveWkl=mv, freezeWkl=fz, stack=stack}
1133 :     end
1134 :     end
1135 :    
1136 :    
1137 :    
1138 :     (*
1139 :     * SELECT:
1140 :     * Using optimistic spilling
1141 :     *)
1142 :     fun select(G as GRAPH{getreg, getpair, trail, firstPseudoR, stamp,
1143 :     spillFlag, proh, ...})
1144 :     {stack, biased} =
1145 :     let fun undoCoalesced END = ()
1146 :     | undoCoalesced(UNDO(NODE{number, color, ...}, status, trail)) =
1147 :     (status := MOVE;
1148 :     if number < firstPseudoR then () else color := PSEUDO;
1149 :     undoCoalesced trail
1150 :     )
1151 :     val show = show G
1152 :    
1153 :     (* Fast coloring, assume no spilling can occur *)
1154 :     fun fastcoloring([], stamp) = ([], stamp)
1155 :     | fastcoloring((node as NODE{color, (* pair, *) adj, ...})::stack,
1156 :     stamp) =
1157 :     let (* set up the proh array *)
1158 : monnier 427 fun neighbors [] = ()
1159 : monnier 469 | neighbors(r::rs) =
1160 :     let fun mark(NODE{color=ref(COLORED c), ...}) =
1161 :     (UA.update(proh, c, stamp); neighbors rs)
1162 :     | mark(NODE{color=ref(ALIASED n), ...}) = mark n
1163 :     | mark _ = neighbors rs
1164 :     in mark r end
1165 : monnier 427 val _ = neighbors(!adj)
1166 : monnier 469 in color := COLORED(getreg{pref=[], proh=proh, stamp=stamp});
1167 :     fastcoloring(stack, stamp+1)
1168 :     end
1169 :    
1170 :     (* Briggs' optimistic spilling heuristic *)
1171 :     fun optimistic([], spills, stamp) = (spills, stamp)
1172 :     | optimistic((node as NODE{color, (* pair, *) adj, ...})::stack,
1173 :     spills, stamp) =
1174 :     let (* set up the proh array *)
1175 :     fun neighbors [] = ()
1176 :     | neighbors(r::rs) =
1177 :     let fun mark(NODE{color=ref(COLORED c), ...}) =
1178 :     (UA.update(proh, c, stamp); neighbors rs)
1179 :     | mark(NODE{color=ref(ALIASED n), ...}) = mark n
1180 :     | mark _ = neighbors rs
1181 :     in mark r end
1182 :     val _ = neighbors(!adj)
1183 : monnier 427 val spills =
1184 : monnier 469 let val col = getreg{pref=[], proh=proh, stamp=stamp}
1185 :     in color := COLORED col; spills
1186 : monnier 427 end handle _ => node::spills
1187 : monnier 469 in optimistic(stack, spills, stamp+1) end
1188 :    
1189 :     (* Briggs' optimistic spilling heuristic, with biased coloring *)
1190 :     fun biasedColoring([], spills, stamp) = (spills, stamp)
1191 :     | biasedColoring(
1192 :     (node as NODE{number, color, adj,
1193 :     (* pair, *) movecnt, movelist,...})::stack,
1194 :     spills, stamp) =
1195 :     let (* set up the proh array *)
1196 :     fun neighbors [] = ()
1197 :     | neighbors(r::rs) =
1198 :     (case chase r of
1199 :     NODE{color=ref(COLORED c), ...} =>
1200 :     (UA.update(proh, c, stamp); neighbors rs)
1201 :     | _ => neighbors rs
1202 :     )
1203 :     (*
1204 :     * Look at lost moves and see if it is possible to
1205 :     * color the move with the same color
1206 :     *)
1207 :     fun getPref([], pref) = pref
1208 :     | getPref(MV{status=ref LOST, src, dst, ...}::mvs, pref) =
1209 :     let val src as NODE{number=s,...} = chase src
1210 :     val dst = chase dst
1211 :     val other = if s = number then dst else src
1212 :     in case other of
1213 :     NODE{color=ref(COLORED c),...} => getPref(mvs, c::pref)
1214 :     | _ => getPref(mvs, pref)
1215 :     end
1216 :     | getPref(_::mvs, pref) = getPref(mvs, pref)
1217 :    
1218 :     val _ = neighbors(!adj)
1219 :     val pref = getPref(!movelist,[])
1220 :     val spills =
1221 :     let val col = getreg{pref=[], proh=proh, stamp=stamp}
1222 :     in color := COLORED col; spills
1223 :     end handle _ => node::spills
1224 :     in biasedColoring(stack, spills, stamp+1) end
1225 :     val (spills, st) = if biased
1226 :     then biasedColoring(stack, [], !stamp)
1227 :     else if !spillFlag then
1228 :     optimistic(stack, [], !stamp)
1229 :     else
1230 :     fastcoloring(stack, !stamp)
1231 :     in stamp := st;
1232 :     case spills of
1233 :     [] => {spills=[]}
1234 :     | spills =>
1235 :     (app (fn node as NODE{color,...} => color := PSEUDO) stack;
1236 :     undoCoalesced (!trail);
1237 :     trail := END;
1238 :     {spills=spills}
1239 :     )
1240 :     end
1241 :    
1242 :     (*
1243 :     * Spill coalescing.
1244 :     * Coalesce non-interfering moves between spilled nodes,
1245 :     * in non-increasing order of move cost.
1246 :     *)
1247 :     fun spillCoalescing(GRAPH{bitMatrix, ...}) nodesToSpill =
1248 :     let val marker = SPILLED(~1)
1249 :     fun mark [] = ()
1250 :     | mark(NODE{color, ...}::ns) = (color := marker; mark ns)
1251 :     val _ = mark nodesToSpill
1252 :     fun chase(NODE{color=ref(ALIASED_SPILL n), ...}) = chase n
1253 :     | chase(NODE{color=ref(ALIASED n), ...}) = chase n
1254 :     | chase n = n
1255 :     fun collectMoves([], mv') = mv'
1256 :     | collectMoves(NODE{movelist, number, ...}::ns, mv') =
1257 :     let fun addMoves([], mv') = collectMoves(ns, mv')
1258 :     | addMoves((mv as MV{dst,src,status=ref LOST, ...})::mvs, mv') =
1259 :     (case (chase dst, chase src) of
1260 :     (NODE{color=ref(SPILLED ~1), number=d, ...},
1261 :     NODE{color=ref(SPILLED ~1), number=s, ...}) =>
1262 :     if d = s then addMoves(mvs, mv')
1263 :     else addMoves(mvs, MV.add(mv, mv'))
1264 :     | _ => addMoves(mvs, mv')
1265 :     )
1266 :     | addMoves(_::mvs, mv') = addMoves(mvs, mv')
1267 :     in addMoves(!movelist, mv') end
1268 :     val mvs = collectMoves(nodesToSpill, MV.EMPTY)
1269 :     val member = BM.member(!bitMatrix)
1270 :     val addEdge = BM.add(!bitMatrix)
1271 :     fun coalesceMoves(MV.EMPTY) = ()
1272 :     | coalesceMoves(MV.TREE(MV{dst, src, ...}, _, l, r)) =
1273 :     let val dst as NODE{number=d, uses=u1, defs=d1,
1274 :     color, adj=adj1, ...} = chase dst
1275 :     val src as NODE{number=s, uses=u2, defs=d2, adj=adj2, ...} =
1276 :     chase src
1277 :     fun addEdges [] = ()
1278 :     | addEdges(n::adj) =
1279 :     (case chase n of
1280 :     n as NODE{color=ref(SPILLED ~1), number=t, ...} =>
1281 :     (if addEdge(s,t) then adj2 := n :: !adj2 else ();
1282 :     addEdges adj)
1283 :     | _ => addEdges adj
1284 :     )
1285 :     in if d = s orelse member(dst, src) then ()
1286 :     else ((* print(Int.toString d ^"<->"^Int.toString s^"\n"); *)
1287 :     color := ALIASED_SPILL src; addEdges(!adj1)
1288 :     );
1289 :     coalesceMoves(MV.merge(l,r))
1290 : monnier 427 end
1291 : monnier 469 in coalesceMoves mvs
1292 : monnier 427 end
1293 :    
1294 :     (*
1295 : monnier 469 * Spill coloring.
1296 :     * Assign logical spill locations to all the spill nodes.
1297 : monnier 427 *)
1298 : monnier 469 fun spillColoring(GRAPH{spillLoc, ...}) nodesToSpill =
1299 :     let val proh = A.array(length nodesToSpill, ~1)
1300 :     val firstLoc = !spillLoc
1301 :     val _ = spillLoc := firstLoc - 1 (* allocate one location *)
1302 :     fun selectColor([], currLoc) = ()
1303 :     | selectColor(NODE{color as ref(SPILLED _), number, adj, ...}::nodes,
1304 :     currLoc) =
1305 :     let fun chase(NODE{color=ref(ALIASED_SPILL n), ...}) = chase n
1306 :     | chase(NODE{color=ref(ALIASED n), ...}) = chase n
1307 :     | chase n = n
1308 :     fun neighbors [] = ()
1309 :     | neighbors(n::ns) =
1310 :     (case chase n of
1311 :     NODE{color=ref(SPILLED loc), ...} =>
1312 :     if loc >= ~1 then () (* no location yet *)
1313 :     else A.update(proh, firstLoc - loc, number)
1314 :     | _ => ();
1315 :     neighbors ns
1316 :     )
1317 :     val _ = neighbors(!adj)
1318 :     fun findColor(loc, startingPoint) =
1319 :     let val loc = if loc < firstLoc then !spillLoc + 1 else loc
1320 :     in if A.sub(proh, firstLoc - loc) <> number then loc (* ok *)
1321 :     else if loc = startingPoint then (* new location *)
1322 :     let val loc = !spillLoc
1323 :     in spillLoc := loc - 1; loc end
1324 :     else findColor(loc - 1, startingPoint)
1325 :     end
1326 :     val currLoc = if currLoc < firstLoc then !spillLoc + 1
1327 :     else currLoc
1328 :     val loc = findColor(currLoc, currLoc)
1329 :     in color := SPILLED loc;
1330 :     selectColor(nodes, loc - 1)
1331 :     end
1332 :     | selectColor(_::nodes, currLoc) = selectColor(nodes, currLoc)
1333 :     in selectColor(nodesToSpill, firstLoc)
1334 : monnier 427 end
1335 :    
1336 : monnier 469 (*
1337 :     * Update the regmap, after finishing register allocation.
1338 :     * All nodes must have been colored.
1339 :     *)
1340 :     fun finishRA(GRAPH{regmap, nodes, deadCopies, ...}) =
1341 :     let val enter = Intmap.add regmap
1342 :     fun set(r, NODE{color=ref(COLORED c),...}) = enter(r, c)
1343 :     | set(r, NODE{color=ref(ALIASED n),...}) = set(r, n)
1344 :     | set(r, NODE{color=ref(SPILLED _),...}) = enter(r,~1) (* XXX *)
1345 :     | set(r, NODE{color=ref(ALIASED_SPILL _),...}) = enter(r,~1) (* XXX *)
1346 :     | set _ = error "finishRA"
1347 :     in Intmap.app set nodes;
1348 :     case !deadCopies of
1349 :     [] => ()
1350 :     | dead => app (fn r => enter(r, ~1)) dead
1351 :     end
1352 : monnier 427
1353 : monnier 469 (*
1354 :     * Update the regmap, after copy propagation
1355 :     *)
1356 :     fun finishCP(GRAPH{regmap, nodes,...}) =
1357 :     let val enter = Intmap.add regmap
1358 :     in Intmap.app
1359 :     (fn (r, node as NODE{color as ref(ALIASED _),...}) =>
1360 :     (case chase node of
1361 :     NODE{color=ref(COLORED c),...} => enter(r, c)
1362 :     | NODE{color=ref PSEUDO, number,...} => enter(r, number)
1363 :     | NODE{color=ref REMOVED, number,...} => enter(r, number)
1364 :     | _ => error "finishCP"
1365 :     )
1366 :     | _ => ()
1367 :     ) nodes
1368 :     end
1369 :    
1370 :     (*
1371 :     * Clear the interference graph, but keep the nodes
1372 :     *)
1373 :     fun clearGraph(GRAPH{bitMatrix, maxRegs, trail, spillFlag, deadCopies, ...}) =
1374 :     let val edges = BM.edges(!bitMatrix)
1375 :     in trail := END;
1376 :     spillFlag := false;
1377 :     bitMatrix := BM.empty;
1378 :     deadCopies := [];
1379 :     bitMatrix := G.newBitMatrix{edges=edges, maxRegs=maxRegs()}
1380 :     end
1381 :    
1382 :     fun clearNodes(GRAPH{nodes,...}) =
1383 :     let fun init(_, NODE{pri, degree, adj, movecnt, movelist,
1384 :     movecost, defs, uses, ...}) =
1385 :     (pri := 0; degree := 0; adj := []; movecnt := 0; movelist := [];
1386 :     defs := []; uses := []; movecost := 0)
1387 :     in Intmap.app init nodes
1388 :     end
1389 :    
1390 :     end

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