source: extracted/untrusted/coloring.ml @ 2738

Last change on this file since 2738 was 2738, checked in by sacerdot, 8 years ago

Porting the graph colouring stuff from the untrusted prototype to the extracted
code.

File size: 11.5 KB
Line 
1(* Pasted from Pottier's PP compiler *)
2
3open ERTL
4open Untrusted_interference
5open 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
14type decision =
15  | Spill
16  | Color of I8051.register
17
18(*
19(* [print_decision] turns a decision into a string. *)
20
21let print_decision = function
22  | Spill ->
23      "spilled"
24  | Color hwr ->
25      Printf.sprintf "colored $%s" (I8051.print_register hwr)
26*)
27
28(* ------------------------------------------------------------------------- *)
29(* Colorings. *)
30
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. *)
34
35type coloring =
36    decision Vertex.Map.t
37
38(* ------------------------------------------------------------------------- *)
39(* Sets of colors. *)
40
41module ColorSet =
42  HwRegisterSet
43
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. *)
47
48let add_color coloring r colors =
49  match Vertex.Map.find r coloring with
50  | Spill ->
51      colors
52  | Color color ->
53      ColorSet.add color colors
54
55(* These are the colors that we work with. *)
56
57let colors : ColorSet.t =
58  List.foldr
59   (fun reg set -> HwRegisterSet.add reg set)
60   HwRegisterSet.empty I8051.registersAllocatable
61
62(* This is the number of available colors. *)
63
64let k : int =
65  ColorSet.cardinal colors
66
67(* ------------------------------------------------------------------------- *)
68(* Choices of colors. *)
69
70(* [forbidden_colors graph coloring v] is the set of colors that cannot be
71   assigned to [v] considering [coloring], a coloring of every vertex in
72   [graph] except [v]. *)
73(* This takes into account [v]'s possible interferences with hardware
74   registers, which are viewed as forbidden colors. *)
75
76let forbidden_colors graph coloring v =
77  Vertex.Set.fold (add_color coloring) (ipp graph v) (iph graph v)
78
79(* ------------------------------------------------------------------------- *)
80(* Low and high vertices. *)
81
82(* A vertex is low (or insignificant) if its degree is less than [k].
83   It is high (or significant) otherwise. *)
84
85let high graph v =
86  degree graph v >= k
87
88(* [high_neighbors graph v] is the set of all high neighbors of [v]. *)
89
90let high_neighbors graph v =
91  Vertex.Set.filter (high graph) (ipp graph v)
92
93(* ------------------------------------------------------------------------- *)
94(* George's conservative coalescing criterion. *)
95
96(* According to this criterion, two vertices [a] and [b] can be
97   coalesced, suppressing [a] and keeping [b], if the following
98   two conditions hold:
99
100     1. (pseudo-registers) every high neighbor of [a] is a neighbor of [b];
101     2. (hardware registers) every hardware register that interferes with
102        [a] also interferes with [b].
103
104   This means that, after all low vertices have been removed, any color that
105   is suitable for [b] is also suitable for [a]. *)
106
107let georgepp graph (a, b) =
108  Vertex.Set.subset (high_neighbors graph a) (ipp graph b) &&
109  HwRegisterSet.subset (iph graph a) (iph graph b)
110
111(* According to this criterion, a vertex [a] and a hardware register
112   [c] can be coalesced (that is, [a] can be assigned color [c]) if
113   every high neighbor of [a] interferes with [c]. *)
114
115let georgeph graph (a, c) =
116  Vertex.Set.fold (fun neighbor accu ->
117    accu &&
118    HwRegisterSet.mem c (iph graph neighbor)
119  ) (high_neighbors graph a) true
120
121(* ------------------------------------------------------------------------- *)
122(* Here is the coloring algorithm. *)
123
124module Color (G : sig
125
126  val graph: graph
127  val uses: Registers.register -> int
128  val verbose: bool
129
130end) = struct
131
132  (* The cost function heuristically evaluates how much it might cost
133     to spill vertex [v]. Here, the cost is the ratio of the number of
134     uses of the pseudo-registers represented by [v] by the degree of
135     [v]. One could also take into account the number of nested loops
136     that the uses appear within, but that is not done here. *)
137
138  let cost graph v =
139    let uses =
140      Pset.fold (fun r uses ->
141        G.uses r + uses
142      ) (registers graph v) 0
143    in
144    (float_of_int uses) /. (float_of_int (degree graph v))
145
146  (* The algorithm maintains a transformed graph as it runs. It is
147     obtained from the original graph by removing, coalescing, and
148     freezing vertices. *)
149
150  (* Each of the functions that follow returns a coloring of the graph
151     that it is passed. These functions correspond to the various
152     states of the algorithm (simplification, coalescing, freezing,
153     spilling, selection). The function [simplification] is the
154     initial state. *)
155
156  (* [simplification] removes non-move-related nodes of low degree. *)
157
158  let rec simplification graph : coloring =
159
160    match lowest_non_move_related graph with
161
162    | Some (v, d) when d < k ->
163
164        (* We found a non-move-related node [v] of low degree. Color
165           the rest of the graph, then color [v]. This is what I call
166           selection. *)
167
168(*
169        if G.verbose then
170          printf "Simplifying low vertex: %s.\n%!" (print_vertex graph v);
171*)
172
173        selection graph v
174
175    | _ ->
176
177        (* There are no non-move-related nodes of low degree.
178           Could not simplify further. Start coalescing. *)
179
180        coalescing graph
181
182  (* [coalescing] looks for a preference edge that can be collapsed.
183     It is called after [simplification], so it is known, at this
184     point, that all nodes of low degree are move-related. *)
185
186  and coalescing graph : coloring =
187
188    (* Find a preference edge between two vertices that passes
189       George's criterion.
190
191       [pppick] examines all preference edges in the graph, so its use
192       is inefficient. It would be more efficient instead to examine
193       only areas of the graph that have changed recently. More
194       precisely, it is useless to re-examine a preference edge that
195       did not pass George's criterion the last time it was examined
196       and whose neighborhood has not been modified by simplification,
197       coalescing or freezing. Indeed, in that case, and with a
198       sufficiently large definition of ``neighborhood'', this edge is
199       guaranteed to again fail George's criterion. It would be
200       possible to modify the [Interference.graph] data structure so
201       as to keep track of which neighborhoods have been modified and
202       provide a specialized, more efficient version of [pppick]. This
203       is not done here. *)
204
205    match pppick graph (georgepp graph) with
206
207    | Some (a, b) ->
208
209(*
210        if G.verbose then
211          printf "Coalescing %s with %s.\n%!" (print_vertex graph a) (print_vertex graph b);
212*)
213
214        (* Coalesce [a] with [b] and color the remaining graph. *)
215
216        let coloring = simplification (coalesce graph a b) in
217
218        (* Assign [a] the same color as [b]. *)
219
220        Vertex.Map.add a (Vertex.Map.find b coloring) coloring
221
222    | None ->
223
224        (* Find a preference edge between a vertex and a hardware
225           register that passes George's criterion. Like [pppick],
226           [phpick] is slow. *)
227
228        match phpick graph (georgeph graph) with
229
230        | Some (a, c) ->
231
232(*
233            if G.verbose then
234              printf "Coalescing %s with $%s.\n%!" (print_vertex graph a) (I8051.print_register c);
235*)
236
237            (* Coalesce [a] with [c] and color the remaining graph. *)
238
239            let coloring = simplification (coalesceh graph a c) in
240
241            (* Assign [a] the color [c]. *)
242
243            Vertex.Map.add a (Color c) coloring
244
245        | None ->
246
247            (* Could not coalesce further. Start freezing. *)
248
249            freezing graph
250
251  (* [freezing] begins after [simplification] and [coalescing] are
252     finished, so it is known, at this point, that all nodes of low
253     degree are move-related and no coalescing is possible. [freezing]
254     looks for a node of low degree (which must be move-related) and
255     removes the preference edges that it carries. This potentially
256     opens new opportunities for simplification and coalescing. *)
257
258  and freezing graph : coloring =
259
260    match lowest graph with
261
262    | Some (v, d) when d < k ->
263
264        (* We found a move-related node [v] of low degree.
265           Freeze it and start over. *)
266
267(*
268        if G.verbose then
269          printf "Freezing low vertex: %s.\n%!" (print_vertex graph v);
270*)
271
272        simplification (freeze graph v)
273
274    | _ ->
275
276        (* Could not freeze further. Start spilling. *)
277
278        spilling graph
279
280  (* [spilling] begins after [simplification], [coalescing], and
281     [freezing] are finished, so it is known, at this point, that
282     there are no nodes of low degree.
283
284     Thus, we are facing a potential spill. However, we do optimistic
285     coloring: we do not spill a vertex right away, but proceed
286     normally, just as if we were doing simplification. So, we pick a
287     vertex [v], remove it, and check whether a color can be assigned
288     to [v] only after coloring what remains of the graph.
289
290     It is crucial to pick a vertex that has few uses in the code. It
291     would also be good to pick one that has high degree, as this will
292     help color the rest of the graph. Thus, we pick a vertex that has
293     minimum cost, where the cost is obtained as the ratio of the
294     number of uses of the pseudo-registers represented by this vertex
295     in the code by the degree of the vertex. One could also take into
296     account the number of nested loops that the uses appear within,
297     but that is not done here.
298
299     The use of [minimum] is inefficient, because this function
300     examines all vertices in the graph. It would be possible to
301     augment the [Interference.graph] data structure so as to keep
302     track of the cost associated with each vertex and provide
303     efficient access to a minimum cost vertex. This is not done
304     here. *)
305
306  and spilling graph : coloring =
307
308    match minimum (cost graph) graph with
309    | Some v ->
310       
311(*
312        if G.verbose then
313          printf "Spilling high vertex: %s.\n%!" (print_vertex graph v);
314*)
315       
316        selection graph v
317
318    | None ->
319
320        (* The graph is empty. Return an empty coloring. *)
321
322        Vertex.Map.empty
323
324  (* [selection] removes the vertex [v] from the graph, colors the
325     remaining graph, then selects a color for [v].
326
327     If [v] is low, that is, if [v] has degree less than [k], then at
328     least one color must still be available for [v], regardless of
329     how the remaining graph was colored.
330
331     If [v] was a potential spill, then it is not certain that a color
332     is still available. If one is, though, then we are rewarded for
333     being optimistic. If none is, then [v] becomes an actual
334     spill. *)
335
336  and selection graph v : coloring =
337
338    (* Remove [v] from the graph and color what remains. *)
339
340    let coloring = simplification (remove graph v) in
341
342    (* Determine which colors are allowed. *)
343
344    let allowed = ColorSet.diff colors (forbidden_colors graph coloring v) in
345
346    (* Make a decision.
347
348       We pick a color randomly among those that are allowed. One could
349       attempt to use biased coloring, that is, to pick a color that seems
350       desirable (or not undesirable) according to the preference edges
351       found in the initial graph. But that is probably not worth the
352       trouble. *)
353
354    let decision =
355      try
356        Color (ColorSet.choose allowed)
357      with Not_found ->
358        Spill
359    in
360
361(*
362    if G.verbose then
363      printf "Decision concerning %s: %s.\n%!" (print_vertex graph v) (print_decision decision);
364*)
365
366    (* Record our decision and return. *)
367
368    Vertex.Map.add v decision coloring
369
370  (* Run the algorithm. *)
371
372  let coloring =
373    simplification G.graph
374
375end
376
Note: See TracBrowser for help on using the repository browser.