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

SCM Repository

[smlnj] Annotation of /MLRISC/releases/release-110.79/ra/ra-core.sml
ViewVC logotype

Annotation of /MLRISC/releases/release-110.79/ra/ra-core.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4168 - (view) (download)

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

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