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.oper
  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       fun sortWeights weights = (* Sort the weights such that the largest is at left, ready to be grabbed. *)
  39         ListMergeSort.sort (fn ((_, a), (_, b)) => a < b) weights
  40
  41       (* Chooses one temporary to pick, and updates the weights. *)
  42       fun orderOne (weights : (Temp.temp * int) list) : Temp.temp * (Temp.temp * int) list =
  43         let
  44           val sorted = sortWeights weights
  45           val (chosen, w) = List.hd sorted      (* Grab the temp with the highest weight. *)
  46           val remaining = List.tl sorted
  47           val neighbors =                       (* Grab all the neighbors for some given temp. *)
  48             (OperSet.listItems
  49               (valOf (TempMap.find (graph, chosen))))
  50           val newWeights =
  51             List.map
  52               (fn (t, wt) =>
  53                 (t,
  54                   if (List.exists
  55                         (fn X.TEMP t' => (T.eq (t, t'))
  56                           | _ => false)
  57                         neighbors)
  58                     then (wt + 1)
  59                     else wt
  60                 )
  61               ) remaining
  62         in
  63           (chosen, newWeights)
  64         end
  65
  66       (* Recursively order until we run out of things to order. *)
  67       fun keepOrdering (nil : (Temp.temp * int) list) : Temp.temp list = nil
  68         | keepOrdering (weights) =
  69           let
  70             val (chosen, newWeights) = orderOne weights
  71           in
  72             chosen :: (keepOrdering newWeights)
  73           end
  74
  75       val ordered = keepOrdering (TempMap.listItems initialWeights)
  76     in
  77       ordered @ (List.filter (fn a => not (List.exists (fn b => Temp.eq (a,b)) ordered)) temps)
  78     end
  79 end