codegen/colororder.sml

   1 (* L1 Compiler
   2  * Gathers tiberium, fires rockets
   3  * Takes a interference graph and generates an ordering for coloring
   4  * Author: Joshua Wise <jwise@andrew.cmu.edu>
   5  *)
   6
   7 signature COLORORDER =
   8 sig
   9   type tiberium = (Temp.temp * x86.oper list) list
  10   type rockets = Temp.temp list
  11
  12   val colororder : tiberium -> rockets
  13 end
  14
  15 structure ColorOrder :> COLORORDER =
  16 struct
  17   structure T = Temp
  18   structure X = x86
  19
  20   type tiberium = (Temp.temp * x86.oper list) list
  21   type rockets = Temp.temp list
  22
  23   fun colororder (graph : tiberium) : rockets =
  24     let
  25       val () = print ("Ordering colors...\n");
  26       val initialWeights = map (fn (t, _) => (t, 0)) graph
  27
  28       fun sortWeights weights = (* Sort the weights such that the largest is at left, ready to be grabbed. *)
  29         ListMergeSort.sort (fn ((_, a), (_, b)) => a < b) weights
  30
  31       (* Chooses one temporary to pick, and updates the weights. *)
  32       fun orderOne (weights : (Temp.temp * int) list) : Temp.temp * (Temp.temp * int) list =
  33         let
  34           val sorted = sortWeights weights
  35           val (chosen, w) = List.hd sorted      (* Grab the temp with the highest weight. *)
  36           val () = print ("  Chose "^(Temp.name chosen)^" with weight "^(Int.toString w)^"\n");
  37           val remaining = List.tl sorted
  38           val neighbors =       (* Grab all the neighbors for some given temp. *)
  39             List.hd
  40               (List.map (fn (_, neighbors) => neighbors)
  41                 (List.filter (fn (t, _) => T.compare (t, chosen) = EQUAL) graph))
  42           val () = List.app
  43                      (fn (X.TEMP t) => (print ("    Neighbor "^(Temp.name t)^"\n"))
  44                        | (X.REG X.EAX) => (print "    Fixed color EAX\n")
  45                        | (X.REG X.EDX) => (print "    Fixed color EDX\n")
  46                        | _ => raise ErrorMsg.InternalError "Unknown neighbor type -- const?"
  47                      ) neighbors;
  48           val newWeights =
  49             List.map
  50               (fn (t, wt) =>
  51                 (t,
  52                   if (List.exists
  53                         (fn X.TEMP t' => (T.compare (t, t') = EQUAL)
  54                           | _ => false)
  55                         neighbors)
  56                     then (wt + 1)
  57                     else wt
  58                 )
  59               ) remaining
  60         in
  61           (chosen, newWeights)
  62         end
  63
  64       (* Recursively order until we run out of things to order. *)
  65       fun keepOrdering (nil : (Temp.temp * int) list) : Temp.temp list = nil
  66         | keepOrdering (weights) =
  67           let
  68             val (chosen, newWeights) = orderOne weights
  69           in
  70             chosen :: (keepOrdering newWeights)
  71           end
  72     in
  73       (keepOrdering initialWeights)
  74     end
  75 end