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 428 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/ra/ra-core.sml

1 : monnier 427 (*
2 :     * Core of the register allocator
3 :     *
4 :     * -- Allen
5 :     *)
6 :    
7 :     structure RACore : RA_CORE =
8 :     struct
9 :    
10 :     structure G = RAGraph
11 :    
12 :     open G
13 :    
14 :     val spillRegSentinel = ~1
15 :    
16 :     (*
17 :     * Utility functions
18 :     *)
19 :     fun error msg = MLRiscErrorMsg.error("RACore",msg)
20 :    
21 :     fun nodeNumber(NODE{number, ...}) = number
22 :    
23 :     fun isMoveRelated(NODE{movecnt=ref 0, ...}) = false
24 :     | isMoveRelated _ = true
25 :    
26 :     fun chase(NODE{color=ref(ALIASED r), ...}) = chase r
27 :     | chase x = x
28 :    
29 :     (* debugging *)
30 :     fun dumpGraph(GRAPH{nodes,...}) =
31 :     let fun prList (l:int list,msg:string) = let
32 :     fun pr [] = print "\n"
33 :     | pr (x::xs) = (print (Int.toString x ^ " "); pr xs)
34 :     in
35 :     print msg; pr l
36 :     end
37 :     fun prAdj(nodes, n)= prList(map (nodeNumber o chase) nodes, n)
38 :     in Intmap.app
39 :     (fn (n, NODE{adj, ...}) =>
40 :     prAdj (!adj, Int.toString(n) ^ " <--> "))
41 :     nodes
42 :     end
43 :    
44 :     (*
45 :     * Update the regmap to be consistent with the nodes set,
46 :     * After register allocation. This means that all nodes have been colored
47 :     *)
48 :     fun finishRA(GRAPH{regmap,nodes,...}) =
49 :     let val enter = Intmap.add regmap
50 :     in Intmap.app
51 :     (fn (i, node) =>
52 :     case chase node
53 :     of NODE{color=ref(COLORED col), ...} => enter(i,col)
54 :     | _ => error "finishRA"
55 :     (*esac*))
56 :     nodes
57 :     end
58 :    
59 :     (*
60 :     * Update the regmap to be consistent with the nodes set,
61 :     * after copy propagation.
62 :     *)
63 :     fun finishCP(GRAPH{regmap,nodes,...}) =
64 :     let val enter = Intmap.add regmap
65 :     in Intmap.app
66 :     (fn (i, node as NODE{color as ref (ALIASED _), ...}) =>
67 :     (case (chase node) of
68 :     NODE{color=ref(COLORED col), ...} => enter(i, col)
69 :     | NODE{color=ref PSEUDO, number, ...} => enter(i, number)
70 :     | NODE{color=ref REMOVED, number, ...} => enter(i,number)
71 :     | _ => error "finishP"
72 :     (*esac*))
73 :     | _ => ())
74 :     nodes
75 :     end
76 :    
77 :    
78 :     (* add an edge to the interference graph.
79 :     * note --- adjacency lists for machine registers are not maintained.
80 :     *)
81 :     fun addEdge (GRAPH{bitMatrix,...}) =
82 :     let val addBitMatrix = BM.add bitMatrix
83 :     fun add(r as NODE{color=ref PSEUDO, adj, degree,...}, s) =
84 :     (adj := s :: !adj; degree := 1 + !degree)
85 :     | add(NODE{color=ref(ALIASED _), ...}, _) =
86 :     error "addEdge.add: ALIASED"
87 :     | add(NODE{color=ref(REMOVED), ...}, _) =
88 :     error "addEdge.add: REMOVED"
89 :     | add _ = ()
90 :     in fn (x as NODE{number=xn, ...}, y as NODE{number=yn, ...}) =>
91 :     if xn = yn then ()
92 :     else if addBitMatrix(if xn < yn then (xn, yn) else (yn, xn)) then
93 :     (add(x, y); add(y, x))
94 :     else ()
95 :     end
96 :    
97 :     (*
98 :     * Activate moves associated with a node and its neighbors
99 :     *)
100 :     fun enableMoves(node as NODE{adj, ...}, moveWkl) =
101 :     let fun addMvWkl([], wkl) = wkl
102 :     | addMvWkl((mv as MV{status, ...})::rest, wkl) =
103 :     (case !status
104 :     of MOVE =>
105 :     (status := WORKLIST; addMvWkl(rest, mv::wkl))
106 :     | _ => addMvWkl(rest, wkl)
107 :     (*esac*))
108 :     fun add([], wkl) = wkl
109 :     | add((node as NODE{movelist, color=ref PSEUDO,...})::ns, wkl) =
110 :     if isMoveRelated node then
111 :     add(ns, addMvWkl(!movelist, wkl))
112 :     else
113 :     add(ns, wkl)
114 :     | add(_::ns, wkl) = add(ns,wkl)
115 :     in
116 :     add(node:: (!adj), moveWkl)
117 :     end
118 :    
119 :    
120 :     (*
121 :     * Decrement the degree associated with a node returning a potentially
122 :     * new set of worklists --- simplifyWkl, freezeWkl, and moveWkl.
123 :     *)
124 :     fun decrementDegree(K,node as (NODE{degree as ref d, ...}),
125 :     simpWkl,fzWkl,mvWkl) =
126 :     (degree := d - 1;
127 :     if d = K then
128 :     let val moveWkl = enableMoves(node, mvWkl)
129 :     in if isMoveRelated(node) then
130 :     (simpWkl, node::fzWkl, moveWkl)
131 :     else
132 :     (node::simpWkl, fzWkl, moveWkl)
133 :     end
134 :     else
135 :     (simpWkl, fzWkl, mvWkl)
136 :     )
137 :    
138 :    
139 :    
140 :     (* ------------------------------------------------------------------------
141 :     * Core phases
142 :     * ------------------------------------------------------------------------*)
143 :    
144 :     (*--------build worklists----------*)
145 :    
146 :     (* make initial worklists. Note: register aliasing may have
147 :     * occurred due to previous rounds of graph-coloring; therefore
148 :     * nodes may already be colored or aliased.
149 :     *)
150 :     fun makeWorkLists (GRAPH{nodes,K,...}) initialMoves =
151 :     let fun iter([], simpWkl, fzWkl, spillWkl) =
152 :     {simplifyWkl = simpWkl,
153 :     freezeWkl = fzWkl,
154 :     spillWkl = spillWkl,
155 :     moveWkl = initialMoves,
156 :     stack = []}
157 :     | iter(node::rest, simpWkl, fzWkl, spillWkl) =
158 :     (case node
159 :     of NODE{color=ref PSEUDO, degree, ...} =>
160 :     if !degree >= K then
161 :     iter(rest, simpWkl, fzWkl, node::spillWkl)
162 :     else if isMoveRelated(node) then
163 :     iter(rest, simpWkl, node::fzWkl, spillWkl)
164 :     else
165 :     iter(rest, node::simpWkl, fzWkl, spillWkl)
166 :     | _ =>
167 :     iter(rest, simpWkl, fzWkl, spillWkl)
168 :     (*esac*))
169 :     in iter(Intmap.values nodes, [], [], [])
170 :     end
171 :    
172 :     (*---------simplify-----------*)
173 :     fun simplifyPhase(GRAPH{K,...}) =
174 :     let
175 :     (* for every node removed from the simplify worklist, decrement the
176 :     * degree of all of its neighbors, potentially adding the neighbor
177 :     * to the simplify worklist.
178 :     *)
179 :     fun simplify{simplifyWkl,freezeWkl,spillWkl,moveWkl,stack} =
180 :     let fun loop([], fzWkl, mvWkl, stack) =
181 :     {simplifyWkl=[], freezeWkl=fzWkl, moveWkl=mvWkl,
182 :     stack=stack, spillWkl=spillWkl}
183 :     | loop((node as NODE{color as ref PSEUDO, adj, number, ...})::wkl,
184 :     fzWkl, mvWkl, stack) =
185 :     let fun forallAdj([], simpWkl, fzWkl, mvWkl) =
186 :     loop(simpWkl, fzWkl, mvWkl, node::stack)
187 :     | forallAdj((n as NODE{color as ref PSEUDO, ...})::rest,
188 :     wkl, fzWkl, mvWkl) =
189 :     let val (wkl, fzWkl, mvWkl) =
190 :     decrementDegree(K, n, wkl, fzWkl, mvWkl)
191 :     in forallAdj(rest, wkl, fzWkl, mvWkl)
192 :     end
193 :     | forallAdj(_::rest, simpWkl, fzWkl, mvWkl) =
194 :     forallAdj(rest, simpWkl, fzWkl, mvWkl)
195 :     in color := REMOVED;
196 :     (* print("Simplifying "^Int.toString number^"\n"); *)
197 :     forallAdj(!adj, wkl, fzWkl, mvWkl)
198 :     end
199 :     | loop(_::ns, fzWkl, mvWkl, stack) = loop(ns, fzWkl, mvWkl, stack)
200 :     in
201 :     loop(simplifyWkl, freezeWkl, moveWkl, stack)
202 :     end
203 :     in simplify
204 :     end (* simplify *)
205 :    
206 :    
207 :    
208 :     (*-----------coalesce-------------*)
209 :     fun coalescePhase(G as GRAPH{K,spillFlag,undoInfo,bitMatrix,...}) =
210 :     let val memBitMatrix = BM.member bitMatrix
211 :     fun member(NODE{number=x,...}, NODE{number=y,...}) =
212 :     memBitMatrix (if x<y then (x, y) else (y, x))
213 :     val addEdge = addEdge G
214 :    
215 :     fun coalesce{moveWkl, simplifyWkl, freezeWkl, spillWkl, stack} =
216 :     let (* v is being replaced by u *)
217 :     fun combine(v as NODE{color=cv, movecnt, movelist=mv, adj, ...},
218 :     u as NODE{color=cu, movelist=mu, ...},
219 :     mvWkl, simpWkl, fzWkl) = let
220 :     (* merge moveList entries, taking the opportunity
221 :     * to prune the lists
222 :     *)
223 :     fun mergeMoveLists([], [], mvs) = mvs
224 :     | mergeMoveLists([], xmvs, mvs) = mergeMoveLists(xmvs, [], mvs)
225 :     | mergeMoveLists((mv as MV{status,...})::rest, other, mvs) =
226 :     (case !status
227 :     of (MOVE | WORKLIST) =>
228 :     mergeMoveLists(rest, other, mv::mvs)
229 :     | _ => mergeMoveLists(rest, other, mvs)
230 :     (*esac*))
231 :    
232 :     (* form combined node *)
233 :     fun union([], mvWkl, simpWkl, fzWkl) = (mvWkl, simpWkl, fzWkl)
234 :     | union((t as NODE{color, ...})::rest, mvWkl, simpWkl, fzWkl) =
235 :     (case color
236 :     of ref (COLORED _) =>
237 :     (addEdge(t, u); union(rest, mvWkl, simpWkl, fzWkl))
238 :     | ref PSEUDO =>
239 :     ((* the order of addEdge and decrementDegree is important *)
240 :     addEdge (t, u);
241 :     let val (wkl, fzWkl, mvWkl) =
242 :     decrementDegree(K, t, simpWkl, fzWkl, mvWkl)
243 :     in
244 :     union(rest, mvWkl, wkl, fzWkl)
245 :     end)
246 :     | _ => union(rest, mvWkl, simpWkl, fzWkl)
247 :     (*esac*))
248 :     in
249 :     cv := ALIASED u;
250 :     movecnt := 0;
251 :     case cu
252 :     of ref PSEUDO => mu := mergeMoveLists(!mu, !mv, [])
253 :     | _ => ()
254 :     (*esac*);
255 :     union(!adj, mvWkl, simpWkl, fzWkl)
256 :     end (*combine*)
257 :    
258 :     (* If a node is no longer move-related as a result of coalescing,
259 :     * and can become candidate for the next round of simplification.
260 :     *)
261 :     fun addWkl(node as NODE{color=ref PSEUDO,
262 :     movecnt as ref mc,
263 :     degree, ...}, c, wkl) = let
264 :     val ncnt = mc - c
265 :     in
266 :     if ncnt <> 0 then (movecnt := ncnt; wkl)
267 :     else if !degree >= K then wkl
268 :     else node::wkl
269 :     end
270 :     | addWkl(_, _, wkl) = wkl
271 :    
272 :     (* heuristic used to determine if a pseudo and machine register
273 :     * can be coalesced.
274 :     *)
275 :     fun safe(r, NODE{adj, ...}) = let
276 :     fun f [] = true
277 :     | f (NODE{color=ref(COLORED _), ...}::rest) = f rest
278 :     | f (NODE{color=ref(ALIASED _), ...}::rest) = f rest
279 :     | f ((x as NODE{degree, ...})::rest) =
280 :     (!degree < K orelse member(x, r)) andalso f rest
281 :     in
282 :     f(!adj)
283 :     end
284 :    
285 :     (* return true if Briggs et.al. conservative heuristic applies *)
286 :     fun conservative(x as NODE{degree=ref dx, adj=ref xadj, ...},
287 :     y as NODE{degree=ref dy, adj=ref yadj, ...}) =
288 :     dx + dy < K
289 :     orelse let
290 :     (* movecnt is used as a temporary scratch to record high degree
291 :     * or colored nodes we have already visited
292 :     * ((movecnt = ~1) => visited)
293 :     * K-k is the number of nodes with deg > K
294 :     * n is the number of nodes with deg = K but not neighbors of
295 :     * both x and y
296 :     *
297 :     * Note: I've replaced the old version by a purely tail
298 :     * recursive version. This works faster.
299 :     *)
300 :     datatype trail = TR of int ref * int * trail | NIL
301 :     fun undo(NIL,v) = v
302 :     | undo(TR(movecnt,m,tr),v) = (movecnt := m; undo(tr,v))
303 :     fun g(_, _, 0, n, tr) = undo(tr,false)
304 :     | g([], [], k, n, tr) = undo(tr, k > n)
305 :     | g([], yadj, k, n, tr) = g(yadj, [], k, n, tr)
306 :     | g(NODE{color=ref REMOVED, ...}::vs,yadj,k,n,tr) =
307 :     g(vs,yadj,k,n,tr)
308 :     | g(NODE{color=ref(ALIASED _), ...}::vs,yadj,k,n,tr) =
309 :     g(vs,yadj,k,n,tr)
310 :     | g(NODE{movecnt=ref ~1,degree, ...}::vs, yadj,k,n,tr) =
311 :     if !degree = K then g(vs,yadj,k,n-1,tr)
312 :     else g(vs,yadj,k,n,tr)
313 :     | g(NODE{movecnt as ref m,color=ref(COLORED _),...}::vs,
314 :     yadj,k,n,tr) =
315 :     (movecnt := ~1; g(vs,yadj,k-1,n,TR(movecnt,m,tr)))
316 :     | g(NODE{movecnt as ref m,
317 :     degree = ref deg, color=ref PSEUDO,...}::vs, yadj,
318 :     k, n, tr) =
319 :     if deg < K then g(vs, yadj, k, n, tr)
320 :     else if deg = K then
321 :     (movecnt := ~1;
322 :     g(vs, yadj, k, n+1, TR(movecnt,m,tr)))
323 :     else (movecnt := ~1;
324 :     g(vs, yadj, k-1, n, TR(movecnt,m,tr)))
325 :     in g(xadj, yadj, K, 0, NIL)
326 :     end
327 :    
328 :     (* iterate over move worklist *)
329 :     fun doMoveWkl((mv as MV{src,dst,status,...})::rest, wkl, fzWkl) = let
330 :     val (u as NODE{number=u', color as ref ucol, ...},
331 :     v as NODE{number=v', movecnt as ref vCnt, ...}) =
332 :     case (chase src, chase dst)
333 :     of (x, y as NODE{color=ref (COLORED _),...}) => (y,x)
334 :     | (x,y) => (x,y)
335 :     (* val _ = print("Coalescing "^Int.toString u'^"<->"^
336 :     Int.toString v') *)
337 :     fun coalesceIt() =
338 :     (status := COALESCED;
339 :     if !spillFlag then undoInfo := (v, status) :: (!undoInfo)
340 :     else ())
341 :     in
342 :     if u' = v' then
343 :     (coalesceIt (); (* print " Trivial\n"; *)
344 :     doMoveWkl(rest, addWkl(u, 2, wkl), fzWkl))
345 :     else
346 :     (case v
347 :     of NODE{color=ref(COLORED _), ...} =>
348 :     (status := CONSTRAINED;
349 :     (* print " Both colored\n"; *)
350 :     doMoveWkl(rest, wkl, fzWkl))
351 :     | _ => (* v is a pseudo register *)
352 :     if member (v, u) then
353 :     (status := CONSTRAINED;
354 :     (* print " Interfere\n"; *)
355 :     doMoveWkl(rest, addWkl(v,1,addWkl(u,1,wkl)), fzWkl))
356 :     else
357 :     (case ucol
358 :     of COLORED _ =>
359 :     (* coalescing a pseudo and machine register *)
360 :     if safe(u,v) then
361 :     (coalesceIt();
362 :     (* print " Safe\n"; *)
363 :     doMoveWkl(combine(v, u, rest, wkl, fzWkl)))
364 :     else
365 :     (status := MOVE;
366 :     (* print " Unsafe\n"; *)
367 :     doMoveWkl(rest, wkl, fzWkl))
368 :     | _ =>
369 :     (* coalescing pseudo and pseudo register *)
370 :     if conservative(u, v) then let
371 :     val (mvWkl, wkl, fzWkl) =
372 :     combine(v, u, rest, wkl, fzWkl)
373 :     in
374 :     coalesceIt();
375 :     (* print " Ok\n"; *)
376 :     doMoveWkl(mvWkl, addWkl(u, 2-vCnt, wkl), fzWkl)
377 :     end
378 :     else
379 :     (status := MOVE;
380 :     (* print " Non-conservative\n"; *)
381 :     doMoveWkl(rest, wkl, fzWkl))
382 :     (*esac*))
383 :     (*esac*))
384 :     end
385 :     | doMoveWkl([], wkl, fzWkl) =
386 :     (* Note. The wkl is not uniq, because decrementDegree may have
387 :     * added the same node multiple times. We will let simplify take
388 :     * care of this.
389 :     *)
390 :     {simplifyWkl = wkl, freezeWkl = fzWkl,
391 :     moveWkl = [], spillWkl = spillWkl, stack = stack}
392 :     in
393 :     doMoveWkl(moveWkl, simplifyWkl, freezeWkl)
394 :     end (* coalesce *)
395 :     in coalesce
396 :     end
397 :    
398 :     (* When a move is frozen in place, the operands of the move may
399 :     * be simplified. One of the operands is node (below).
400 :     *)
401 :     fun wklFromFrozen(K, NODE{number=node, movelist, movecnt, ...}) =
402 :     let fun mkWkl(MV{status, src, dst, ...}) =
403 :     let val s = chase src and d = chase dst
404 :     val y = if nodeNumber s = node then d else s
405 :     in case !status
406 :     of MOVE =>
407 :     (status := LOST;
408 :     case y
409 :     of NODE{color=ref(COLORED _), ...} => NONE
410 :     | NODE{movecnt as ref 1, degree, ...} =>
411 :     (movecnt := 0;
412 :     if !degree < K then SOME y
413 :     else NONE)
414 :     | NODE{movecnt,...} =>
415 :     (movecnt := !movecnt - 1; NONE)
416 :     (*esac*))
417 :     | WORKLIST => error "wklFromFrozen"
418 :     | _ => NONE
419 :     end
420 :     in movecnt:=0;
421 :     List.mapPartial mkWkl (!movelist)
422 :     end
423 :    
424 :     (*-----------freeze------------*)
425 :    
426 :     fun freezePhase(GRAPH{K,...}) =
427 :     let
428 :    
429 :    
430 :     (* freeze a move in place
431 :     * Important: A node in the freezeWkl starts out with a degree < K.
432 :     * However, because of coalescing, it may have its degree increased
433 :     * to > K; BUT is guaranteed never to be a spill candidate. We do not
434 :     * want to select such nodes for freezing. There has to be some other
435 :     * freeze candidate that will liberate such nodes.
436 :     *)
437 :     fun freeze{freezeWkl, simplifyWkl, spillWkl, moveWkl, stack} = let
438 :     fun find([], acc) = (NONE, acc)
439 :     | find((n as NODE{color=ref PSEUDO, degree=ref d, ...})::ns, acc) =
440 :     if d >= K then find(ns, n::acc) else (SOME n, acc@ns)
441 :     | find(_::ns, acc) = find(ns, acc)
442 :    
443 :     fun mkWorkLists(NONE, fzWkl) =
444 :     {freezeWkl=fzWkl, simplifyWkl=simplifyWkl,
445 :     spillWkl=spillWkl, moveWkl=moveWkl, stack=stack}
446 :     | mkWorkLists(SOME n, fzWkl) =
447 :     {freezeWkl=fzWkl, simplifyWkl=n::wklFromFrozen(K,n),
448 :     spillWkl=spillWkl, moveWkl=moveWkl, stack=stack}
449 :     in
450 :     mkWorkLists(find(freezeWkl,[]))
451 :     end
452 :     in freeze
453 :     end
454 :    
455 :     (*-----------select-------------*)
456 :     (* spilling has occurred, and we retain coalesces upto to first
457 :     * potential (chaitin) spill. Any move that was coalesced after
458 :     * the spillFlag was set, is undone.
459 :     *)
460 :     fun optimisticSpilling
461 :     (G as GRAPH{getreg,stamp,nodes,regmap,undoInfo,firstPseudoR,proh,...})
462 :     ({stack, ...} : G.worklists) =
463 :     let fun undoCoalesced (NODE{number, color, ...}, status) =
464 :     (status := MOVE;
465 :     if number < firstPseudoR then () else color := PSEUDO)
466 :    
467 :     (* Briggs's optimistic spilling heuristic *)
468 :     fun optimistic([], spills) = spills
469 :     | optimistic((node as NODE{color, adj, ...}) ::ns, spills) =
470 :     let val st = !stamp
471 :     val _ = stamp := st + 1
472 :     fun neighbors [] = ()
473 :     | neighbors(r::rs) =
474 :     (case chase r
475 :     of NODE{color=ref (COLORED col), ...} =>
476 :     if col = spillRegSentinel then neighbors rs
477 :     else (Array.update(proh,col,st);neighbors rs)
478 :     | _ => neighbors rs
479 :     (*esac*))
480 :     val _ = neighbors(!adj)
481 :     (* Hmmm.. should use biased coloring here ... allen *)
482 :     val spills =
483 :     let val col = getreg{pref=[],stamp=st,proh=proh}
484 :     in color := COLORED col; spills
485 :     end handle _ => node::spills
486 :     in optimistic(ns, spills)
487 :     end
488 :     in case optimistic(stack, []) of
489 :     [] => []
490 :     | spills =>
491 :     (app (fn NODE{color, ...} => color := PSEUDO) stack;
492 :     app undoCoalesced (!undoInfo);
493 :     undoInfo := [];
494 :     spills)
495 :     end
496 :    
497 :     (*
498 :     * Simplify/coalesce/freeze
499 :     *)
500 :     fun simplifyCoalesceFreeze G =
501 :     let val simplify = simplifyPhase G
502 :     val coalesce = coalescePhase G
503 :     val freeze = freezePhase G
504 :     fun iterate(wl as {simplifyWkl= _::_, ...}) = iterate(simplify wl)
505 :     | iterate(wl as {moveWkl= _::_, ...}) = iterate(coalesce wl)
506 :     | iterate(wl as {freezeWkl= _::_, ...}) = iterate(freeze wl)
507 :     | iterate wl = wl
508 :     in iterate
509 :     end
510 :    
511 :     end
512 :    

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