1 (* Pasted from Pottier's PP compiler *)
7 (* ------------------------------------------------------------------------- *)
10 (* A decision is of the form either [Spill] -- the vertex could
11 not be colored and should be spilled into a stack slot -- or
12 [Color] -- the vertex was assigned a hardware register. *)
16 | Color of I8051.register
18 (* [print_decision] turns a decision into a string. *)
20 let print_decision = function
24 Printf.sprintf "colored $%s" (I8051.print_register hwr)
26 (* ------------------------------------------------------------------------- *)
29 (* A coloring is a partial function of graph vertices to decisions.
30 Vertices that are not in the domain of the coloring are waiting for
31 a decision to be made. *)
36 (* ------------------------------------------------------------------------- *)
42 (* [add_color coloring r colors] returns the union of the set [colors] with
43 the element [color], if the vertex [r] was assigned color [color], and
44 returns [colors] if [r] was spilled. *)
46 let add_color coloring r colors =
47 match Vertex.Map.find r coloring with
51 ColorSet.add color colors
53 (* These are the colors that we work with. *)
55 let colors : ColorSet.t =
58 (* This is the number of available colors. *)
61 ColorSet.cardinal colors
63 (* ------------------------------------------------------------------------- *)
64 (* Choices of colors. *)
66 (* [forbidden_colors graph coloring v] is the set of colors that cannot be
67 assigned to [v] considering [coloring], a coloring of every vertex in
68 [graph] except [v]. *)
69 (* This takes into account [v]'s possible interferences with hardware
70 registers, which are viewed as forbidden colors. *)
72 let forbidden_colors graph coloring v =
73 Vertex.Set.fold (add_color coloring) (ipp graph v) (iph graph v)
75 (* ------------------------------------------------------------------------- *)
76 (* Low and high vertices. *)
78 (* A vertex is low (or insignificant) if its degree is less than [k].
79 It is high (or significant) otherwise. *)
84 (* [high_neighbors graph v] is the set of all high neighbors of [v]. *)
86 let high_neighbors graph v =
87 Vertex.Set.filter (high graph) (ipp graph v)
89 (* ------------------------------------------------------------------------- *)
90 (* George's conservative coalescing criterion. *)
92 (* According to this criterion, two vertices [a] and [b] can be
93 coalesced, suppressing [a] and keeping [b], if the following
96 1. (pseudo-registers) every high neighbor of [a] is a neighbor of [b];
97 2. (hardware registers) every hardware register that interferes with
98 [a] also interferes with [b].
100 This means that, after all low vertices have been removed, any color that
101 is suitable for [b] is also suitable for [a]. *)
103 let georgepp graph (a, b) =
104 Vertex.Set.subset (high_neighbors graph a) (ipp graph b) &&
105 I8051.RegisterSet.subset (iph graph a) (iph graph b)
107 (* According to this criterion, a vertex [a] and a hardware register
108 [c] can be coalesced (that is, [a] can be assigned color [c]) if
109 every high neighbor of [a] interferes with [c]. *)
111 let georgeph graph (a, c) =
112 Vertex.Set.fold (fun neighbor accu ->
114 I8051.RegisterSet.mem c (iph graph neighbor)
115 ) (high_neighbors graph a) true
117 (* ------------------------------------------------------------------------- *)
118 (* Here is the coloring algorithm. *)
120 module Color (G : sig
123 val uses: Register.t -> int
128 (* The cost function heuristically evaluates how much it might cost
129 to spill vertex [v]. Here, the cost is the ratio of the number of
130 uses of the pseudo-registers represented by [v] by the degree of
131 [v]. One could also take into account the number of nested loops
132 that the uses appear within, but that is not done here. *)
136 Register.Set.fold (fun r uses ->
138 ) (registers graph v) 0
140 (float_of_int uses) /. (float_of_int (degree graph v))
142 (* The algorithm maintains a transformed graph as it runs. It is
143 obtained from the original graph by removing, coalescing, and
144 freezing vertices. *)
146 (* Each of the functions that follow returns a coloring of the graph
147 that it is passed. These functions correspond to the various
148 states of the algorithm (simplification, coalescing, freezing,
149 spilling, selection). The function [simplification] is the
152 (* [simplification] removes non-move-related nodes of low degree. *)
154 let rec simplification graph : coloring =
156 match lowest_non_move_related graph with
158 | Some (v, d) when d < k ->
160 (* We found a non-move-related node [v] of low degree. Color
161 the rest of the graph, then color [v]. This is what I call
165 printf "Simplifying low vertex: %s.\n%!" (print_vertex graph v);
171 (* There are no non-move-related nodes of low degree.
172 Could not simplify further. Start coalescing. *)
176 (* [coalescing] looks for a preference edge that can be collapsed.
177 It is called after [simplification], so it is known, at this
178 point, that all nodes of low degree are move-related. *)
180 and coalescing graph : coloring =
182 (* Find a preference edge between two vertices that passes
185 [pppick] examines all preference edges in the graph, so its use
186 is inefficient. It would be more efficient instead to examine
187 only areas of the graph that have changed recently. More
188 precisely, it is useless to re-examine a preference edge that
189 did not pass George's criterion the last time it was examined
190 and whose neighborhood has not been modified by simplification,
191 coalescing or freezing. Indeed, in that case, and with a
192 sufficiently large definition of ``neighborhood'', this edge is
193 guaranteed to again fail George's criterion. It would be
194 possible to modify the [Interference.graph] data structure so
195 as to keep track of which neighborhoods have been modified and
196 provide a specialized, more efficient version of [pppick]. This
199 match pppick graph (georgepp graph) with
204 printf "Coalescing %s with %s.\n%!" (print_vertex graph a) (print_vertex graph b);
206 (* Coalesce [a] with [b] and color the remaining graph. *)
208 let coloring = simplification (coalesce graph a b) in
210 (* Assign [a] the same color as [b]. *)
212 Vertex.Map.add a (Vertex.Map.find b coloring) coloring
216 (* Find a preference edge between a vertex and a hardware
217 register that passes George's criterion. Like [pppick],
220 match phpick graph (georgeph graph) with
225 printf "Coalescing %s with $%s.\n%!" (print_vertex graph a) (I8051.print_register c);
227 (* Coalesce [a] with [c] and color the remaining graph. *)
229 let coloring = simplification (coalesceh graph a c) in
231 (* Assign [a] the color [c]. *)
233 Vertex.Map.add a (Color c) coloring
237 (* Could not coalesce further. Start freezing. *)
241 (* [freezing] begins after [simplification] and [coalescing] are
242 finished, so it is known, at this point, that all nodes of low
243 degree are move-related and no coalescing is possible. [freezing]
244 looks for a node of low degree (which must be move-related) and
245 removes the preference edges that it carries. This potentially
246 opens new opportunities for simplification and coalescing. *)
248 and freezing graph : coloring =
250 match lowest graph with
252 | Some (v, d) when d < k ->
254 (* We found a move-related node [v] of low degree.
255 Freeze it and start over. *)
258 printf "Freezing low vertex: %s.\n%!" (print_vertex graph v);
260 simplification (freeze graph v)
264 (* Could not freeze further. Start spilling. *)
268 (* [spilling] begins after [simplification], [coalescing], and
269 [freezing] are finished, so it is known, at this point, that
270 there are no nodes of low degree.
272 Thus, we are facing a potential spill. However, we do optimistic
273 coloring: we do not spill a vertex right away, but proceed
274 normally, just as if we were doing simplification. So, we pick a
275 vertex [v], remove it, and check whether a color can be assigned
276 to [v] only after coloring what remains of the graph.
278 It is crucial to pick a vertex that has few uses in the code. It
279 would also be good to pick one that has high degree, as this will
280 help color the rest of the graph. Thus, we pick a vertex that has
281 minimum cost, where the cost is obtained as the ratio of the
282 number of uses of the pseudo-registers represented by this vertex
283 in the code by the degree of the vertex. One could also take into
284 account the number of nested loops that the uses appear within,
285 but that is not done here.
287 The use of [minimum] is inefficient, because this function
288 examines all vertices in the graph. It would be possible to
289 augment the [Interference.graph] data structure so as to keep
290 track of the cost associated with each vertex and provide
291 efficient access to a minimum cost vertex. This is not done
294 and spilling graph : coloring =
296 match minimum (cost graph) graph with
300 printf "Spilling high vertex: %s.\n%!" (print_vertex graph v);
306 (* The graph is empty. Return an empty coloring. *)
310 (* [selection] removes the vertex [v] from the graph, colors the
311 remaining graph, then selects a color for [v].
313 If [v] is low, that is, if [v] has degree less than [k], then at
314 least one color must still be available for [v], regardless of
315 how the remaining graph was colored.
317 If [v] was a potential spill, then it is not certain that a color
318 is still available. If one is, though, then we are rewarded for
319 being optimistic. If none is, then [v] becomes an actual
322 and selection graph v : coloring =
324 (* Remove [v] from the graph and color what remains. *)
326 let coloring = simplification (remove graph v) in
328 (* Determine which colors are allowed. *)
330 let allowed = ColorSet.diff colors (forbidden_colors graph coloring v) in
334 We pick a color randomly among those that are allowed. One could
335 attempt to use biased coloring, that is, to pick a color that seems
336 desirable (or not undesirable) according to the preference edges
337 found in the initial graph. But that is probably not worth the
342 Color (ColorSet.choose allowed)
348 printf "Decision concerning %s: %s.\n%!" (print_vertex graph v) (print_decision decision);
350 (* Record our decision and return. *)
352 Vertex.Map.add v decision coloring
354 (* Run the algorithm. *)
357 simplification G.graph