extracted/untrusted/spill.ml

   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