extracted/untrusted/compute_colouring.ml

   1 (* Adapted from Pottier's PP compiler *)
   2
   3 let colour_graph globals int_fun liveafter =
   4   (* Build an interference graph for this function, and color
   5      it. Define a function that allows consulting the coloring. *)
   6
   7   let uses = Uses.examine_internal globals int_fun in
   8
   9   let module G = struct
  10     let graph = Build.build globals int_fun uses liveafter
  11     let uses =
  12      (fun r ->
  13        Glue.int_of_matitapos
  14         (Identifiers.lookup_safe PreIdentifiers.RegisterTag uses r))
  15     let verbose = false
  16 (*
  17     let () =
  18       if verbose then
  19         Printf.printf "Starting hardware register allocation for %s.\n" f
  20 *)
  21   end in
  22
  23   let module C = Coloring.Color (G) in
  24
  25   let lookup r =
  26     Untrusted_interference.Vertex.Map.find (Untrusted_interference.lookup G.graph r) C.coloring
  27   in
  28
  29   (* Restrict the interference graph to concern spilled vertices only,
  30      and color it again, this time using stack slots as colors. *)
  31
  32   let module H = struct
  33     let graph = Untrusted_interference.droph (Untrusted_interference.restrict G.graph (fun v ->
  34       match Untrusted_interference.Vertex.Map.find v C.coloring with
  35       | Coloring.Spill ->
  36           true
  37       | Coloring.Color _ ->
  38           false
  39     ))
  40     let verbose = false
  41 (*
  42     let () =
  43       if verbose then
  44         Printf.printf "Starting stack slot allocation for %s.\n" f
  45 *)
  46   end in
  47
  48   let module S = Spill.Color (H) in
  49
  50   (* Define a new function that consults both colorings at once. *)
  51
  52   let lookup r =
  53    match r with
  54       Types.Inl r ->
  55        (match lookup r with
  56        | Coloring.Spill ->
  57            Interference.Decision_spill (Glue.matitanat_of_int (Untrusted_interference.Vertex.Map.find (Untrusted_interference.lookup H.graph r) S.coloring))
  58        | Coloring.Color color ->
  59            Interference.Decision_colour color)
  60     | Types.Inr r -> Interference.Decision_colour r
  61   in
  62
  63    { Interference.colouring = lookup;
  64      spilled_no = Glue.matitanat_of_int S.locals
  65    }