1 (* Pasted from Pottier's PP compiler *)
4 open Untrusted_interference
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
19 (* [print_decision] turns a decision into a string. *)
21 let print_decision = function
25 Printf.sprintf "colored $%s" (I8051.print_register hwr)
28 (* ------------------------------------------------------------------------- *)
31 (* A coloring is a partial function of graph vertices to decisions.
32 Vertices that are not in the domain of the coloring are waiting for
33 a decision to be made. *)
38 (* ------------------------------------------------------------------------- *)
44 (* [add_color coloring r colors] returns the union of the set [colors] with
45 the element [color], if the vertex [r] was assigned color [color], and
46 returns [colors] if [r] was spilled. *)
48 let add_color coloring r colors =
49 match Vertex.Map.find r coloring with
53 ColorSet.add color colors
55 (* These are the colors that we work with. *)
57 let colors : ColorSet.t =
58 Untrusted_interference.hwregisterset_of_list I8051.registersAllocatable
60 (* This is the number of available colors. *)
63 ColorSet.cardinal colors
65 (* ------------------------------------------------------------------------- *)
66 (* Choices of colors. *)
68 (* [forbidden_colors graph coloring v] is the set of colors that cannot be
69 assigned to [v] considering [coloring], a coloring of every vertex in
70 [graph] except [v]. *)
71 (* This takes into account [v]'s possible interferences with hardware
72 registers, which are viewed as forbidden colors. *)
74 let forbidden_colors graph coloring v =
75 Vertex.Set.fold (add_color coloring) (ipp graph v) (iph graph v)
77 (* ------------------------------------------------------------------------- *)
78 (* Low and high vertices. *)
80 (* A vertex is low (or insignificant) if its degree is less than [k].
81 It is high (or significant) otherwise. *)
86 (* [high_neighbors graph v] is the set of all high neighbors of [v]. *)
88 let high_neighbors graph v =
89 Vertex.Set.filter (high graph) (ipp graph v)
91 (* ------------------------------------------------------------------------- *)
92 (* George's conservative coalescing criterion. *)
94 (* According to this criterion, two vertices [a] and [b] can be
95 coalesced, suppressing [a] and keeping [b], if the following
98 1. (pseudo-registers) every high neighbor of [a] is a neighbor of [b];
99 2. (hardware registers) every hardware register that interferes with
100 [a] also interferes with [b].
102 This means that, after all low vertices have been removed, any color that
103 is suitable for [b] is also suitable for [a]. *)
105 let georgepp graph (a, b) =
106 Vertex.Set.subset (high_neighbors graph a) (ipp graph b) &&
107 HwRegisterSet.subset (iph graph a) (iph graph b)
109 (* According to this criterion, a vertex [a] and a hardware register
110 [c] can be coalesced (that is, [a] can be assigned color [c]) if
111 every high neighbor of [a] interferes with [c]. *)
113 let georgeph graph (a, c) =
114 Vertex.Set.fold (fun neighbor accu ->
116 HwRegisterSet.mem c (iph graph neighbor)
117 ) (high_neighbors graph a) true
119 (* ------------------------------------------------------------------------- *)
120 (* Here is the coloring algorithm. *)
122 module Color (G : sig
125 val uses: Registers.register -> int
130 (* The cost function heuristically evaluates how much it might cost
131 to spill vertex [v]. Here, the cost is the ratio of the number of
132 uses of the pseudo-registers represented by [v] by the degree of
133 [v]. One could also take into account the number of nested loops
134 that the uses appear within, but that is not done here. *)
138 Pset.fold (fun r uses ->
140 ) (registers graph v) 0
142 (float_of_int uses) /. (float_of_int (degree graph v))
144 (* The algorithm maintains a transformed graph as it runs. It is
145 obtained from the original graph by removing, coalescing, and
146 freezing vertices. *)
148 (* Each of the functions that follow returns a coloring of the graph
149 that it is passed. These functions correspond to the various
150 states of the algorithm (simplification, coalescing, freezing,
151 spilling, selection). The function [simplification] is the
154 (* [simplification] removes non-move-related nodes of low degree. *)
156 let rec simplification graph : coloring =
158 match lowest_non_move_related graph with
160 | Some (v, d) when d < k ->
162 (* We found a non-move-related node [v] of low degree. Color
163 the rest of the graph, then color [v]. This is what I call
168 printf "Simplifying low vertex: %s.\n%!" (print_vertex graph v);
175 (* There are no non-move-related nodes of low degree.
176 Could not simplify further. Start coalescing. *)
180 (* [coalescing] looks for a preference edge that can be collapsed.
181 It is called after [simplification], so it is known, at this
182 point, that all nodes of low degree are move-related. *)
184 and coalescing graph : coloring =
186 (* Find a preference edge between two vertices that passes
189 [pppick] examines all preference edges in the graph, so its use
190 is inefficient. It would be more efficient instead to examine
191 only areas of the graph that have changed recently. More
192 precisely, it is useless to re-examine a preference edge that
193 did not pass George's criterion the last time it was examined
194 and whose neighborhood has not been modified by simplification,
195 coalescing or freezing. Indeed, in that case, and with a
196 sufficiently large definition of ``neighborhood'', this edge is
197 guaranteed to again fail George's criterion. It would be
198 possible to modify the [Interference.graph] data structure so
199 as to keep track of which neighborhoods have been modified and
200 provide a specialized, more efficient version of [pppick]. This
203 match pppick graph (georgepp graph) with
209 printf "Coalescing %s with %s.\n%!" (print_vertex graph a) (print_vertex graph b);
212 (* Coalesce [a] with [b] and color the remaining graph. *)
214 let coloring = simplification (coalesce graph a b) in
216 (* Assign [a] the same color as [b]. *)
218 Vertex.Map.add a (Vertex.Map.find b coloring) coloring
222 (* Find a preference edge between a vertex and a hardware
223 register that passes George's criterion. Like [pppick],
226 match phpick graph (georgeph graph) with
232 printf "Coalescing %s with $%s.\n%!" (print_vertex graph a) (I8051.print_register c);
235 (* Coalesce [a] with [c] and color the remaining graph. *)
237 let coloring = simplification (coalesceh graph a c) in
239 (* Assign [a] the color [c]. *)
241 Vertex.Map.add a (Color c) coloring
245 (* Could not coalesce further. Start freezing. *)
249 (* [freezing] begins after [simplification] and [coalescing] are
250 finished, so it is known, at this point, that all nodes of low
251 degree are move-related and no coalescing is possible. [freezing]
252 looks for a node of low degree (which must be move-related) and
253 removes the preference edges that it carries. This potentially
254 opens new opportunities for simplification and coalescing. *)
256 and freezing graph : coloring =
258 match lowest graph with
260 | Some (v, d) when d < k ->
262 (* We found a move-related node [v] of low degree.
263 Freeze it and start over. *)
267 printf "Freezing low vertex: %s.\n%!" (print_vertex graph v);
270 simplification (freeze graph v)
274 (* Could not freeze further. Start spilling. *)
278 (* [spilling] begins after [simplification], [coalescing], and
279 [freezing] are finished, so it is known, at this point, that
280 there are no nodes of low degree.
282 Thus, we are facing a potential spill. However, we do optimistic
283 coloring: we do not spill a vertex right away, but proceed
284 normally, just as if we were doing simplification. So, we pick a
285 vertex [v], remove it, and check whether a color can be assigned
286 to [v] only after coloring what remains of the graph.
288 It is crucial to pick a vertex that has few uses in the code. It
289 would also be good to pick one that has high degree, as this will
290 help color the rest of the graph. Thus, we pick a vertex that has
291 minimum cost, where the cost is obtained as the ratio of the
292 number of uses of the pseudo-registers represented by this vertex
293 in the code by the degree of the vertex. One could also take into
294 account the number of nested loops that the uses appear within,
295 but that is not done here.
297 The use of [minimum] is inefficient, because this function
298 examines all vertices in the graph. It would be possible to
299 augment the [Interference.graph] data structure so as to keep
300 track of the cost associated with each vertex and provide
301 efficient access to a minimum cost vertex. This is not done
304 and spilling graph : coloring =
306 match minimum (cost graph) graph with
311 printf "Spilling high vertex: %s.\n%!" (print_vertex graph v);
318 (* The graph is empty. Return an empty coloring. *)
322 (* [selection] removes the vertex [v] from the graph, colors the
323 remaining graph, then selects a color for [v].
325 If [v] is low, that is, if [v] has degree less than [k], then at
326 least one color must still be available for [v], regardless of
327 how the remaining graph was colored.
329 If [v] was a potential spill, then it is not certain that a color
330 is still available. If one is, though, then we are rewarded for
331 being optimistic. If none is, then [v] becomes an actual
334 and selection graph v : coloring =
336 (* Remove [v] from the graph and color what remains. *)
338 let coloring = simplification (remove graph v) in
340 (* Determine which colors are allowed. *)
342 let allowed = ColorSet.diff colors (forbidden_colors graph coloring v) in
346 We pick a color randomly among those that are allowed. One could
347 attempt to use biased coloring, that is, to pick a color that seems
348 desirable (or not undesirable) according to the preference edges
349 found in the initial graph. But that is probably not worth the
354 Color (ColorSet.choose allowed)
361 printf "Decision concerning %s: %s.\n%!" (print_vertex graph v) (print_decision decision);
364 (* Record our decision and return. *)
366 Vertex.Map.add v decision coloring
368 (* Run the algorithm. *)
371 simplification G.graph