1 | (* Pasted from Pottier's PP compiler *) |
---|
2 | |
---|
3 | open Untrusted_interference |
---|
4 | (* open Integer *) |
---|
5 | open Printf |
---|
6 | |
---|
7 | (* ------------------------------------------------------------------------- *) |
---|
8 | (* Colorings. *) |
---|
9 | |
---|
10 | (* This module performs graph coloring with an unlimited number of |
---|
11 | colors and aggressive coalescing. It is used for assigning stack |
---|
12 | slots to the pseudo-registers that have been spilled by register |
---|
13 | allocation. *) |
---|
14 | |
---|
15 | (* A coloring is a partial function of graph vertices to stack |
---|
16 | slots. Vertices that are not in the domain of the coloring are |
---|
17 | waiting for a decision to be made. *) |
---|
18 | |
---|
19 | type decision = |
---|
20 | int |
---|
21 | |
---|
22 | type coloring = |
---|
23 | decision Vertex.Map.t |
---|
24 | |
---|
25 | (* ------------------------------------------------------------------------- *) |
---|
26 | (* Here is the coloring algorithm. *) |
---|
27 | |
---|
28 | module Color (G : sig |
---|
29 | |
---|
30 | val graph: graph |
---|
31 | val verbose: bool |
---|
32 | |
---|
33 | end) = struct |
---|
34 | |
---|
35 | module SlotSet = |
---|
36 | Set.Make(struct type t = int let compare = Pervasives.compare end) |
---|
37 | |
---|
38 | (* [forbidden_slots graph coloring v] is the set of stack slots that |
---|
39 | cannot be assigned to [v] considering the (partial) coloring |
---|
40 | [coloring]. This takes into account [v]'s possible interferences |
---|
41 | with other spilled vertices. *) |
---|
42 | |
---|
43 | let add_slot coloring r slots = |
---|
44 | SlotSet.add (Vertex.Map.find r coloring) slots |
---|
45 | |
---|
46 | let forbidden_slots graph coloring v = |
---|
47 | Vertex.Set.fold (add_slot coloring) (ipp graph v) SlotSet.empty |
---|
48 | |
---|
49 | (* [allocate_slot forbidden] returns a stack slot that is not a |
---|
50 | member of the set [forbidden]. Unlike hardware registers, stack |
---|
51 | slots are infinitely many, so it is always possible to allocate a |
---|
52 | new one. The reference [locals] holds the space that must be |
---|
53 | reserved on the stack for locals. *) |
---|
54 | |
---|
55 | let locals = |
---|
56 | ref 0 |
---|
57 | |
---|
58 | let allocate_slot forbidden = |
---|
59 | let rec loop slot = |
---|
60 | if SlotSet.mem slot forbidden then |
---|
61 | loop (slot + Glue.int_of_bitvector I8051.int_size) |
---|
62 | else |
---|
63 | slot |
---|
64 | in |
---|
65 | let slot = loop 0 in |
---|
66 | locals := max (slot + Glue.int_of_bitvector I8051.int_size) !locals; |
---|
67 | slot |
---|
68 | |
---|
69 | (* Allocation is in two phases, implemented by [coalescing] and |
---|
70 | [simplification]. Each of these functions produces a coloring of its |
---|
71 | graph argument. *) |
---|
72 | |
---|
73 | (* [simplification] expects a graph that does not contain any preference |
---|
74 | edges. It picks a vertex [v], removes it, colors the remaining graph, |
---|
75 | then colors [v] using a color that is still available. Such a color must |
---|
76 | exist, since there is an unlimited number of colors. *) |
---|
77 | |
---|
78 | (* Following Appel, [v] is chosen with lowest degree: this will make this |
---|
79 | vertex easier to color and might (?) help use fewer colors. *) |
---|
80 | |
---|
81 | let rec simplification graph : coloring = |
---|
82 | |
---|
83 | match lowest graph with |
---|
84 | | Some (v, _) -> |
---|
85 | |
---|
86 | (* |
---|
87 | if G.verbose then |
---|
88 | printf "SPILL: Picking vertex: %s.\n" (print_vertex graph v); |
---|
89 | *) |
---|
90 | |
---|
91 | (* Remove [v] from the graph and color what remains. *) |
---|
92 | |
---|
93 | let coloring = simplification (Untrusted_interference.remove graph v) in |
---|
94 | |
---|
95 | (* Choose a color for [v]. *) |
---|
96 | |
---|
97 | let decision = |
---|
98 | allocate_slot (forbidden_slots graph coloring v) |
---|
99 | in |
---|
100 | |
---|
101 | (* |
---|
102 | if G.verbose then |
---|
103 | printf "SPILL: Decision concerning %s: offset %d.\n" (print_vertex graph v) decision; |
---|
104 | *) |
---|
105 | |
---|
106 | (* Record our decision and return. *) |
---|
107 | |
---|
108 | Vertex.Map.add v decision coloring |
---|
109 | |
---|
110 | | None -> |
---|
111 | |
---|
112 | (* The graph is empty. Return an empty coloring. *) |
---|
113 | |
---|
114 | Vertex.Map.empty |
---|
115 | |
---|
116 | (* [coalescing] looks for a preference edge, that is, for two vertices |
---|
117 | [x] and [y] such that [x] and [y] are move-related. In that case, |
---|
118 | [x] and [y] cannot interfere, because the [Interference] module |
---|
119 | does not allow two vertices to be related by both an interference |
---|
120 | edge and a preference edge. If [coalescing] finds such an edge, it |
---|
121 | coalesces [x] and [y] and continues coalescing. Otherwise, it |
---|
122 | invokes the next phase, [simplification]. |
---|
123 | |
---|
124 | This is aggressive coalescing: we coalesce all preference edges, |
---|
125 | without fear of creating high-degree nodes. This is good because |
---|
126 | a move between two pseudo-registers that have been spilled in |
---|
127 | distinct stack slots is very expensive: one load followed by one |
---|
128 | store. *) |
---|
129 | |
---|
130 | let rec coalescing graph : coloring = |
---|
131 | |
---|
132 | match pppick graph (fun _ -> true) with |
---|
133 | | Some (x, y) -> |
---|
134 | |
---|
135 | (* |
---|
136 | if G.verbose then |
---|
137 | printf "SPILL: Coalescing %s and %s.\n" (print_vertex graph x) (print_vertex graph y); |
---|
138 | *) |
---|
139 | |
---|
140 | let graph = Untrusted_interference.coalesce graph x y in |
---|
141 | let coloring = coalescing graph in |
---|
142 | Vertex.Map.add x (Vertex.Map.find y coloring) coloring |
---|
143 | |
---|
144 | | None -> |
---|
145 | |
---|
146 | simplification graph |
---|
147 | |
---|
148 | (* Run the algorithm. [coalescing] runs first and calls [simplification] |
---|
149 | when it is done. *) |
---|
150 | |
---|
151 | let coloring = |
---|
152 | coalescing G.graph |
---|
153 | |
---|
154 | (* Report how much stack space was used. *) |
---|
155 | |
---|
156 | let locals = |
---|
157 | !locals |
---|
158 | |
---|
159 | end |
---|