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 579 - (view) (download)

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 498 val debug = false
73 :     (* val tally = false *)
74 :    
75 :    
76 : monnier 475 val verbose = MLRiscControl.getFlag "ra-verbose"
77 :     val ra_spill_coal = MLRiscControl.getCounter "ra-spill-coalescing"
78 :     val ra_spill_prop = MLRiscControl.getCounter "ra-spill-propagation"
79 : monnier 469
80 : monnier 498 (*
81 :     val good_briggs = MLRiscControl.getCounter "good-briggs"
82 :     val bad_briggs = MLRiscControl.getCounter "bad-briggs"
83 :     val good_george = MLRiscControl.getCounter "good-george"
84 :     val bad_george = MLRiscControl.getCounter "bad-george"
85 :     val good_freeze = MLRiscControl.getCounter "good-freeze"
86 :     val bad_freeze = MLRiscControl.getCounter "bad-freeze"
87 :     *)
88 :    
89 : george 545 val NO_OPTIMIZATION = 0wx0
90 :     val BIASED_SELECTION = 0wx1
91 :     val DEAD_COPY_ELIM = 0wx2
92 :     val COMPUTE_SPAN = 0wx4
93 :     val SAVE_COPY_TEMPS = 0wx8
94 :     val HAS_PARALLEL_COPIES = 0wx10
95 : leunga 579 val SPILL_COALESCING = 0wx100
96 :     val SPILL_COLORING = 0wx200
97 :     val SPILL_PROPAGATION = 0wx400
98 :     val MEMORY_COALESCING =
99 :     SPILL_COALESCING + SPILL_COLORING + SPILL_PROPAGATION
100 : monnier 498
101 : leunga 579
102 : monnier 498 local
103 :    
104 :     fun isOn(flag,mask) = Word.andb(flag,mask) <> 0w0
105 :    
106 : monnier 469 fun error msg = MLRiscErrorMsg.error("RACore", msg)
107 :    
108 :     (* No overflow checking necessary here *)
109 :     fun x + y = W.toIntX(W.+(W.fromInt x, W.fromInt y))
110 :     fun x - y = W.toIntX(W.-(W.fromInt x, W.fromInt y))
111 :    
112 : monnier 475 fun concat([], b) = b
113 :     | concat(x::a, b) = concat(a, x::b)
114 :    
115 : monnier 498 in
116 :    
117 : monnier 469 (*
118 :     * Bit Matrix routines
119 : monnier 427 *)
120 : monnier 469 structure BM =
121 :     struct
122 :     fun hashFun(i, j, shift, size) =
123 : monnier 498 let val i = W.fromInt i
124 :     val j = W.fromInt j
125 :     val h = W.+(W.<<(i, shift), W.+(i, j))
126 :     val mask = W.-(W.fromInt size, 0w1)
127 :     in W.toIntX(W.andb(h, mask)) end
128 : monnier 427
129 : monnier 469 val empty = BM{table=SMALL(ref(A.array(0, [])), 0w0), elems=ref 0, edges=0}
130 : monnier 427
131 : monnier 469 (*
132 :     val indices = A.array(1024,0)
133 : monnier 427
134 : monnier 469 fun init(i,j) =
135 :     if i < 1024 then
136 :     (A.update(indices, i, j); init(i+1, i+j+1))
137 :     else ()
138 :    
139 :     val _ = init(0, 0)
140 :     *)
141 :    
142 :     fun edges(BM{table=SMALL(ref table, _), ...}) = A.length table
143 :     | edges(BM{table=LARGE(ref table, _), ...}) = A.length table
144 :     (*| edges(BM{table=BITMATRIX _, edges, ...}) = edges *)
145 :    
146 :     fun member(BM{table=SMALL(table, shift), ...}) =
147 : monnier 498 (fn (i, j) =>
148 : monnier 469 let val (i,j) = if i < j then (i, j) else (j, i)
149 :     val k = W.+(W.<<(W.fromInt i, 0w15), W.fromInt j)
150 :     fun find [] = false
151 :     | find(k'::b) = k = k' orelse find b
152 :     val tab = !table
153 :     in find(UA.sub(tab, hashFun(i, j, shift, A.length tab))) end
154 :     )
155 :     | member(BM{table=LARGE(table, shift), ...}) =
156 : monnier 498 (fn (i, j) =>
157 : monnier 469 let val (i,j) = if i < j then (i, j) else (j, i)
158 :     fun find NIL = false
159 :     | find(B(i',j',b)) = i = i' andalso j = j' orelse find b
160 :     val tab = !table
161 :     in find(UA.sub(tab, hashFun(i, j, shift, A.length tab))) end
162 :     )
163 : monnier 498 (*
164 : monnier 469 | member(BM{table=BITMATRIX table, ...}) =
165 : monnier 498 (fn (i, j) =>
166 : monnier 469 let val (i,j) = if i > j then (i, j) else (j, i)
167 :     val bit = W.fromInt(UA.sub(indices, i) + j)
168 :     val index = W.toIntX(W.>>(bit, 0w3))
169 :     val mask = W.<<(0w1, W.andb(bit, 0w7))
170 :     in W.andb(W.fromInt(W8.toInt(UW8A.sub(table, index))), mask) <> 0w0
171 :     end
172 :     )
173 : monnier 498 *)
174 : monnier 469
175 :     fun add (BM{table=SMALL(table, shift), elems, ...}) =
176 :     let fun insert(i, j) =
177 :     let val (i,j) = if i < j then (i, j) else (j, i)
178 :     val tab = !table
179 :     val len = A.length tab
180 :     in if !elems < len then
181 :     let val index = hashFun(i, j, shift, len)
182 :     val k = W.+(W.<<(W.fromInt i, 0w15), W.fromInt j)
183 :     fun find [] = false
184 :     | find(k'::b) = k = k' orelse find b
185 :     val b = UA.sub(tab, index)
186 :     in if find b then false
187 :     else (UA.update(tab, index, k::b);
188 :     elems := !elems + 1; true)
189 :     end
190 :     else (* grow table *)
191 :     let val oldTable = tab
192 :     val oldSize = A.length oldTable
193 :     val newSize = oldSize + oldSize
194 :     val newTable = A.array(newSize,[])
195 :     fun enter n =
196 :     if n < oldSize then
197 :     let fun loop([],a,b) =
198 :     (UA.update(newTable, n, a);
199 :     UA.update(newTable, n + oldSize, b);
200 :     enter(n+1))
201 :     | loop(k::l,a,b) =
202 :     let val i = W.toIntX(W.>>(k, 0w15))
203 :     val j = W.toIntX(W.-(k,W.<<(W.fromInt i, 0w15)))
204 :     in if hashFun(i, j, shift, newSize) = n
205 :     then loop(l, k::a, b)
206 :     else loop(l, a, k::b)
207 :     end
208 :     in loop(UA.sub(oldTable, n), [], []) end
209 :     else ()
210 :     in table := newTable;
211 :     enter 0;
212 :     insert(i, j)
213 :     end
214 :     end
215 :     in insert
216 :     end
217 :     | add (BM{table=LARGE(table, shift), elems, ...}) =
218 :     let fun insert(i, j) =
219 :     let val (i,j) = if i < j then (i, j) else (j, i)
220 :     val tab = !table
221 :     val len = A.length tab
222 :     in if !elems < len then
223 : george 545 let val index = hashFun(i, j, shift, len)
224 : monnier 469 fun find NIL = false
225 :     | find(B(i',j',b)) = i = i' andalso j = j' orelse find b
226 :     val b = UA.sub(tab, index)
227 :     in if find b then false
228 :     else (UA.update(tab, index, B(i,j,b));
229 :     elems := !elems + 1; true)
230 :     end
231 :     else (* grow table *)
232 :     let val oldTable = tab
233 :     val oldSize = A.length oldTable
234 :     val newSize = oldSize + oldSize
235 :     val newTable = A.array(newSize,NIL)
236 :     fun enter n =
237 :     if n < oldSize then
238 :     let fun loop(NIL,a,b) =
239 :     (UA.update(newTable, n, a);
240 :     UA.update(newTable, n + oldSize, b);
241 :     enter(n+1))
242 :     | loop(B(i,j,l),a,b) =
243 :     if hashFun(i, j, shift, newSize) = n
244 :     then loop(l, B(i,j,a), b)
245 :     else loop(l, a, B(i,j,b))
246 :     in loop(UA.sub(oldTable, n), NIL, NIL) end
247 :     else ()
248 :     in table := newTable;
249 :     enter 0;
250 :     insert(i, j)
251 :     end
252 :     end
253 :     in insert
254 :     end
255 : monnier 498 (*
256 : monnier 469 | add(BM{table=BITMATRIX table, ...}) =
257 :     (fn (i, j) =>
258 :     let val (i,j) = if i > j then (i, j) else (j, i)
259 :     val bit = W.fromInt(UA.sub(indices, i) + j)
260 :     val index = W.toIntX(W.>>(bit, 0w3))
261 :     val mask = W.<<(0w1, W.andb(bit, 0w7))
262 :     val value = W.fromInt(W8.toInt(UW8A.sub(table, index)))
263 :     in if W.andb(value, mask) <> 0w0 then false
264 :     else (UW8A.update(table, index,
265 :     W8.fromInt(W.toIntX(W.orb(value, mask)))); true)
266 :     end
267 :     )
268 : monnier 498 *)
269 : monnier 469
270 :     fun delete (BM{table=SMALL(table, shift), elems, ...}) =
271 :     (fn (i,j) =>
272 :     let val k = W.+(W.<<(W.fromInt i, 0w15), W.fromInt j)
273 :     fun find [] = []
274 :     | find(k'::b) =
275 :     if k = k' then (elems := !elems - 1; b) else find b
276 :     val tab = !table
277 :     val index = hashFun(i, j, shift, A.length tab)
278 :     val n = !elems
279 :     in UA.update(tab, index, find(UA.sub(tab, index)));
280 :     !elems <> n
281 :     end
282 :     )
283 :     | delete (BM{table=LARGE(table, shift), elems, ...}) =
284 :     (fn (i,j) =>
285 :     let fun find NIL = NIL
286 :     | find(B(i', j', b)) =
287 :     if i = i' andalso j = j' then (elems := !elems - 1; b)
288 :     else B(i', j', find b)
289 :     val tab = !table
290 :     val index = hashFun(i, j, shift, A.length tab)
291 :     val n = !elems
292 :     in UA.update(tab, index, find(UA.sub(tab, index)));
293 :     !elems <> n
294 :     end
295 :     )
296 :     (*
297 :     | delete(BM{table=BITMATRIX table, ...}) =
298 :     (fn (i, j) =>
299 :     let val (i,j) = if i > j then (i, j) else (j, i)
300 :     val bit = W.fromInt(UA.sub(indices, i) + j)
301 :     val index = W.toIntX(W.>>(bit, 0w3))
302 :     val mask = W.-(W.<<(0w1, W.andb(bit, 0w7)), 0w1)
303 :     val value = W.fromInt(W8.toInt(UW8A.sub(table, index)))
304 :     in if W.andb(value, mask) = 0w0 then false
305 :     else (UW8A.update(table, index,
306 :     W8.fromInt(W.toIntX(W.andb(value,W.notb mask))));
307 :     true)
308 :     end
309 :     )
310 :     *)
311 :     end
312 :    
313 :    
314 :     (*
315 :     * Priority Queue. Let's hope the compiler will inline it for performance
316 :     *)
317 :     functor PriQueue(type elem val less : elem * elem -> bool) =
318 :     struct
319 :    
320 :    
321 :     (* A leftist tree is a binary tree with priority ordering
322 :     * with the invariant that the left branch is always the taller one
323 :     *)
324 :     type elem = elem
325 : monnier 498 datatype pri_queue = TREE of elem * int * pri_queue * pri_queue | EMPTY
326 : monnier 469
327 :     fun merge'(EMPTY, EMPTY) = (EMPTY, 0)
328 :     | merge'(EMPTY, a as TREE(_, d, _, _)) = (a, d)
329 :     | merge'(a as TREE(_, d, _, _), EMPTY) = (a, d)
330 :     | merge'(a as TREE(x, d, l, r), b as TREE(y, d', l', r')) =
331 :     let val (root, l, r1, r2) =
332 :     if less(x, y) then (x, l, r, b) else (y, l', r', a)
333 :     val (r, d_r) = merge'(r1, r2)
334 : monnier 498 val d_l = case l of EMPTY => 0 | TREE(_, d, _, _) => d
335 :     val (l, r, d_t) = if d_l >= d_r then (l, r, d_l+1) else (r, l, d_r+1)
336 : monnier 469 in (TREE(root, d_t, l, r), d_t) end
337 :    
338 : monnier 498 fun merge(a, b) = #1(merge'(a, b))
339 : monnier 469
340 :     fun add (x, EMPTY) = TREE(x, 1, EMPTY, EMPTY)
341 :     | add (x, b as TREE(y, d', l', r')) =
342 :     if less(x,y) then TREE(x, d'+1, b, EMPTY)
343 :     else #1(merge'(TREE(x, 1, EMPTY, EMPTY), b))
344 :     end
345 :    
346 :     structure FZ = PriQueue
347 :     (type elem=node
348 : leunga 579 fun less(NODE{movecost=ref p1,...}, NODE{movecost=ref p2,...}) = p1 <= p2
349 : monnier 469 )
350 :     structure MV = PriQueue
351 :     (type elem=G.move
352 : leunga 579 fun less(MV{cost=p1,...}, MV{cost=p2,...}) = p1 >= p2
353 : monnier 469 )
354 : monnier 498
355 : monnier 469 type move_queue = MV.pri_queue
356 :     type freeze_queue = FZ.pri_queue
357 :    
358 :    
359 :     (*
360 :     * Utility functions
361 :     *)
362 : monnier 427 fun chase(NODE{color=ref(ALIASED r), ...}) = chase r
363 :     | chase x = x
364 :    
365 : monnier 469 fun colorOf(G.GRAPH{showReg,...}) (NODE{number, color, pri,...}) =
366 :     showReg number^
367 :     (case !color of
368 : monnier 498 PSEUDO => ""
369 :     | REMOVED => "r"
370 :     | ALIASED _ => "a"
371 :     | COLORED c => "["^showReg c^"]"
372 :     | SPILLED ~1 => "s"
373 :     | SPILLED c => (if c >= 0 then "m" else "s")^
374 :     (if c >= 0 andalso number = c then ""
375 :     else "{"^Int.toString c^"}")
376 : monnier 469 )
377 :    
378 :     fun show G (node as NODE{pri,...}) =
379 :     colorOf G node^(if !verbose then "("^Int.toString(!pri)^")" else "")
380 :    
381 :     (*
382 :     * Dump the interference graph
383 :     *)
384 :     fun dumpGraph(G as G.GRAPH{nodes, showReg, K,...}) stream =
385 :     let fun pr s = TextIO.output(stream, s)
386 :     val show = show G
387 :     val colorOf = colorOf G
388 : monnier 498 fun prMove(MV{src, dst, status=ref(WORKLIST | BRIGGS_MOVE | GEORGE_MOVE),
389 :     cost,...}) =
390 : monnier 469 pr(colorOf(chase dst)^" <- "^colorOf(chase src)^
391 :     "("^Int.toString(cost)^") ")
392 :     | prMove _ = ()
393 : monnier 498
394 :     fun prAdj(n,n' as NODE{adj, degree, uses, defs,
395 :     color, pri, movecnt, movelist, ...}) =
396 :     (pr(show n');
397 :     if !verbose then pr(" deg="^Int.toString(!degree)) else ();
398 :     (case !color of
399 :     ALIASED n => (pr " => "; pr(show n); pr "\n")
400 :     | _ =>
401 :     (pr(" <-->");
402 :     app (fn n => (pr " "; pr(show n))) (!adj); pr "\n";
403 :     if !verbose andalso !movecnt > 0 then
404 :     (pr("\tmoves "^Int.toString(!movecnt)^": ");
405 :     app prMove (!movelist);
406 :     pr "\n"
407 :     )
408 : george 545 else ()
409 : monnier 498 )
410 :     )
411 :     )
412 : monnier 469
413 :     in pr("=========== K="^Int.toString K^" ===========\n");
414 :     app prAdj (ListMergeSort.sort (fn ((x, _),(y, _)) => x > y)
415 :     (Intmap.intMapToList nodes))
416 : monnier 427 end
417 :    
418 : monnier 469
419 :     (*
420 :     * Function to create new nodes.
421 :     * Note: it is up to the caller to remove all dedicated registers.
422 :     *)
423 :     fun newNodes(G.GRAPH{nodes, firstPseudoR, ...}) =
424 :     let val getnode = Intmap.map nodes
425 :     val addnode = Intmap.add nodes
426 :    
427 :     fun defUse{defs, uses, pt, cost} =
428 :     let fun def reg =
429 :     let val node as NODE{pri, defs,...} = getnode reg
430 :     in pri := !pri + cost;(* increment the priority by the cost *)
431 :     defs := pt :: !defs;
432 :     node
433 :     end
434 :     handle _ =>
435 :     let val col = if reg < firstPseudoR then COLORED(reg) else PSEUDO
436 :     val node =
437 :     NODE{number=reg, color=ref col, degree=ref 0,
438 :     adj=ref [], movecnt=ref 0, movelist = ref [],
439 :     movecost=ref 0, (* pair=false, *) pri=ref cost,
440 :     defs=ref [pt], uses=ref []}
441 :     in addnode(reg, node); node
442 :     end
443 :     fun use reg =
444 :     let val node as NODE{pri, uses,...} = getnode reg
445 :     in pri := !pri + cost; (* increment the priority by the cost *)
446 :     uses := pt :: !uses
447 :     end
448 :     handle _ =>
449 :     let val col = if reg < firstPseudoR then COLORED(reg) else PSEUDO
450 :     val node =
451 :     NODE{number=reg, color=ref col, degree=ref 0,
452 :     adj=ref [], movecnt=ref 0, movelist = ref [],
453 :     movecost=ref 0, (* pair=false, *)
454 :     pri=ref cost, defs=ref [], uses=ref[pt]
455 :     }
456 :     in addnode(reg, node)
457 :     end
458 :     fun defAll([],ds) = ds | defAll(r::rs,ds) = defAll(rs,def r::ds)
459 :     fun useAll [] = () | useAll(r::rs) = (use r; useAll rs)
460 :     val defs = defAll(defs,[])
461 :     val _ = useAll uses
462 :     in defs
463 :     end
464 :     in defUse
465 : monnier 427 end
466 :    
467 :    
468 : monnier 469 (*
469 :     * Add an edge (x, y) to the interference graph.
470 :     * Nop if the edge already exists.
471 :     * Note: adjacency lists of colored nodes are not stored
472 :     * within the interference graph to save space.
473 : monnier 498 * Now we allow spilled node to be added to the edge; these do not
474 :     * count toward the degree.
475 : monnier 469 *)
476 :     fun addEdge(GRAPH{bitMatrix,...}) =
477 :     let val addBitMatrix = BM.add(!bitMatrix)
478 : monnier 498 in fn (x as NODE{number=xn, color=colx, adj=adjx, degree=degx, ...},
479 :     y as NODE{number=yn, color=coly, adj=adjy, degree=degy, ...}) =>
480 : monnier 427 if xn = yn then ()
481 : monnier 469 else if addBitMatrix(xn, yn) then
482 : monnier 498 (case (!colx, !coly) of
483 :     (PSEUDO, PSEUDO) => (adjx := y :: !adjx; degx := !degx + 1;
484 :     adjy := x :: !adjy; degy := !degy + 1)
485 :     | (PSEUDO, COLORED _) => (adjx := y :: !adjx; degx := !degx + 1)
486 :     | (PSEUDO, SPILLED _) => (adjx := y :: !adjx; adjy := x :: !adjy)
487 :     | (COLORED _, PSEUDO) => (adjy := x :: !adjy; degy := !degy + 1)
488 :     | (COLORED _, COLORED _) => ()
489 :     | (COLORED _, SPILLED _) => ()
490 :     | (SPILLED _, PSEUDO) => (adjx := y :: !adjx; adjy := x :: !adjy)
491 :     | (SPILLED _, COLORED _) => ()
492 :     | (SPILLED _, SPILLED _) => ()
493 :     | _ => error "addEdge"
494 :     )
495 :     else () (* edge already there *)
496 : monnier 427 end
497 :    
498 :     (*
499 : monnier 469 * Remove an edge from the bitmatrix
500 : monnier 427 *)
501 : monnier 469 fun removeEdge(GRAPH{bitMatrix,...}) =
502 :     let val rmvBitMatrix = BM.delete(!bitMatrix)
503 :     fun filter(c,[], adj') = adj'
504 :     | filter(c,(n as NODE{color,...})::adj, adj') =
505 :     filter(c, adj, if c = color then adj' else n::adj')
506 :     fun rmv(NODE{color, adj, degree, (* pair=p1, *)...},
507 :     s as NODE{(* pair=p2, *) color=c2,...}) =
508 :     (case !color of
509 :     PSEUDO => (adj := filter(c2,!adj,[]);
510 :     (* check for pair <-> pair interference *)
511 :     (* if p1 andalso p2 then degree := !degree - 2
512 :     else *) degree := !degree - 1
513 :     )
514 :     | COLORED _ => () (* not stored *)
515 :     | ALIASED _ => error "removeEdge: ALIASED"
516 :     | REMOVED => error "removeEdge: REMOVED"
517 :     | SPILLED _ => error "removeEdge: SPILLED"
518 :     )
519 :     in fn (x as NODE{number=xn, ...}, y as NODE{number=yn, ...}) =>
520 :     if xn = yn then ()
521 :     else if rmvBitMatrix(if xn < yn then (xn, yn) else (yn, xn)) then
522 :     (rmv(x, y); rmv(y, x))
523 :     else ()
524 : monnier 427 end
525 :    
526 :     (*
527 : monnier 469 * Initialize a list of worklists
528 : monnier 427 *)
529 : monnier 469 fun initWorkLists
530 : monnier 498 (GRAPH{nodes, K, bitMatrix, regmap, pseudoCount, blockedCount,
531 :     firstPseudoR, deadCopies, memMoves, mode, ...}) {moves} =
532 : monnier 469 let (* Filter moves that already have an interference
533 :     * Also initialize the movelist and movecnt fields at this time.
534 :     *)
535 :     val member = BM.member(!bitMatrix)
536 : monnier 427
537 : monnier 469 fun setInfo(NODE{color=ref PSEUDO, movecost, movecnt, movelist,...},
538 :     mv, cost) =
539 :     (movelist := mv :: !movelist;
540 :     movecnt := !movecnt + 1;
541 :     movecost := !movecost + cost
542 :     )
543 :     | setInfo _ = ()
544 : monnier 427
545 : monnier 498 fun filter([], mvs', mem) = (mvs', mem)
546 :     | filter((mv as MV{src as NODE{number=x, color=ref colSrc,...},
547 :     dst as NODE{number=y, color=ref colDst,...},
548 :     cost, ...})::mvs,
549 :     mvs', mem) =
550 :     (case (colSrc, colDst) of
551 :     (COLORED _, COLORED _) => filter(mvs, mvs', mem)
552 :     | (SPILLED _, SPILLED _) => filter(mvs, mvs', mem)
553 :     | (SPILLED _, _) => filter(mvs, mvs', mv::mem)
554 :     | (_, SPILLED _) => filter(mvs, mvs', mv::mem)
555 :     | _ =>
556 :     if member(x, y) (* moves that interfere *)
557 :     then filter(mvs, mvs', mem)
558 : monnier 469 else (setInfo(src, mv, cost);
559 :     setInfo(dst, mv, cost);
560 : monnier 498 filter(mvs, MV.add(mv, mvs'), mem)
561 : monnier 469 )
562 : monnier 498 )
563 : monnier 427
564 : monnier 498 fun filter'([], mvs', mem, dead) = (mvs', mem, dead)
565 :     | filter'((mv as
566 :     MV{src as NODE{number=x, color as ref colSrc,
567 :     pri, adj, uses,...},
568 :     dst as NODE{number=y, color=ref colDst,
569 :     defs=dstDefs, uses=dstUses,...},
570 :     cost, ...})::mvs,
571 :     mvs', mem, dead) =
572 :     (case (colSrc, colDst, dstDefs, dstUses) of
573 :     (COLORED _, COLORED _, _, _) => filter'(mvs, mvs', mem, dead)
574 :     | (SPILLED _, SPILLED _, _, _) => filter'(mvs, mvs', mem, dead)
575 :     | (SPILLED _, _, _, _) => filter'(mvs, mvs', mv::mem, dead)
576 :     | (_, SPILLED _, _, _) => filter'(mvs, mvs', mv::mem, dead)
577 :     | (_, PSEUDO, ref [pt], ref []) =>
578 : monnier 469 (* eliminate dead copy *)
579 : monnier 498 let fun decDegree [] = ()
580 :     | decDegree(NODE{color=ref PSEUDO, degree, ...}::adj) =
581 :     (degree := !degree - 1; decDegree adj)
582 :     | decDegree(_::adj) = decDegree adj
583 :     fun elimUses([], _, uses, pri, cost) = (uses, pri)
584 :     | elimUses(pt::pts, pt' : int, uses, pri, cost) =
585 :     if pt = pt' then elimUses(pts, pt', uses, pri-cost, cost)
586 :     else elimUses(pts, pt', pt::uses, pri, cost)
587 :     val (uses', pri') = elimUses(!uses, pt, [], !pri, cost);
588 : monnier 469 in pri := pri';
589 :     uses := uses';
590 :     color := ALIASED src;
591 :     decDegree(!adj);
592 : monnier 498 filter'(mvs, mvs', mem, y::dead)
593 : monnier 427 end
594 : monnier 498 | _ => (* normal moves *)
595 :     if member(x, y) (* moves that interfere *)
596 :     then filter'(mvs, mvs', mem, dead)
597 : monnier 469 else (setInfo(src, mv, cost);
598 :     setInfo(dst, mv, cost);
599 : monnier 498 filter'(mvs, MV.add(mv, mvs'), mem, dead)
600 : monnier 469 )
601 : monnier 498 )
602 :    
603 : monnier 469 (*
604 :     * Scan all nodes in the graph and check which worklist they should
605 :     * go into.
606 :     *)
607 : monnier 498 fun collect([], simp, fz, moves, spill, pseudos, blocked) =
608 :     (pseudoCount := pseudos;
609 :     blockedCount := blocked;
610 : monnier 469 {simplifyWkl = simp,
611 :     moveWkl = moves,
612 :     freezeWkl = fz,
613 :     spillWkl = spill
614 :     }
615 : monnier 498 )
616 :     | collect(node::rest, simp, fz, moves, spill, pseudos, blocked) =
617 : monnier 469 (case node of
618 :     NODE{color=ref PSEUDO, movecnt, degree, ...} =>
619 :     if !degree >= K then
620 : monnier 498 collect(rest, simp, fz, moves, node::spill,
621 :     pseudos+1, blocked)
622 : monnier 469 else if !movecnt > 0 then
623 : monnier 498 collect(rest, simp, FZ.add(node, fz),
624 :     moves, spill, pseudos+1, blocked+1)
625 : monnier 469 else
626 : monnier 498 collect(rest, node::simp, fz, moves, spill,
627 :     pseudos+1, blocked)
628 :     | _ => collect(rest, simp, fz, moves, spill, pseudos, blocked)
629 : monnier 469 )
630 : monnier 427
631 : monnier 469 (* First build the move priqueue *)
632 : monnier 498 val (mvs, mem) =
633 :     if isOn(mode, DEAD_COPY_ELIM) then
634 :     let val (mvs, mem, dead) = filter'(moves, MV.EMPTY, [], [])
635 :     in deadCopies := dead; (mvs, mem)
636 : monnier 469 end
637 : monnier 498 else filter(moves, MV.EMPTY, [])
638 : monnier 469
639 :     (* if copy propagation was done prior to register allocation
640 :     * then some nodes may already be aliased. This function updates the
641 :     * aliasing.
642 :     *)
643 :     fun updateAliases() =
644 :     let val alias = Intmap.mapInt regmap
645 :     val getnode = Intmap.map nodes
646 :     fun fixup(num, NODE{color, ...}) =
647 :     if num < firstPseudoR then ()
648 :     else let val reg = alias num
649 :     in if reg=num then () else
650 :     color := ALIASED(getnode reg)
651 :     end
652 :     in Intmap.app fixup nodes end
653 :    
654 :     in (* updateAliases(); *)
655 : monnier 498 memMoves := mem; (* memory moves *)
656 :     collect(Intmap.values nodes, [], FZ.EMPTY, mvs, [], 0, 0)
657 : monnier 469 end
658 :    
659 :     (*
660 :     * Return a regmap that reflects the current interference graph.
661 :     * Spilled registers are given the special value ~1
662 :     *)
663 :     fun regmap(G.GRAPH{nodes,...}) =
664 :     let val getnode = Intmap.map nodes
665 :     fun num(NODE{color=ref(COLORED r),...}) = r
666 :     | num(NODE{color=ref(ALIASED n),...}) = num n
667 : monnier 498 | num(NODE{color=ref(SPILLED s),...}) = if s >= 0 then s else ~1
668 : monnier 469 | num(NODE{number, color=ref PSEUDO,...}) = number
669 :     | num _ = error "regmap"
670 :     fun lookup r = num(getnode r) handle _ => r (* XXX *)
671 :     in lookup
672 :     end
673 :    
674 :     (*
675 :     * Return a regmap that reflects the current interference graph,
676 :     * during spilling.
677 :     *)
678 :     fun spillRegmap(G.GRAPH{nodes,...}) =
679 :     let val getnode = Intmap.map nodes
680 :     fun num(NODE{color=ref(COLORED r),...}) = r
681 :     | num(NODE{color=ref(ALIASED n),...}) = num n
682 :     | num(NODE{color=ref(SPILLED _),number,...}) = number
683 :     | num(NODE{number, color=ref PSEUDO,...}) = number
684 :     | num _ = error "spillRegmap"
685 :     fun lookup r = num(getnode r) handle _ => r (* XXX *)
686 :     in lookup
687 :     end
688 :    
689 :     (*
690 :     * Return a regmap that returns the current spill location
691 :     * during spilling.
692 :     *)
693 :     fun spillLoc(G.GRAPH{nodes,...}) =
694 :     let val getnode = Intmap.map nodes
695 :     fun num(NODE{color=ref(ALIASED n), ...}) = num n
696 :     | num(NODE{color=ref(SPILLED ~1), number, ...}) = number
697 :     | num(NODE{color=ref(SPILLED c), ...}) = c
698 :     | num(NODE{number, ...}) = number
699 :     fun lookup r = num(getnode r) handle _ => r (* XXX *)
700 :     in lookup
701 :     end
702 :    
703 :     (*
704 :     * Core phases:
705 :     * Simplify, coalesce, freeze.
706 :     *
707 :     * NOTE: When a node's color is REMOVED or ALIASED,
708 :     * it is not considered to be part of the adjacency list
709 :     *
710 :     * 1. The move list has no duplicate
711 :     * 2. The freeze list may have duplicates
712 :     *)
713 :     fun iteratedCoalescingPhases
714 : leunga 579 (G as GRAPH{K, bitMatrix, spillFlag, trail, stamp, mode,
715 : monnier 498 pseudoCount, blockedCount, ...}) =
716 : monnier 469 let val member = BM.member(!bitMatrix)
717 : monnier 427 val addEdge = addEdge G
718 : monnier 469 val show = show G
719 : leunga 579 val memoryCoalescingOn = isOn(mode, MEMORY_COALESCING)
720 : monnier 427
721 : leunga 579 val blocked = blockedCount
722 :    
723 : monnier 469 (*
724 :     * SIMPLIFY node:
725 :     * precondition: node must be part of the interference graph (PSEUDO)
726 :     *)
727 : monnier 498 fun simplify(node as NODE{color, number, adj, degree, (*pair,*)...},
728 :     mv, fz, stack) =
729 : monnier 469 let val _ = if debug then print("Simplifying "^show node^"\n") else ()
730 :     fun forallAdj([], mv, fz, stack) = (mv, fz, stack)
731 : monnier 498 | forallAdj((n as NODE{color=ref PSEUDO, degree as ref d,...})::adj,
732 :     mv, fz, stack) =
733 :     if d = K then
734 :     let val (mv, fz, stack) = lowDegree(n, mv, fz, stack)
735 :     in forallAdj(adj, mv, fz, stack) end
736 :     else (degree := d - 1; forallAdj(adj, mv, fz, stack))
737 :     | forallAdj(_::adj, mv, fz, stack) = forallAdj(adj, mv, fz, stack)
738 : monnier 469 in color := REMOVED;
739 : monnier 498 pseudoCount := !pseudoCount - 1;
740 : monnier 469 forallAdj(!adj, mv, fz, node::stack) (* push onto stack *)
741 :     end (* simplify *)
742 :    
743 : monnier 498 and simplifyAll([], mv, fz, stack) = (mv, fz, stack)
744 :     | simplifyAll(node::simp, mv, fz, stack) =
745 :     let val (mv, fz, stack) = simplify(node, mv, fz, stack)
746 :     in simplifyAll(simp, mv, fz, stack) end
747 :    
748 : monnier 469 (*
749 :     * Decrement the degree of a pseudo node.
750 :     * precondition: node must be part of the interference graph
751 :     * If the degree of the node is now K-1.
752 :     * Then if (a) the node is move related, freeze it.
753 :     * (b) the node is non-move related, simplify it
754 :     *
755 :     * node -- the node to decrement degree
756 :     * mv -- queue of move candidates to be coalesced
757 :     * fz -- queue of freeze candidates
758 :     * stack -- stack of removed nodes
759 :     *)
760 : monnier 498 and lowDegree(node as NODE{degree as ref d, movecnt, adj, color,...},
761 :     (* false, *) mv, fz, stack) =
762 :     (* normal edge *)
763 : monnier 469 (if debug then
764 :     print("DecDegree "^show node^" d="^Int.toString(d-1)^"\n") else ();
765 : monnier 498 degree := K - 1;
766 :     (* node is now low degree!!! *)
767 :     let val mv = enableMoves(!adj, mv)
768 :     in if !movecnt > 0 then (* move related *)
769 :     (blocked := !blocked + 1; (mv, FZ.add(node, fz), stack))
770 :     else (* non-move related, simplify now! *)
771 :     simplify(node, mv, fz, stack)
772 :     end
773 : monnier 469 )
774 :     (*
775 :     | decDegree(node as NODE{degree as ref d, movecnt, adj, color,...},
776 :     true, mv, fz, stack) = (* register pair edge *)
777 :     (degree := d - 2;
778 :     if d >= K andalso !degree < K then
779 :     (* node is now low degree!!! *)
780 :     let val mv = enableMoves(node :: !adj, mv)
781 :     in if !movecnt > 0 then (* move related *)
782 : monnier 498 (blocked := !blocked + 1; (mv, FZ.add(node, fz), stack))
783 : monnier 469 else (* non-move related, simplify now! *)
784 :     simplify(node, mv, fz, stack)
785 :     end
786 :     else
787 :     (mv, fz, stack)
788 :     )
789 :     *)
790 :    
791 :     (*
792 :     * Enable moves:
793 :     * given: a list of nodes (some of which are not in the graph)
794 :     * do: all moves associated with these nodes are inserted
795 :     * into the move worklist
796 :     *)
797 :     and enableMoves([], mv) = mv
798 :     | enableMoves(n::ns, mv) =
799 :     let (* add valid moves onto the worklist.
800 :     * there are no duplicates on the move worklist!
801 : monnier 427 *)
802 : monnier 498 fun addMv([], ns, mv) = enableMoves(ns, mv)
803 :     | addMv((m as MV{status, hicount as ref hi, ...})::rest,
804 :     ns, mv) =
805 : monnier 469 (case !status of
806 : monnier 498 (BRIGGS_MOVE | GEORGE_MOVE) =>
807 :     (* decrements hi, when hi <= 0 enable move *)
808 :     if hi <= 1 then
809 :     (status := WORKLIST; addMv(rest, ns, MV.add(m, mv)))
810 :     else
811 :     (hicount := hi-1; addMv(rest, ns, mv))
812 :     | _ => addMv(rest, ns, mv)
813 : monnier 469 )
814 :     in (* make sure the nodes are actually in the graph *)
815 :     case n of
816 :     NODE{movelist, color=ref PSEUDO, movecnt,...} =>
817 :     if !movecnt > 0 then (* is it move related? *)
818 : monnier 498 addMv(!movelist, ns, mv)
819 : monnier 469 else
820 :     enableMoves(ns, mv)
821 :     | _ => enableMoves(ns, mv)
822 :     end (* enableMoves *)
823 :    
824 :     (*
825 :     * Brigg's conservative coalescing test:
826 :     * given: an unconstrained move (x, y)
827 :     * return: true or false
828 :     *)
829 : monnier 498 fun conservative(hicount,
830 :     x as NODE{degree=ref dx, adj=xadj, (* pair=px, *) ...},
831 : monnier 469 y as NODE{degree=ref dy, adj=yadj, (* pair=py, *) ...}) =
832 :     dx + dy < K orelse
833 :     let (*
834 : monnier 498 * hi -- is the number of nodes with deg > K (without duplicates)
835 :     * n -- the number of nodes that have deg = K but not neighbors
836 :     * of both x and y
837 : monnier 469 * We use the movecnt as a flag indicating whether
838 :     * a node has been visited. A negative count is used to mark
839 :     * a visited node.
840 : monnier 427 *)
841 : monnier 498 fun undo([], extraHi) =
842 :     extraHi <= 0 orelse (hicount := extraHi; false)
843 :     | undo(movecnt::tr, extraHi) =
844 :     (movecnt := ~1 - !movecnt; undo(tr, extraHi))
845 :     fun loop([], [], hi, n, tr) = undo(tr, (hi + n) - K + 1)
846 :     | loop([], yadj, hi, n, tr) = loop(yadj, [], hi, n, tr)
847 : monnier 469 | loop(NODE{color, movecnt as ref m, degree=ref deg, ...}::vs,
848 : monnier 498 yadj, hi, n, tr) =
849 :     (case !color of
850 :     COLORED _ =>
851 :     if m < 0 then
852 :     (* node has been visited before *)
853 :     loop(vs, yadj, hi, n, tr)
854 :     else
855 :     (movecnt := ~1 - m; (* mark as visited *)
856 :     loop(vs, yadj, hi+1, n, movecnt::tr))
857 :     | PSEUDO =>
858 :     if deg < K then loop(vs, yadj, hi, n, tr)
859 :     else if m >= 0 then
860 :     (* node has never been visited before *)
861 :     (movecnt := ~1 - m; (* mark as visited *)
862 :     if deg = K
863 :     then loop(vs, yadj, hi, n+1, movecnt::tr)
864 :     else loop(vs, yadj, hi+1, n, movecnt::tr)
865 :     )
866 :     else
867 :     (* node has been visited before *)
868 :     if deg = K then loop(vs, yadj, hi, n-1, tr)
869 :     else loop(vs, yadj, hi, n, tr)
870 :     | _ => loop(vs, yadj, hi, n, tr) (* REMOVED/ALIASED *)
871 :     )
872 :     in loop(!xadj, !yadj, 0, 0, []) end
873 : monnier 469
874 :     (*
875 :     * Heuristic used to determine whether a pseudo and machine register
876 :     * can be coalesced.
877 :     * Precondition:
878 :     * The two nodes are assumed not to interfere.
879 :     *)
880 : monnier 498 fun safe(hicount, reg, NODE{adj, ...}) =
881 :     let fun loop([], hi) = hi = 0 orelse (hicount := hi; false)
882 :     | loop(n::adj, hi) =
883 : monnier 469 (case n of
884 : monnier 498 (* Note: Actively we only have to consider pseudo nodes and not
885 :     * nodes that are removed, since removed nodes either have
886 :     * deg < K or else optimistic spilling must be in effect!
887 :     *)
888 :     NODE{degree,number,color=ref(PSEUDO | REMOVED), ...} =>
889 :     if !degree < K orelse member(reg, number) then loop(adj, hi)
890 :     else loop(adj, hi+1)
891 :     | _ => loop(adj, hi)
892 : monnier 469 )
893 : monnier 498 in loop(!adj, 0) end
894 : monnier 469
895 :     (*
896 :     * Decrement the active move count of a node.
897 :     * When the move count reaches 0 and the degree < K
898 :     * simplify the node immediately.
899 :     * Precondition: node must be a node in the interference graph
900 :     * The node can become a non-move related node.
901 :     *)
902 :     fun decMoveCnt
903 :     (node as NODE{movecnt, color=ref PSEUDO, degree, movecost,...},
904 :     cnt, cost, mv, fz, stack) =
905 :     let val newCnt = !movecnt - cnt
906 :     in movecnt := newCnt;
907 :     movecost := !movecost - cost;
908 :     if newCnt = 0 andalso !degree < K (* low degree and movecnt = 0 *)
909 : monnier 498 then (blocked := !blocked - 1; simplify(node, mv, fz, stack))
910 : monnier 469 else (mv, fz, stack)
911 :     end
912 :     | decMoveCnt(_, _, _, mv, fz, stack) = (mv, fz, stack)
913 :    
914 :     (*
915 :     * Combine two nodes u and v into one.
916 :     * v is replaced by u
917 :     * u is the new combined node
918 :     * Precondition: u <> v and u and v must be unconstrained
919 :     *
920 :     * u, v -- two nodes to be merged, must be distinct!
921 : monnier 498 * coloingv -- is u a colored node?
922 : monnier 469 * mvcost -- the cost of the move that has been eliminated
923 :     * mv -- the queue of moves
924 :     * fz -- the queue of freeze candidates
925 :     * stack -- stack of removed nodes
926 :     *)
927 : monnier 498 fun combine(u, v, coloringv, mvcost, mv, fz, stack) =
928 : monnier 469 let val NODE{color=vcol, pri=pv, movecnt=cntv, movelist=movev, adj=adjv,
929 : monnier 498 defs=defsv, uses=usesv, degree=degv, ...} = v
930 : monnier 469 val NODE{color=ucol, pri=pu, movecnt=cntu, movelist=moveu, adj=adju,
931 : monnier 498 defs=defsu, uses=usesu, degree=degu, ...} = u
932 :    
933 : monnier 469 (* merge movelists together, taking the opportunity
934 :     * to prune the lists
935 :     *)
936 :     fun mergeMoveList([], mv) = mv
937 : monnier 498 | mergeMoveList((m as MV{status,hicount,...})::rest, mv) =
938 : monnier 469 (case !status of
939 : monnier 498 BRIGGS_MOVE =>
940 :     (* if we are changing a copy from v <-> w to uv <-> w
941 :     * makes sure we reset its trigger count, so that it
942 :     * will be tested next.
943 :     *)
944 :     (if coloringv then (status := GEORGE_MOVE; hicount := 0)
945 :     else ();
946 :     mergeMoveList(rest, m::mv)
947 :     )
948 :     | GEORGE_MOVE =>
949 :     (* if u is colored and v is not, then the move v <-> w
950 :     * becomes uv <-> w where w is colored. This can always
951 :     * be discarded.
952 :     *)
953 :     (if coloringv then mergeMoveList(rest, mv)
954 :     else mergeMoveList(rest, m::mv)
955 :     )
956 :     | WORKLIST => mergeMoveList(rest, m::mv)
957 : monnier 469 | _ => mergeMoveList(rest, mv)
958 :     )
959 :    
960 :     (* Form combined node; add the adjacency list of v to u *)
961 :     fun union([], mv, fz, stack) = (mv, fz, stack)
962 : monnier 498 | union((t as NODE{color, (* pair=pt, *)degree, ...})::adj,
963 :     mv, fz, stack) =
964 : monnier 469 (case !color of
965 : monnier 498 (COLORED _ | SPILLED _) =>
966 :     (addEdge(t, u); union(adj, mv, fz, stack))
967 : monnier 469 | PSEUDO =>
968 :     (addEdge(t, u);
969 : monnier 498 let val d = !degree
970 :     in if d = K then
971 :     let val (mv, fz, stack) = lowDegree(t, mv, fz, stack)
972 :     in union(adj, mv, fz, stack) end
973 :     else (degree := d - 1; union(adj, mv, fz, stack))
974 :     end
975 : monnier 469 )
976 :     | _ => union(adj, mv, fz, stack)
977 :     )
978 : monnier 498
979 : monnier 469 in vcol := ALIASED u;
980 :     (* combine the priority of both:
981 :     * note that since the mvcost has been counted twice
982 :     * in the original priority, we substract it twice
983 :     * from the new priority.
984 :     *)
985 : monnier 498 pu := !pu + !pv - mvcost - mvcost;
986 : monnier 469 (* combine the def/use pts of both nodes.
987 :     * Strictly speaking, the def/use points of the move
988 :     * should also be removed. But since we never spill
989 :     * a coalesced node and only spilling makes use of these
990 : monnier 475 * def/use points, we are safe for now.
991 :     *
992 :     * New comment: with spill propagation, it is necessary
993 :     * to keep track of the spilled program points.
994 : monnier 469 *)
995 : leunga 579 if memoryCoalescingOn then
996 :     (defsu := concat(!defsu, !defsv);
997 :     usesu := concat(!usesu, !usesv)
998 :     )
999 :     else ();
1000 : monnier 469 case !ucol of
1001 :     PSEUDO =>
1002 : monnier 498 (if !cntv > 0 then
1003 :     (if !cntu > 0 then blocked := !blocked - 1 else ();
1004 :     moveu := mergeMoveList(!movev, !moveu)
1005 :     )
1006 :     else ();
1007 : monnier 469 movev := []; (* XXX kill the list to free space *)
1008 :     cntu := !cntu + !cntv
1009 :     )
1010 :     | _ => ()
1011 :     ;
1012 :     cntv := 0;
1013 :    
1014 : monnier 498 let val removingHi = !degv >= K andalso (!degu >= K orelse coloringv)
1015 : monnier 469 (* Update the move count of the combined node *)
1016 : monnier 498 val (mv, fz, stack) = union(!adjv, mv, fz, stack)
1017 :     val (mv, fz, stack) =
1018 :     decMoveCnt(u, 2, mvcost + mvcost, mv, fz, stack)
1019 :     (* If either v or u are high degree then at least one high degree
1020 :     * node is removed from the neighbors of uv after coalescing
1021 :     *)
1022 :     val mv = if removingHi then enableMoves(!adju, mv) else mv
1023 :     in coalesce(mv, fz, stack)
1024 : monnier 469 end
1025 :     end
1026 :    
1027 :     (*
1028 :     * COALESCE:
1029 :     * Repeat coalescing and simplification until mv is empty.
1030 :     *)
1031 : monnier 498 and coalesce(MV.EMPTY, fz, stack) = (fz, stack)
1032 :     | coalesce(MV.TREE(MV{src, dst, status, hicount, cost, ...}, _, l, r),
1033 :     fz, stack) =
1034 :     let (* val _ = coalesce_count := !coalesce_count + 1 *)
1035 :     val u = chase src
1036 : monnier 469 val v as NODE{color=ref vcol, ...} = chase dst
1037 :     (* make u the colored one *)
1038 :     val (u as NODE{number=u', color=ref ucol, ...},
1039 :     v as NODE{number=v', color=ref vcol, ...}) =
1040 :     case vcol of
1041 :     COLORED _ => (v, u)
1042 :     | _ => (u, v)
1043 :     val _ = if debug then print ("Coalescing "^show u^"<->"^show v
1044 :     ^" ("^Int.toString cost^")") else ()
1045 :     val mv = MV.merge(l, r)
1046 : monnier 498 fun coalesceIt(status, v) =
1047 :     (status := COALESCED;
1048 :     if !spillFlag then trail := UNDO(v, status, !trail) else ()
1049 :     )
1050 : monnier 469 in if u' = v' then (* trivial move *)
1051 : monnier 498 let val _ = if debug then print(" Trivial\n") else ()
1052 :     val _ = coalesceIt(status, v)
1053 :     in coalesce(decMoveCnt(u, 2, cost+cost, mv, fz, stack))
1054 :     end
1055 : monnier 469 else
1056 :     (case vcol of
1057 :     COLORED _ =>
1058 :     (* two colored nodes cannot be coalesced *)
1059 : monnier 498 (status := CONSTRAINED;
1060 :     if debug then print(" Both Colored\n") else ();
1061 :     coalesce(mv, fz, stack))
1062 : monnier 469 | _ =>
1063 : monnier 498 if member(u', v') then
1064 : monnier 469 (* u and v interfere *)
1065 : monnier 498 let val _ = status := CONSTRAINED
1066 :     val _ = if debug then print(" Interfere\n") else ();
1067 :     val (mv, fz, stack) =
1068 :     decMoveCnt(u, 1, cost, mv, fz, stack)
1069 :     in coalesce(decMoveCnt(v, 1, cost, mv, fz, stack)) end
1070 : monnier 469 else
1071 :     case ucol of
1072 :     COLORED _ => (* u is colored, v is not *)
1073 : monnier 498 if safe(hicount, u', v) then
1074 :     (if debug then print(" Safe\n") else ();
1075 :     (*if tally then good_george := !good_george+1 else ();*)
1076 :     coalesceIt(status, v);
1077 :     combine(u, v, true, cost, mv, fz, stack)
1078 :     )
1079 : monnier 469 else
1080 : monnier 498 ((* remove it from the move list *)
1081 :     status := GEORGE_MOVE;
1082 :     (*if tally then bad_george := !bad_george + 1 else ();*)
1083 : monnier 469 if debug then print(" Unsafe\n") else ();
1084 : monnier 498 coalesce(mv, fz, stack)
1085 : monnier 469 )
1086 :     | _ => (* u, v are not colored *)
1087 : monnier 498 if conservative(hicount, u, v) then
1088 :     (if debug then print(" OK\n") else ();
1089 :     (*if tally then good_briggs := !good_briggs+1 else ();*)
1090 :     coalesceIt(status, v);
1091 :     combine(u, v, false, cost, mv, fz, stack)
1092 :     )
1093 : monnier 469 else (* conservative test failed *)
1094 : monnier 498 ((* remove it from the move list *)
1095 :     status := BRIGGS_MOVE;
1096 :     (*if tally then bad_briggs := !bad_briggs + 1 else ();*)
1097 : monnier 469 if debug then print(" Non-conservative\n") else ();
1098 : monnier 498 coalesce(mv, fz, stack)
1099 : monnier 469 )
1100 :     )
1101 :     end
1102 :    
1103 :     (* mark a node n as frozen:
1104 :     * Go thru all the moves (n, m), decrement the move count of m
1105 :     * precondition: degree must be < K
1106 :     * movecnt must be > 0
1107 :     * node -- the node to be frozen
1108 :     * fz -- a queue of freeze candidates
1109 :     * stack -- stack of removed nodes
1110 :     *)
1111 : monnier 498 fun markAsFrozen(
1112 :     node as NODE{number=me, degree,
1113 :     adj, movelist, movecnt as ref mc,...},
1114 :     fz, stack) =
1115 : monnier 469 let val _ = if debug then print("Mark as frozen "^Int.toString me^"\n")
1116 :     else ()
1117 :     (* eliminate all moves, return a list of nodes that
1118 :     * can be simplified
1119 :     *)
1120 :     fun elimMoves([], simp) = simp
1121 :     | elimMoves(MV{status, src, dst, ...}::mvs, simp) =
1122 :     case !status of
1123 :     WORKLIST => error "elimMoves"
1124 : monnier 498 | (BRIGGS_MOVE | GEORGE_MOVE) => (* mark move as lost *)
1125 : monnier 469 let val _ = status := LOST
1126 :     val src as NODE{number=s,...} = chase src
1127 : monnier 498 val you = if s = me then chase dst else src
1128 : monnier 469 in case you of
1129 :     NODE{color=ref(COLORED _),...} =>
1130 :     elimMoves(mvs, simp)
1131 :     | NODE{movecnt as ref c, degree, ...} => (* pseudo *)
1132 :     (movecnt := c - 1;
1133 :     if c = 1 andalso !degree < K then
1134 : leunga 579 (blocked := !blocked - 1;
1135 :     elimMoves(mvs, you::simp))
1136 : monnier 469 else
1137 :     elimMoves(mvs, simp)
1138 :     )
1139 :     end
1140 :     | _ => elimMoves(mvs, simp)
1141 :    
1142 : monnier 498 (* Note:
1143 :     * We are removing a high degree node, so try to enable all moves
1144 :     * associated with its neighbors.
1145 :     *)
1146 :    
1147 :     val mv = if !degree >= K then enableMoves(!adj, MV.EMPTY)
1148 :     else MV.EMPTY
1149 :    
1150 :     in if mc = 0
1151 :     then simplify(node, mv, fz, stack)
1152 :     else
1153 :     (movecnt := 0;
1154 :     simplifyAll(node::elimMoves(!movelist, []), mv, fz, stack)
1155 :     )
1156 : monnier 427 end
1157 :    
1158 : monnier 469 (*
1159 :     * FREEZE:
1160 :     * Repeat picking
1161 :     * a node with degree < K from the freeze list and freeze it.
1162 :     * fz -- queue of freezable nodes
1163 :     * stack -- stack of removed nodes
1164 :     * undo -- trail of coalesced moves after potential spill
1165 : monnier 427 *)
1166 : monnier 498 fun freeze(fz, stack) =
1167 :     let fun loop(FZ.EMPTY, FZ.EMPTY, stack) = stack
1168 :     | loop(FZ.EMPTY, newFz, _) = error "no freeze candidate"
1169 :     | loop(FZ.TREE(node, _, l, r), newFz, stack) =
1170 : monnier 469 let val fz = FZ.merge(l, r)
1171 :     in case node of
1172 :     (* This node has not been simplified
1173 :     * This must be a move-related node.
1174 :     *)
1175 : monnier 498 NODE{color=ref PSEUDO, degree, ...} =>
1176 :     if !degree >= K (* can't be frozen yet? *)
1177 :     then
1178 :     ((*if tally then bad_freeze := !bad_freeze+1 else ();*)
1179 :     loop(fz, newFz, stack))
1180 : monnier 469 else (* freeze node *)
1181 : monnier 498 let val _ =
1182 :     if debug then print("Freezing "^show node^"\n")
1183 :     else ()
1184 :     (*val _ =
1185 :     if tally then good_freeze := !good_freeze + 1
1186 :     else ()*)
1187 : leunga 579 val _ = blocked := !blocked - 1;
1188 : monnier 469 val (mv, fz, stack) = markAsFrozen(node, fz, stack)
1189 : monnier 498 val (fz, stack) = coalesce(mv, fz, stack)
1190 :     in if !blocked = 0
1191 :     then ((* print "[no freezing again]"; *) stack)
1192 :     else ((* print("[freezing again "^
1193 :     Int.toString(!blocked)^"]"); *)
1194 :     loop(FZ.merge(fz, newFz), FZ.EMPTY, stack))
1195 : monnier 469 end
1196 : monnier 498 | _ =>
1197 :     ((*if tally then bad_freeze := !bad_freeze + 1 else ();*)
1198 :     loop(fz, newFz, stack))
1199 : monnier 469 end
1200 : monnier 498 in if !blocked = 0 then ((* print "[no freezing]"; *) stack)
1201 :     else ((* print("[freezing "^Int.toString(!blocked)^"]"); *)
1202 :     loop(fz, FZ.EMPTY, stack))
1203 : monnier 427 end
1204 : monnier 469
1205 : monnier 498 (*
1206 :     * Sort simplify worklist in increasing degree.
1207 :     * Matula and Beck suggests that we should always remove the
1208 :     * node with the lowest degree first. This is an approximation of
1209 :     * the idea.
1210 :     *)
1211 : monnier 469 (*
1212 : monnier 498 val buckets = A.array(K, []) : G.node list A.array
1213 :     fun sortByDegree nodes =
1214 :     let fun insert [] = ()
1215 :     | insert((n as NODE{degree=ref deg, ...})::rest) =
1216 :     (UA.update(buckets, deg, n::UA.sub(buckets, deg)); insert rest)
1217 :     fun collect(~1, L) = L
1218 :     | collect(deg, L) = collect(deg-1, concat(UA.sub(buckets, deg), L))
1219 :     in insert nodes;
1220 :     collect(K-1, [])
1221 :     end
1222 :     *)
1223 :    
1224 :     (*
1225 : monnier 469 * Iterate over simplify, coalesce, freeze
1226 :     *)
1227 :     fun iterate{simplifyWkl, moveWkl, freezeWkl, stack} =
1228 :     let (* simplify everything *)
1229 : monnier 498 val (mv, fz, stack) =
1230 :     simplifyAll((* sortByDegree *) simplifyWkl,
1231 :     moveWkl, freezeWkl, stack)
1232 :     val (fz, stack) = coalesce(mv, fz, stack)
1233 :     val stack = freeze(fz, stack)
1234 :     in {stack=stack}
1235 : monnier 469 end
1236 :     in {markAsFrozen=markAsFrozen, iterate=iterate}
1237 : monnier 427 end
1238 :    
1239 : monnier 469 (*
1240 :     * The main entry point for the iterated coalescing algorithm
1241 :     *)
1242 :     fun iteratedCoalescing G =
1243 :     let val {iterate,...} = iteratedCoalescingPhases G
1244 :     in iterate end
1245 : monnier 427
1246 : monnier 469
1247 :     (*
1248 :     * Potential Spill:
1249 :     * Find some node on the spill list and just optimistically
1250 :     * remove it from the graph.
1251 :     *)
1252 :     fun potentialSpillNode (G as G.GRAPH{spillFlag,...}) =
1253 :     let val {markAsFrozen,...} = iteratedCoalescingPhases G
1254 : george 545 val spilled = SPILLED ~1
1255 :     in fn {node, cost, stack} =>
1256 : monnier 469 let val _ = spillFlag := true (* potential spill found *)
1257 : monnier 498 val (mv, fz, stack) = markAsFrozen(node, FZ.EMPTY, stack)
1258 : george 545 in if cost < 0.0 then
1259 :     let val NODE{color, ...} = node in color := spilled end
1260 :     else ();
1261 :     {moveWkl=mv, freezeWkl=fz, stack=stack}
1262 : monnier 469 end
1263 :     end
1264 :    
1265 :    
1266 :    
1267 :     (*
1268 :     * SELECT:
1269 :     * Using optimistic spilling
1270 :     *)
1271 :     fun select(G as GRAPH{getreg, getpair, trail, firstPseudoR, stamp,
1272 : monnier 498 spillFlag, proh, mode, ...}) {stack} =
1273 : monnier 469 let fun undoCoalesced END = ()
1274 :     | undoCoalesced(UNDO(NODE{number, color, ...}, status, trail)) =
1275 : monnier 498 (status := BRIGGS_MOVE;
1276 : monnier 469 if number < firstPseudoR then () else color := PSEUDO;
1277 :     undoCoalesced trail
1278 :     )
1279 :     val show = show G
1280 :    
1281 :     (* Fast coloring, assume no spilling can occur *)
1282 :     fun fastcoloring([], stamp) = ([], stamp)
1283 :     | fastcoloring((node as NODE{color, (* pair, *) adj, ...})::stack,
1284 :     stamp) =
1285 :     let (* set up the proh array *)
1286 : monnier 427 fun neighbors [] = ()
1287 : monnier 469 | neighbors(r::rs) =
1288 :     let fun mark(NODE{color=ref(COLORED c), ...}) =
1289 :     (UA.update(proh, c, stamp); neighbors rs)
1290 :     | mark(NODE{color=ref(ALIASED n), ...}) = mark n
1291 :     | mark _ = neighbors rs
1292 :     in mark r end
1293 : monnier 427 val _ = neighbors(!adj)
1294 : monnier 469 in color := COLORED(getreg{pref=[], proh=proh, stamp=stamp});
1295 :     fastcoloring(stack, stamp+1)
1296 :     end
1297 :    
1298 :     (* Briggs' optimistic spilling heuristic *)
1299 :     fun optimistic([], spills, stamp) = (spills, stamp)
1300 : george 545 | optimistic((node as NODE{color=ref(SPILLED _), ...})::stack,
1301 :     spills, stamp) =
1302 :     optimistic(stack, node::spills, stamp)
1303 : monnier 469 | optimistic((node as NODE{color, (* pair, *) adj, ...})::stack,
1304 :     spills, stamp) =
1305 :     let (* set up the proh array *)
1306 :     fun neighbors [] = ()
1307 :     | neighbors(r::rs) =
1308 :     let fun mark(NODE{color=ref(COLORED c), ...}) =
1309 :     (UA.update(proh, c, stamp); neighbors rs)
1310 :     | mark(NODE{color=ref(ALIASED n), ...}) = mark n
1311 :     | mark _ = neighbors rs
1312 :     in mark r end
1313 :     val _ = neighbors(!adj)
1314 : monnier 427 val spills =
1315 : monnier 469 let val col = getreg{pref=[], proh=proh, stamp=stamp}
1316 :     in color := COLORED col; spills
1317 : monnier 427 end handle _ => node::spills
1318 : monnier 469 in optimistic(stack, spills, stamp+1) end
1319 :    
1320 :     (* Briggs' optimistic spilling heuristic, with biased coloring *)
1321 :     fun biasedColoring([], spills, stamp) = (spills, stamp)
1322 : george 545 | biasedColoring((node as NODE{color=ref(SPILLED _), ...})::stack,
1323 :     spills, stamp) =
1324 :     biasedColoring(stack, node::spills, stamp)
1325 : monnier 469 | biasedColoring(
1326 :     (node as NODE{number, color, adj,
1327 :     (* pair, *) movecnt, movelist,...})::stack,
1328 :     spills, stamp) =
1329 :     let (* set up the proh array *)
1330 :     fun neighbors [] = ()
1331 :     | neighbors(r::rs) =
1332 :     (case chase r of
1333 :     NODE{color=ref(COLORED c), ...} =>
1334 :     (UA.update(proh, c, stamp); neighbors rs)
1335 :     | _ => neighbors rs
1336 :     )
1337 :     (*
1338 :     * Look at lost moves and see if it is possible to
1339 :     * color the move with the same color
1340 :     *)
1341 :     fun getPref([], pref) = pref
1342 : monnier 498 | getPref(MV{status=ref(LOST | BRIGGS_MOVE | GEORGE_MOVE),
1343 :     src, dst, ...}::mvs, pref) =
1344 : monnier 469 let val src as NODE{number=s,...} = chase src
1345 : monnier 498 val other = if s = number then chase dst else src
1346 : monnier 469 in case other of
1347 :     NODE{color=ref(COLORED c),...} => getPref(mvs, c::pref)
1348 :     | _ => getPref(mvs, pref)
1349 :     end
1350 :     | getPref(_::mvs, pref) = getPref(mvs, pref)
1351 :    
1352 :     val _ = neighbors(!adj)
1353 :     val pref = getPref(!movelist,[])
1354 :     val spills =
1355 :     let val col = getreg{pref=[], proh=proh, stamp=stamp}
1356 :     in color := COLORED col; spills
1357 :     end handle _ => node::spills
1358 :     in biasedColoring(stack, spills, stamp+1) end
1359 : monnier 498 val (spills, st) = if isOn(mode, BIASED_SELECTION)
1360 : monnier 469 then biasedColoring(stack, [], !stamp)
1361 :     else if !spillFlag then
1362 :     optimistic(stack, [], !stamp)
1363 :     else
1364 :     fastcoloring(stack, !stamp)
1365 :     in stamp := st;
1366 :     case spills of
1367 :     [] => {spills=[]}
1368 :     | spills =>
1369 : leunga 579 let fun undo [] = ()
1370 :     | undo(NODE{color,...}::nodes) = (color := PSEUDO; undo nodes)
1371 :     in undo stack;
1372 :     undoCoalesced (!trail);
1373 :     trail := END;
1374 :     {spills=spills}
1375 :     end
1376 : monnier 469 end
1377 :    
1378 :     (*
1379 : monnier 498 * Incorporate memory<->register moves into the interference graph
1380 :     *)
1381 :     fun initMemMoves(GRAPH{memMoves, ...}) =
1382 :     let fun move(NODE{movelist, movecost, ...}, mv, cost) =
1383 :     (movelist := mv :: !movelist;
1384 :     movecost := cost + !movecost
1385 :     )
1386 :    
1387 :     fun setMove(dst, src, mv, cost) =
1388 :     (move(dst, mv, cost); move(src, mv, cost))
1389 :    
1390 :     fun init [] = ()
1391 :     | init((mv as MV{dst, src, cost, ...})::mvs) =
1392 :     let val dst as NODE{color=dstCol, ...} = chase dst
1393 :     val src as NODE{color=srcCol, ...} = chase src
1394 :     in case (!dstCol, !srcCol) of
1395 :     (SPILLED x, SPILLED y) => setMove(dst, src, mv, cost)
1396 :     | (SPILLED _, PSEUDO) => setMove(dst, src, mv, cost)
1397 :     | (PSEUDO, SPILLED _) => setMove(dst, src, mv, cost)
1398 :     | (SPILLED _, COLORED _) => () (* skip *)
1399 :     | (COLORED _, SPILLED _) => () (* skip *)
1400 :     | _ => error "initMemMoves" ;
1401 :     init mvs
1402 :     end
1403 :     val moves = !memMoves
1404 :     in memMoves := [];
1405 :     init moves
1406 :     end
1407 :    
1408 : george 545
1409 : monnier 498 (*
1410 : george 545 * Compute savings due to memory<->register moves
1411 :     *)
1412 :     fun moveSavings(GRAPH{memMoves=ref [], ...}) = (fn node => 0)
1413 :     | moveSavings(GRAPH{memMoves, bitMatrix, ...}) =
1414 :     let exception Savings
1415 :     val savingsMap = Intmap.new(32, Savings)
1416 :     : {pinned:int,cost:int} Intmap.intmap
1417 :     val savings = Intmap.mapWithDefault(savingsMap, {pinned= ~1, cost=0})
1418 :     val addSavings = Intmap.add savingsMap
1419 :     val member = BM.member(!bitMatrix)
1420 :     fun incSavings(u, v, c) =
1421 :     let val {pinned, cost} = savings u
1422 :     in if pinned <> ~1 andalso v <> pinned orelse member(u, v)
1423 :     then ()
1424 :     else addSavings(u, {pinned=v, cost=cost + c + c})
1425 :     end
1426 : leunga 579 fun computeSavings [] = ()
1427 :     | computeSavings(MV{dst, src, cost, ...}::mvs) =
1428 :     let val src as NODE{number=u, color=cu, ...} = chase src
1429 :     val dst as NODE{number=v, color=cv, ...} = chase dst
1430 :     in case (!cu, !cv) of
1431 :     (SPILLED _, PSEUDO) => incSavings(v, u, cost)
1432 :     | (PSEUDO, SPILLED _) => incSavings(u, v, cost)
1433 :     | _ => ();
1434 :     computeSavings mvs
1435 :     end
1436 :     in computeSavings (!memMoves);
1437 : george 545 fn node => #cost(savings node)
1438 :     end
1439 :    
1440 :     (*
1441 : monnier 469 * Spill coalescing.
1442 :     * Coalesce non-interfering moves between spilled nodes,
1443 :     * in non-increasing order of move cost.
1444 :     *)
1445 : monnier 498 fun spillCoalescing(GRAPH{bitMatrix, ...}) =
1446 :     let val member = BM.member(!bitMatrix)
1447 :     val addEdge = BM.add(!bitMatrix)
1448 :     in fn nodesToSpill =>
1449 :     let
1450 :     (* Find moves between two spilled nodes *)
1451 :     fun collectMoves([], mv') = mv'
1452 :     | collectMoves(NODE{movelist, color=ref(SPILLED _), ...}::ns, mv') =
1453 :     let fun ins([], mv') = collectMoves(ns, mv')
1454 :     | ins(MV{status=ref(COALESCED | CONSTRAINED), ...}::mvs,
1455 :     mv') = ins(mvs, mv')
1456 :     | ins((mv as MV{dst, src, ...})::mvs, mv') =
1457 :     (case (chase dst, chase src) of
1458 :     (NODE{color=ref(SPILLED x), number=d, ...},
1459 :     NODE{color=ref(SPILLED y), number=s, ...}) =>
1460 :     if d = s orelse (* trival move *)
1461 :     (x >= 0 andalso y >= 0) (* both are fixed *)
1462 :     then ins(mvs, mv')
1463 :     else ins(mvs, MV.add(mv, mv'))
1464 :     | _ => ins(mvs, mv')
1465 :     )
1466 :     in ins(!movelist, mv') end
1467 :     | collectMoves(_::ns, mv') = collectMoves(ns, mv')
1468 : monnier 475
1469 : monnier 498 val mvs = collectMoves(nodesToSpill, MV.EMPTY)
1470 : monnier 475
1471 : monnier 498 (* Coalesce moves between two spilled nodes *)
1472 :     fun coalesceMoves(MV.EMPTY) = ()
1473 :     | coalesceMoves(MV.TREE(MV{dst, src, cost, ...}, _, l, r)) =
1474 :     let val dst as NODE{color=colorDst, ...} = chase dst
1475 :     val src = chase src
1476 :    
1477 :     (* Make sure that dst is the non-mem reg node *)
1478 :     val (dst, src) =
1479 :     case !colorDst of
1480 :     SPILLED ~1 => (dst, src)
1481 :     | _ => (src, dst)
1482 :    
1483 :     val dst as NODE{number=d, color=colorDst, adj=adjDst,
1484 :     defs=defsDst, uses=usesDst, ...} = dst
1485 :     val src as NODE{number=s, color=colorSrc, adj=adjSrc,
1486 :     defs=defsSrc, uses=usesSrc, ...} = src
1487 : monnier 475
1488 : monnier 498 (* combine adjacency lists *)
1489 :     fun union([], adjSrc) = adjSrc
1490 :     | union((n as NODE{color, adj=adjT,
1491 :     number=t, ...})::adjDst, adjSrc) =
1492 :     (case !color of
1493 :     (SPILLED _ | PSEUDO) =>
1494 :     if addEdge(s, t) then
1495 :     (adjT := src :: !adjT; union(adjDst, n::adjSrc))
1496 :     else union(adjDst, adjSrc)
1497 :     | COLORED _ =>
1498 :     if addEdge(s, t) then union(adjDst, n::adjSrc)
1499 :     else union(adjDst, adjSrc)
1500 :     | _ => union(adjDst, adjSrc)
1501 :     )
1502 :     val mvs = MV.merge(l,r)
1503 :     in if d = s then (* trivial *)
1504 :     coalesceMoves mvs
1505 :     else
1506 :     (case !colorDst of
1507 :     SPILLED x =>
1508 :     if x >= 0 orelse (* both dst and src are mem regs *)
1509 :     member(d, s) (* they interfere *)
1510 :     then
1511 :     ((* print("Bad "^Int.toString d ^
1512 :     "<->"^Int.toString s^"\n")*))
1513 :     else
1514 :     ((* print(Int.toString d ^"<->"^Int.toString s^"\n");*)
1515 :     ra_spill_coal := !ra_spill_coal + 1;
1516 :     (* unify *)
1517 :     colorDst := ALIASED src;
1518 :     adjSrc := union(!adjDst, !adjSrc);
1519 :     if x >= 0 then ()
1520 :     else
1521 :     (defsSrc := concat(!defsDst, !defsSrc);
1522 :     usesSrc := concat(!usesDst, !usesSrc))
1523 :     )
1524 :     | _ => error "coalesceMoves";
1525 :     coalesceMoves mvs
1526 : monnier 469 )
1527 : monnier 498 end
1528 :     in coalesceMoves mvs
1529 :     end
1530 : monnier 427 end
1531 :    
1532 :     (*
1533 : george 545 (*
1534 : monnier 475 * Spill propagation.
1535 :     *)
1536 : monnier 498 fun spillPropagation(G as GRAPH{bitMatrix, memRegs, ...}) nodesToSpill =
1537 : monnier 475 let val spillCoalescing = spillCoalescing G
1538 :     exception SpillProp
1539 :     val visited = Intmap.new(32, SpillProp) : bool Intmap.intmap
1540 :     val hasBeenVisited = Intmap.mapWithDefault (visited, false)
1541 :     val markAsVisited = Intmap.add visited
1542 : monnier 498 val member = BM.member(!bitMatrix)
1543 : monnier 475
1544 :     (* compute savings due to spill coalescing.
1545 :     * The move list must be associated with a colorable node.
1546 : monnier 498 * The pinned flag is to prevent the spill node from coalescing
1547 :     * two different fixed memory registers.
1548 : monnier 475 *)
1549 : monnier 498 fun coalescingSavings([], pinned, sc) = (pinned, sc+sc)
1550 :     | coalescingSavings(MV{status=ref(CONSTRAINED | COALESCED), ...}::mvs,
1551 :     pinned, sc) = coalescingSavings(mvs, pinned, sc)
1552 :     | coalescingSavings(MV{dst, src, cost, ...}::mvs, pinned, sc) =
1553 :     let val NODE{number=d, color=dstCol, ...} = chase dst
1554 :     val NODE{number=s, color=srcCol, ...} = chase src
1555 :     fun savings(x) =
1556 :     if member(d, s) then coalescingSavings(mvs, pinned, sc)
1557 :     else if x = ~1 then coalescingSavings(mvs, pinned, sc+cost)
1558 :     else if pinned >= 0 andalso pinned <> x then
1559 :     (* already coalesced with another mem reg *)
1560 :     coalescingSavings(mvs, pinned, sc)
1561 :     else
1562 :     (* coalescingSavings(mvs, x, sc+cost) *) (* XXX *)
1563 :     coalescingSavings(mvs, x, sc+cost)
1564 :     in if d = s then
1565 :     coalescingSavings(mvs, pinned, sc)
1566 :     else
1567 :     case (!dstCol, !srcCol) of
1568 :     (SPILLED x, PSEUDO) => savings(x)
1569 :     | (PSEUDO, SPILLED x) => savings(x)
1570 :     | _ => coalescingSavings(mvs, pinned, sc)
1571 :     end
1572 : monnier 475
1573 : monnier 498 (* Insert all spillable neighbors onto the worklist *)
1574 : monnier 475 fun insert([], worklist) = worklist
1575 :     | insert((node as NODE{color=ref PSEUDO, number, ...})::adj, worklist) =
1576 : monnier 498 if hasBeenVisited number
1577 :     then insert(adj, worklist)
1578 : monnier 475 else (markAsVisited (number, true);
1579 :     insert(adj, node::worklist))
1580 :     | insert(_::adj, worklist) = insert(adj, worklist)
1581 :    
1582 :     val marker = SPILLED(~1)
1583 :    
1584 :     (* Process all nodes from the worklist *)
1585 : monnier 498 fun propagate([], spilled) = spilled
1586 :     | propagate((node as NODE{color as ref PSEUDO,
1587 :     pri=ref spillcost, number,
1588 :     adj, movelist, ...})::worklist,
1589 :     spilled) =
1590 :     let val (pinned, savings) = coalescingSavings(!movelist, ~1, 0)
1591 : george 545 in (* if (if pinned >= 0 then savings > spillcost
1592 :     else savings >= spillcost) *) (* XXX *)
1593 :     if savings >= spillcost
1594 : monnier 498 then (* propagate spill *)
1595 : monnier 475 (ra_spill_prop := !ra_spill_prop + 1;
1596 :     color := marker; (* spill the node *)
1597 : monnier 498 (* print("Propagating "^Int.toString number^" "^
1598 :     "savings="^Int.toString(savings)^
1599 :     " cost="^Int.toString spillcost^"\n"); *)
1600 :     (* run spill coalescing *)
1601 :     spillCoalescing [node];
1602 :     propagate(insert(!adj, worklist), node::spilled)
1603 : monnier 475 )
1604 :     else
1605 : monnier 498 propagate(worklist, spilled)
1606 : monnier 475 end
1607 : monnier 498 | propagate(_::worklist, spilled) =
1608 :     propagate(worklist, spilled)
1609 : monnier 475
1610 :     (* Initialize worklist *)
1611 :     fun init([], worklist) = worklist
1612 : monnier 498 | init(NODE{adj, color=ref(SPILLED _), ...}::rest, worklist) =
1613 : monnier 475 init(rest, insert(!adj, worklist))
1614 :     | init(_::rest, worklist) = init(rest, worklist)
1615 :    
1616 :     (*
1617 :     * Iterate between spill coalescing and propagation
1618 :     *)
1619 :     fun iterate(spillWorkList, spilled) =
1620 : monnier 498 let (* run one round of coalescing first *)
1621 :     val _ = spillCoalescing spillWorkList
1622 : monnier 475 val propagationWorkList = init(spillWorkList, [])
1623 : monnier 498 (* iterate on our own spill nodes *)
1624 :     val spilled = propagate(propagationWorkList, spilled)
1625 :     (* try the memory registers too *)
1626 :     val spilled = propagate(!memRegs, spilled)
1627 :     in spilled
1628 : monnier 475 end
1629 : monnier 498
1630 : monnier 475 in iterate(nodesToSpill, nodesToSpill)
1631 :     end
1632 :    
1633 :     (*
1634 : monnier 469 * Spill coloring.
1635 :     * Assign logical spill locations to all the spill nodes.
1636 : george 545 *
1637 :     * IMPORTANT BUG FIX:
1638 :     * Spilled copy temporaries are assigned its own set of colors and
1639 :     * cannot share with another other nodes. They can share colors with
1640 :     * themselves however.
1641 : monnier 427 *)
1642 : george 545 fun spillColoring(GRAPH{spillLoc, copyTmps, mode, ...}) nodesToSpill =
1643 : monnier 469 let val proh = A.array(length nodesToSpill, ~1)
1644 :     val firstLoc = !spillLoc
1645 : george 545 val _ = spillLoc := firstLoc - 1 (* allocate one location first *)
1646 :    
1647 :     fun colorCopyTmps(tmps) =
1648 :     let fun loop([], found) = found
1649 :     | loop(NODE{color as ref(SPILLED ~1), ...}::tmps, found) =
1650 :     (color := SPILLED firstLoc; loop(tmps, true))
1651 :     | loop(_::tmps, found) = loop(tmps, found)
1652 :     in if loop(tmps, false) then
1653 :     (spillLoc := !spillLoc - 1; firstLoc - 1)
1654 :     else firstLoc
1655 :     end
1656 :    
1657 :     fun selectColor([], firstColor, currLoc) = ()
1658 : monnier 498 | selectColor(NODE{color as ref(SPILLED ~1), number, adj, ...}::nodes,
1659 : george 545 firstColor, currLoc) =
1660 : monnier 498 let fun neighbors [] = ()
1661 : monnier 469 | neighbors(n::ns) =
1662 : monnier 498 let fun mark(NODE{color=ref(SPILLED loc), ...}) =
1663 :     (if loc >= ~1 then () (* no location yet *)
1664 :     else A.update(proh, firstLoc - loc, number);
1665 :     neighbors ns
1666 :     )
1667 :     | mark(NODE{color=ref(ALIASED n), ...}) = mark n
1668 :     | mark _ = neighbors ns
1669 :     in mark n end
1670 : monnier 469 val _ = neighbors(!adj)
1671 :     fun findColor(loc, startingPoint) =
1672 : george 545 let val loc = if loc < firstColor then !spillLoc + 1 else loc
1673 : monnier 469 in if A.sub(proh, firstLoc - loc) <> number then loc (* ok *)
1674 :     else if loc = startingPoint then (* new location *)
1675 :     let val loc = !spillLoc
1676 :     in spillLoc := loc - 1; loc end
1677 :     else findColor(loc - 1, startingPoint)
1678 :     end
1679 : george 545 val currLoc = if currLoc < firstColor then !spillLoc + 1
1680 : monnier 469 else currLoc
1681 :     val loc = findColor(currLoc, currLoc)
1682 : monnier 498 (* val _ = print("Spill("^Int.toString number^")="^
1683 :     Int.toString loc^"\n") *)
1684 : george 545 in color := SPILLED loc; (* mark with color *)
1685 :     selectColor(nodes, firstColor, loc - 1)
1686 : monnier 469 end
1687 : george 545 | selectColor(_::nodes, firstColor, currLoc) =
1688 :     selectColor(nodes, firstColor, currLoc)
1689 :    
1690 :     (* color the copy temporaries first *)
1691 :     val firstColor = if isOn(mode, HAS_PARALLEL_COPIES)
1692 :     then colorCopyTmps(!copyTmps) else firstLoc
1693 :     (* color the rest of the spilled nodes *)
1694 :     in selectColor(nodesToSpill, firstColor, !spillLoc)
1695 : monnier 427 end
1696 : george 545 *)
1697 : monnier 427
1698 : monnier 469 (*
1699 :     * Update the regmap, after finishing register allocation.
1700 :     * All nodes must have been colored.
1701 :     *)
1702 :     fun finishRA(GRAPH{regmap, nodes, deadCopies, ...}) =
1703 :     let val enter = Intmap.add regmap
1704 :     fun set(r, NODE{color=ref(COLORED c),...}) = enter(r, c)
1705 :     | set(r, NODE{color=ref(ALIASED n),...}) = set(r, n)
1706 : monnier 498 | set(r, NODE{color=ref(SPILLED s),...}) =
1707 :     enter(r,if s >= 0 then s else ~1) (* XXX *)
1708 :     | set(r, _) = error("finishRA "^Int.toString r)
1709 : monnier 469 in Intmap.app set nodes;
1710 :     case !deadCopies of
1711 :     [] => ()
1712 :     | dead => app (fn r => enter(r, ~1)) dead
1713 :     end
1714 : monnier 427
1715 : monnier 469 (*
1716 :     * Update the regmap, after copy propagation
1717 :     *)
1718 :     fun finishCP(GRAPH{regmap, nodes,...}) =
1719 :     let val enter = Intmap.add regmap
1720 :     in Intmap.app
1721 :     (fn (r, node as NODE{color as ref(ALIASED _),...}) =>
1722 :     (case chase node of
1723 :     NODE{color=ref(COLORED c),...} => enter(r, c)
1724 :     | NODE{color=ref PSEUDO, number,...} => enter(r, number)
1725 :     | NODE{color=ref REMOVED, number,...} => enter(r, number)
1726 :     | _ => error "finishCP"
1727 :     )
1728 :     | _ => ()
1729 :     ) nodes
1730 :     end
1731 :    
1732 :     (*
1733 :     * Clear the interference graph, but keep the nodes
1734 :     *)
1735 : monnier 498 fun clearGraph(GRAPH{bitMatrix, maxRegs, trail, spillFlag,
1736 : george 545 deadCopies, memMoves, copyTmps, ...}) =
1737 : monnier 469 let val edges = BM.edges(!bitMatrix)
1738 :     in trail := END;
1739 :     spillFlag := false;
1740 :     deadCopies := [];
1741 : monnier 498 memMoves := [];
1742 : george 545 copyTmps := [];
1743 :     bitMatrix := BM.empty;
1744 : monnier 469 bitMatrix := G.newBitMatrix{edges=edges, maxRegs=maxRegs()}
1745 :     end
1746 :    
1747 :     fun clearNodes(GRAPH{nodes,...}) =
1748 :     let fun init(_, NODE{pri, degree, adj, movecnt, movelist,
1749 :     movecost, defs, uses, ...}) =
1750 :     (pri := 0; degree := 0; adj := []; movecnt := 0; movelist := [];
1751 :     defs := []; uses := []; movecost := 0)
1752 :     in Intmap.app init nodes
1753 :     end
1754 :    
1755 : monnier 498 end (* local *)
1756 :    
1757 : monnier 469 end

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