[486] | 1 | (* Pasted from Pottier's PP compiler *) |
---|
| 2 | |
---|
| 3 | open 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 | AST.immediate |
---|
| 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 + I8051.int_size) |
---|
| 62 | else |
---|
| 63 | slot |
---|
| 64 | in |
---|
| 65 | let slot = loop 0 in |
---|
| 66 | locals := max (slot + 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 | if G.verbose then |
---|
| 87 | printf "SPILL: Picking vertex: %s.\n" (print_vertex graph v); |
---|
| 88 | |
---|
| 89 | (* Remove [v] from the graph and color what remains. *) |
---|
| 90 | |
---|
| 91 | let coloring = simplification (Interference.remove graph v) in |
---|
| 92 | |
---|
| 93 | (* Choose a color for [v]. *) |
---|
| 94 | |
---|
| 95 | let decision = |
---|
| 96 | allocate_slot (forbidden_slots graph coloring v) |
---|
| 97 | in |
---|
| 98 | |
---|
| 99 | if G.verbose then |
---|
| 100 | printf "SPILL: Decision concerning %s: offset %d.\n" (print_vertex graph v) decision; |
---|
| 101 | |
---|
| 102 | (* Record our decision and return. *) |
---|
| 103 | |
---|
| 104 | Vertex.Map.add v decision coloring |
---|
| 105 | |
---|
| 106 | | None -> |
---|
| 107 | |
---|
| 108 | (* The graph is empty. Return an empty coloring. *) |
---|
| 109 | |
---|
| 110 | Vertex.Map.empty |
---|
| 111 | |
---|
| 112 | (* [coalescing] looks for a preference edge, that is, for two vertices |
---|
| 113 | [x] and [y] such that [x] and [y] are move-related. In that case, |
---|
| 114 | [x] and [y] cannot interfere, because the [Interference] module |
---|
| 115 | does not allow two vertices to be related by both an interference |
---|
| 116 | edge and a preference edge. If [coalescing] finds such an edge, it |
---|
| 117 | coalesces [x] and [y] and continues coalescing. Otherwise, it |
---|
| 118 | invokes the next phase, [simplification]. |
---|
| 119 | |
---|
| 120 | This is aggressive coalescing: we coalesce all preference edges, |
---|
| 121 | without fear of creating high-degree nodes. This is good because |
---|
| 122 | a move between two pseudo-registers that have been spilled in |
---|
| 123 | distinct stack slots is very expensive: one load followed by one |
---|
| 124 | store. *) |
---|
| 125 | |
---|
| 126 | let rec coalescing graph : coloring = |
---|
| 127 | |
---|
| 128 | match pppick graph (fun _ -> true) with |
---|
| 129 | | Some (x, y) -> |
---|
| 130 | |
---|
| 131 | if G.verbose then |
---|
| 132 | printf "SPILL: Coalescing %s and %s.\n" (print_vertex graph x) (print_vertex graph y); |
---|
| 133 | |
---|
| 134 | let graph = Interference.coalesce graph x y in |
---|
| 135 | let coloring = coalescing graph in |
---|
| 136 | Vertex.Map.add x (Vertex.Map.find y coloring) coloring |
---|
| 137 | |
---|
| 138 | | None -> |
---|
| 139 | |
---|
| 140 | simplification graph |
---|
| 141 | |
---|
| 142 | (* Run the algorithm. [coalescing] runs first and calls [simplification] |
---|
| 143 | when it is done. *) |
---|
| 144 | |
---|
| 145 | let coloring = |
---|
| 146 | coalescing G.graph |
---|
| 147 | |
---|
| 148 | (* Report how much stack space was used. *) |
---|
| 149 | |
---|
| 150 | let locals = |
---|
| 151 | !locals |
---|
| 152 | |
---|
| 153 | end |
---|