codegen/colororder.sml

   1 (* L3 Compiler
   2  * Takes a interference graph and generates an ordering for coloring
   3  * Author: Joshua Wise <jwise@andrew.cmu.edu>
   4  * Author: Chris Lu <czl@aundrew.cmu.edu>
   5  *)
   6
   7 signature COLORORDER =
   8 sig
   9   structure OperSet : ORD_SET
  10     where type Key.ord_key = x86.basicop
  11   structure LiveMap : ORD_MAP
  12     where type Key.ord_key = int
  13   structure TempMap : ORD_MAP
  14     where type Key.ord_key = Temp.temp
  15
  16   type igraph = OperSet.set TempMap.map
  17   type ordering = Temp.temp list
  18
  19   val colororder : Igraph.graph * Temp.temp list -> ordering
  20 end
  21
  22 structure ColorOrder :> COLORORDER =
  23 struct
  24   structure T = Temp
  25   structure X = x86
  26
  27   structure OperSet = Igraph.OperSet
  28   structure LiveMap = Igraph.LiveMap
  29   structure TempMap = Igraph.TempMap
  30
  31   type igraph = OperSet.set TempMap.map
  32   type ordering = Temp.temp list
  33
  34   fun colororder (graph,temps) =
  35     let
  36       val initialWeights = TempMap.mapi (fn (t, _) => (t, 0)) graph
  37
  38       (* Chooses one temporary to pick, and updates the weights. *)
  39       fun orderOne (weights : (Temp.temp * int) list) : Temp.temp * (Temp.temp * int) list =
  40         let
  41           val (chosen, w) =
  42             foldr
  43               (fn ((t1, w1), (t2, w2)) =>
  44                 if (w2 > w1)
  45                 then (t2, w2)
  46                 else (t1, w1))
  47               (Temp.new "emarnus" Temp.Word, ~9999)
  48               weights
  49
  50           fun ditchOne f nil = nil      (* Special case of filter, which bails out after it removes one. *)
  51             | ditchOne f (h::l) =
  52               if f h
  53               then l
  54               else h::(ditchOne f l)
  55           val remaining = ditchOne (fn (t, w) => Temp.eq (t, chosen)) weights
  56
  57           val neighbors =                       (* Grab all the neighbors for some given temp. *)
  58             (OperSet.listItems
  59               (valOf (TempMap.find (graph, chosen))))
  60           val newWeights =
  61             List.map
  62               (fn (t, wt) =>
  63                 (t,
  64                   if (List.exists
  65                         (fn X.TEMP t' => (T.eq (t, t'))
  66                           | _ => false)
  67                         neighbors)
  68                     then (wt + 1)
  69                     else wt
  70                 )
  71               ) remaining
  72         in
  73           (chosen, newWeights)
  74         end
  75
  76       (* Recursively order until we run out of things to order. *)
  77       fun keepOrdering (nil : (Temp.temp * int) list) : Temp.temp list = nil
  78         | keepOrdering (weights) =
  79           let
  80             val (chosen, newWeights) = orderOne weights
  81           in
  82             chosen :: (keepOrdering newWeights)
  83           end
  84
  85       val ordered = keepOrdering (TempMap.listItems initialWeights)
  86     in
  87       ordered @ (List.filter (fn a => not (List.exists (fn b => Temp.eq (a,b)) ordered)) temps)
  88     end
  89 end