1 | (* Pasted from Pottier's PP compiler *) |
---|
2 | |
---|
3 | open ERTL |
---|
4 | open Interference |
---|
5 | open Printf |
---|
6 | |
---|
7 | (* ------------------------------------------------------------------------- *) |
---|
8 | (* Decisions. *) |
---|
9 | |
---|
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. *) |
---|
13 | |
---|
14 | type decision = |
---|
15 | | Spill |
---|
16 | | Color of I8051.register |
---|
17 | |
---|
18 | (* [print_decision] turns a decision into a string. *) |
---|
19 | |
---|
20 | let print_decision = function |
---|
21 | | Spill -> |
---|
22 | "spilled" |
---|
23 | | Color hwr -> |
---|
24 | Printf.sprintf "colored $%s" (I8051.print_register hwr) |
---|
25 | |
---|
26 | (* ------------------------------------------------------------------------- *) |
---|
27 | (* Colorings. *) |
---|
28 | |
---|
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. *) |
---|
32 | |
---|
33 | type coloring = |
---|
34 | decision Vertex.Map.t |
---|
35 | |
---|
36 | (* ------------------------------------------------------------------------- *) |
---|
37 | (* Sets of colors. *) |
---|
38 | |
---|
39 | module ColorSet = |
---|
40 | I8051.RegisterSet |
---|
41 | |
---|
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. *) |
---|
45 | |
---|
46 | let add_color coloring r colors = |
---|
47 | match Vertex.Map.find r coloring with |
---|
48 | | Spill -> |
---|
49 | colors |
---|
50 | | Color color -> |
---|
51 | ColorSet.add color colors |
---|
52 | |
---|
53 | (* These are the colors that we work with. *) |
---|
54 | |
---|
55 | let colors : ColorSet.t = |
---|
56 | I8051.allocatable |
---|
57 | |
---|
58 | (* This is the number of available colors. *) |
---|
59 | |
---|
60 | let k : int = |
---|
61 | ColorSet.cardinal colors |
---|
62 | |
---|
63 | (* ------------------------------------------------------------------------- *) |
---|
64 | (* Choices of colors. *) |
---|
65 | |
---|
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. *) |
---|
71 | |
---|
72 | let forbidden_colors graph coloring v = |
---|
73 | Vertex.Set.fold (add_color coloring) (ipp graph v) (iph graph v) |
---|
74 | |
---|
75 | (* ------------------------------------------------------------------------- *) |
---|
76 | (* Low and high vertices. *) |
---|
77 | |
---|
78 | (* A vertex is low (or insignificant) if its degree is less than [k]. |
---|
79 | It is high (or significant) otherwise. *) |
---|
80 | |
---|
81 | let high graph v = |
---|
82 | degree graph v >= k |
---|
83 | |
---|
84 | (* [high_neighbors graph v] is the set of all high neighbors of [v]. *) |
---|
85 | |
---|
86 | let high_neighbors graph v = |
---|
87 | Vertex.Set.filter (high graph) (ipp graph v) |
---|
88 | |
---|
89 | (* ------------------------------------------------------------------------- *) |
---|
90 | (* George's conservative coalescing criterion. *) |
---|
91 | |
---|
92 | (* According to this criterion, two vertices [a] and [b] can be |
---|
93 | coalesced, suppressing [a] and keeping [b], if the following |
---|
94 | two conditions hold: |
---|
95 | |
---|
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]. |
---|
99 | |
---|
100 | This means that, after all low vertices have been removed, any color that |
---|
101 | is suitable for [b] is also suitable for [a]. *) |
---|
102 | |
---|
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) |
---|
106 | |
---|
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]. *) |
---|
110 | |
---|
111 | let georgeph graph (a, c) = |
---|
112 | Vertex.Set.fold (fun neighbor accu -> |
---|
113 | accu && |
---|
114 | I8051.RegisterSet.mem c (iph graph neighbor) |
---|
115 | ) (high_neighbors graph a) true |
---|
116 | |
---|
117 | (* ------------------------------------------------------------------------- *) |
---|
118 | (* Here is the coloring algorithm. *) |
---|
119 | |
---|
120 | module Color (G : sig |
---|
121 | |
---|
122 | val graph: graph |
---|
123 | val uses: Register.t -> int |
---|
124 | val verbose: bool |
---|
125 | |
---|
126 | end) = struct |
---|
127 | |
---|
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. *) |
---|
133 | |
---|
134 | let cost graph v = |
---|
135 | let uses = |
---|
136 | Register.Set.fold (fun r uses -> |
---|
137 | G.uses r + uses |
---|
138 | ) (registers graph v) 0 |
---|
139 | in |
---|
140 | (float_of_int uses) /. (float_of_int (degree graph v)) |
---|
141 | |
---|
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. *) |
---|
145 | |
---|
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 |
---|
150 | initial state. *) |
---|
151 | |
---|
152 | (* [simplification] removes non-move-related nodes of low degree. *) |
---|
153 | |
---|
154 | let rec simplification graph : coloring = |
---|
155 | |
---|
156 | match lowest_non_move_related graph with |
---|
157 | |
---|
158 | | Some (v, d) when d < k -> |
---|
159 | |
---|
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 |
---|
162 | selection. *) |
---|
163 | |
---|
164 | if G.verbose then |
---|
165 | printf "Simplifying low vertex: %s.\n%!" (print_vertex graph v); |
---|
166 | |
---|
167 | selection graph v |
---|
168 | |
---|
169 | | _ -> |
---|
170 | |
---|
171 | (* There are no non-move-related nodes of low degree. |
---|
172 | Could not simplify further. Start coalescing. *) |
---|
173 | |
---|
174 | coalescing graph |
---|
175 | |
---|
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. *) |
---|
179 | |
---|
180 | and coalescing graph : coloring = |
---|
181 | |
---|
182 | (* Find a preference edge between two vertices that passes |
---|
183 | George's criterion. |
---|
184 | |
---|
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 |
---|
197 | is not done here. *) |
---|
198 | |
---|
199 | match pppick graph (georgepp graph) with |
---|
200 | |
---|
201 | | Some (a, b) -> |
---|
202 | |
---|
203 | if G.verbose then |
---|
204 | printf "Coalescing %s with %s.\n%!" (print_vertex graph a) (print_vertex graph b); |
---|
205 | |
---|
206 | (* Coalesce [a] with [b] and color the remaining graph. *) |
---|
207 | |
---|
208 | let coloring = simplification (coalesce graph a b) in |
---|
209 | |
---|
210 | (* Assign [a] the same color as [b]. *) |
---|
211 | |
---|
212 | Vertex.Map.add a (Vertex.Map.find b coloring) coloring |
---|
213 | |
---|
214 | | None -> |
---|
215 | |
---|
216 | (* Find a preference edge between a vertex and a hardware |
---|
217 | register that passes George's criterion. Like [pppick], |
---|
218 | [phpick] is slow. *) |
---|
219 | |
---|
220 | match phpick graph (georgeph graph) with |
---|
221 | |
---|
222 | | Some (a, c) -> |
---|
223 | |
---|
224 | if G.verbose then |
---|
225 | printf "Coalescing %s with $%s.\n%!" (print_vertex graph a) (I8051.print_register c); |
---|
226 | |
---|
227 | (* Coalesce [a] with [c] and color the remaining graph. *) |
---|
228 | |
---|
229 | let coloring = simplification (coalesceh graph a c) in |
---|
230 | |
---|
231 | (* Assign [a] the color [c]. *) |
---|
232 | |
---|
233 | Vertex.Map.add a (Color c) coloring |
---|
234 | |
---|
235 | | None -> |
---|
236 | |
---|
237 | (* Could not coalesce further. Start freezing. *) |
---|
238 | |
---|
239 | freezing graph |
---|
240 | |
---|
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. *) |
---|
247 | |
---|
248 | and freezing graph : coloring = |
---|
249 | |
---|
250 | match lowest graph with |
---|
251 | |
---|
252 | | Some (v, d) when d < k -> |
---|
253 | |
---|
254 | (* We found a move-related node [v] of low degree. |
---|
255 | Freeze it and start over. *) |
---|
256 | |
---|
257 | if G.verbose then |
---|
258 | printf "Freezing low vertex: %s.\n%!" (print_vertex graph v); |
---|
259 | |
---|
260 | simplification (freeze graph v) |
---|
261 | |
---|
262 | | _ -> |
---|
263 | |
---|
264 | (* Could not freeze further. Start spilling. *) |
---|
265 | |
---|
266 | spilling graph |
---|
267 | |
---|
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. |
---|
271 | |
---|
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. |
---|
277 | |
---|
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. |
---|
286 | |
---|
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 |
---|
292 | here. *) |
---|
293 | |
---|
294 | and spilling graph : coloring = |
---|
295 | |
---|
296 | match minimum (cost graph) graph with |
---|
297 | | Some v -> |
---|
298 | |
---|
299 | if G.verbose then |
---|
300 | printf "Spilling high vertex: %s.\n%!" (print_vertex graph v); |
---|
301 | |
---|
302 | selection graph v |
---|
303 | |
---|
304 | | None -> |
---|
305 | |
---|
306 | (* The graph is empty. Return an empty coloring. *) |
---|
307 | |
---|
308 | Vertex.Map.empty |
---|
309 | |
---|
310 | (* [selection] removes the vertex [v] from the graph, colors the |
---|
311 | remaining graph, then selects a color for [v]. |
---|
312 | |
---|
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. |
---|
316 | |
---|
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 |
---|
320 | spill. *) |
---|
321 | |
---|
322 | and selection graph v : coloring = |
---|
323 | |
---|
324 | (* Remove [v] from the graph and color what remains. *) |
---|
325 | |
---|
326 | let coloring = simplification (remove graph v) in |
---|
327 | |
---|
328 | (* Determine which colors are allowed. *) |
---|
329 | |
---|
330 | let allowed = ColorSet.diff colors (forbidden_colors graph coloring v) in |
---|
331 | |
---|
332 | (* Make a decision. |
---|
333 | |
---|
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 |
---|
338 | trouble. *) |
---|
339 | |
---|
340 | let decision = |
---|
341 | try |
---|
342 | Color (ColorSet.choose allowed) |
---|
343 | with Not_found -> |
---|
344 | Spill |
---|
345 | in |
---|
346 | |
---|
347 | if G.verbose then |
---|
348 | printf "Decision concerning %s: %s.\n%!" (print_vertex graph v) (print_decision decision); |
---|
349 | |
---|
350 | (* Record our decision and return. *) |
---|
351 | |
---|
352 | Vertex.Map.add v decision coloring |
---|
353 | |
---|
354 | (* Run the algorithm. *) |
---|
355 | |
---|
356 | let coloring = |
---|
357 | simplification G.graph |
---|
358 | |
---|
359 | end |
---|
360 | |
---|