src/ERTL/spill.ml

   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