1 (* Adapted from Pottier's PP compiler *)
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. *)
7 let uses = Uses.examine_internal globals int_fun in
10 let graph = Build.build globals int_fun uses liveafter
14 (Identifiers.lookup_safe PreIdentifiers.RegisterTag uses r))
19 Printf.printf "Starting hardware register allocation for %s.\n" f
23 let module C = Coloring.Color (G) in
26 Untrusted_interference.Vertex.Map.find (Untrusted_interference.lookup G.graph r) C.coloring
29 (* Restrict the interference graph to concern spilled vertices only,
30 and color it again, this time using stack slots as colors. *)
33 let graph = Untrusted_interference.droph (Untrusted_interference.restrict G.graph (fun v ->
34 match Untrusted_interference.Vertex.Map.find v C.coloring with
44 Printf.printf "Starting stack slot allocation for %s.\n" f
48 let module S = Spill.Color (H) in
50 (* Define a new function that consults both colorings at once. *)
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
63 { Interference.colouring = lookup;
64 spilled_no = Glue.matitanat_of_int S.locals