Dsatur coloring algorithm
It is not completely generic, as we need to know the difference between affinity and interference edges.
This commit is contained in:
parent
3f9918b570
commit
448c163181
|
@ -206,6 +206,9 @@ let compute_live_vars eqs =
|
||||||
in
|
in
|
||||||
let env = IvarSet.fold decr_uses (InterfRead.read eq) env in
|
let env = IvarSet.fold decr_uses (InterfRead.read eq) env in
|
||||||
let alive_vars = IvarEnv.fold (fun iv n acc -> if n > 0 then iv::acc else acc) env [] in
|
let alive_vars = IvarEnv.fold (fun iv n acc -> if n > 0 then iv::acc else acc) env [] in
|
||||||
|
|
||||||
|
Format.printf " Alive vars : %s@." (String.concat " " (List.map ivar_to_string alive_vars));
|
||||||
|
|
||||||
let res = (eq, alive_vars)::res in
|
let res = (eq, alive_vars)::res in
|
||||||
let env = IvarSet.fold (add_uses uses) (InterfRead.def eq) env in
|
let env = IvarSet.fold (add_uses uses) (InterfRead.def eq) env in
|
||||||
env, res
|
env, res
|
||||||
|
@ -432,17 +435,17 @@ let color_interf_graphs igs =
|
||||||
let record_igs, igs =
|
let record_igs, igs =
|
||||||
List.partition (fun ig -> is_record_type ig.g_type) igs in
|
List.partition (fun ig -> is_record_type ig.g_type) igs in
|
||||||
(* First color interference graphs of record types *)
|
(* First color interference graphs of record types *)
|
||||||
List.iter color record_igs;
|
List.iter Dcoloring.color record_igs;
|
||||||
(* Then update fields colors *)
|
(* Then update fields colors *)
|
||||||
List.iter color_fields igs;
|
List.iter color_fields igs;
|
||||||
(* and finish the coloring *)
|
(* and finish the coloring *)
|
||||||
List.iter color igs
|
List.iter Dcoloring.color igs
|
||||||
|
|
||||||
let print_graphs f igs =
|
let print_graphs f igs =
|
||||||
let cpt = ref 0 in
|
let cpt = ref 0 in
|
||||||
let print_graph ig =
|
let print_graph ig =
|
||||||
let s = (Names.shortname f.n_name)^ (string_of_int !cpt) in
|
let s = (Names.shortname f.n_name)^ (string_of_int !cpt) in
|
||||||
print_graph (Names.fullname f.n_name) s ig;
|
Interference2dot.print_graph (Names.fullname f.n_name) s ig;
|
||||||
cpt := !cpt + 1
|
cpt := !cpt + 1
|
||||||
in
|
in
|
||||||
List.iter print_graph igs
|
List.iter print_graph igs
|
||||||
|
@ -451,7 +454,7 @@ let print_graphs f igs =
|
||||||
from the interference graph.*)
|
from the interference graph.*)
|
||||||
let create_subst_lists igs =
|
let create_subst_lists igs =
|
||||||
let create_one_ig ig =
|
let create_one_ig ig =
|
||||||
List.map (fun x -> ig.g_type, x) (values_by_color ig)
|
List.map (fun x -> ig.g_type, x) (Dcoloring.values_by_color ig)
|
||||||
in
|
in
|
||||||
List.flatten (List.map create_one_ig igs)
|
List.flatten (List.map create_one_ig igs)
|
||||||
|
|
||||||
|
@ -466,6 +469,7 @@ let node _ acc f =
|
||||||
{ f with n_mem_alloc = create_subst_lists igs }, acc
|
{ f with n_mem_alloc = create_subst_lists igs }, acc
|
||||||
|
|
||||||
let program p =
|
let program p =
|
||||||
|
Format.printf "is_directe %b@." (G.is_directed);
|
||||||
let funs = { Mls_mapfold.defaults with Mls_mapfold.node_dec = node } in
|
let funs = { Mls_mapfold.defaults with Mls_mapfold.node_dec = node } in
|
||||||
let p, _ = Mls_mapfold.program_it funs () p in
|
let p, _ = Mls_mapfold.program_it funs () p in
|
||||||
p
|
p
|
||||||
|
|
88
compiler/utilities/minils/dcoloring.ml
Normal file
88
compiler/utilities/minils/dcoloring.ml
Normal file
|
@ -0,0 +1,88 @@
|
||||||
|
open Interference_graph
|
||||||
|
|
||||||
|
(** Coloring*)
|
||||||
|
let no_color = 0
|
||||||
|
let min_color = 1
|
||||||
|
|
||||||
|
module ColorEnv =
|
||||||
|
ListMap(struct
|
||||||
|
type t = int
|
||||||
|
let compare = compare
|
||||||
|
end)
|
||||||
|
|
||||||
|
module ColorSet =
|
||||||
|
Set.Make(struct
|
||||||
|
type t = int
|
||||||
|
let compare = compare
|
||||||
|
end)
|
||||||
|
|
||||||
|
module Dsatur = struct
|
||||||
|
let rec remove_colored l = match l with
|
||||||
|
| [] -> []
|
||||||
|
| v::l -> if G.Mark.get v > 0 then l else remove_colored l
|
||||||
|
|
||||||
|
let colors i g v =
|
||||||
|
let color e colors =
|
||||||
|
if G.E.label e = i then
|
||||||
|
let c = G.Mark.get (G.E.dst e) in
|
||||||
|
if c <> 0 then
|
||||||
|
ColorSet.add c colors
|
||||||
|
else
|
||||||
|
colors
|
||||||
|
else
|
||||||
|
colors
|
||||||
|
in
|
||||||
|
G.fold_succ_e color g v ColorSet.empty
|
||||||
|
|
||||||
|
(** Returns the smallest value not in the list of colors. *)
|
||||||
|
let rec find_min_available_color interf_colors =
|
||||||
|
let rec aux i =
|
||||||
|
if not (ColorSet.mem i interf_colors) then i else aux (i+1)
|
||||||
|
in
|
||||||
|
aux min_color
|
||||||
|
|
||||||
|
(** Returns a new color from interference and affinity colors lists.*)
|
||||||
|
let pick_color interf_colors aff_colors =
|
||||||
|
let aff_colors = ColorSet.diff aff_colors interf_colors in
|
||||||
|
if not (ColorSet.is_empty aff_colors) then
|
||||||
|
ColorSet.choose aff_colors
|
||||||
|
else
|
||||||
|
find_min_available_color interf_colors
|
||||||
|
|
||||||
|
let dsat g v =
|
||||||
|
let color_deg = ColorSet.cardinal (colors Iinterference g v) in
|
||||||
|
if color_deg = 0 then G.out_degree g v else color_deg
|
||||||
|
|
||||||
|
let dsat_max g v1 v2 =
|
||||||
|
match compare (dsat g v1) (dsat g v2) with
|
||||||
|
| 0 -> if G.out_degree g v1 > G.out_degree g v2 then v1 else v2
|
||||||
|
| x when x > 0 -> v1
|
||||||
|
| _ -> v2
|
||||||
|
|
||||||
|
let uncolored_vertices g =
|
||||||
|
G.fold_vertex (fun v acc -> if G.Mark.get v = 0 then v::acc else acc) g []
|
||||||
|
|
||||||
|
let color_vertex g v =
|
||||||
|
G.Mark.set v (pick_color (colors Iinterference g v) (colors Iaffinity g v))
|
||||||
|
|
||||||
|
let rec color_vertices g vertices = match vertices with
|
||||||
|
| [] -> ()
|
||||||
|
| v::vertices ->
|
||||||
|
let vmax = List.fold_left (dsat_max g) v vertices in
|
||||||
|
color_vertex g vmax;
|
||||||
|
let vertices = remove_colored (v::vertices) in
|
||||||
|
color_vertices g vertices
|
||||||
|
|
||||||
|
let coloring g =
|
||||||
|
color_vertices g (uncolored_vertices g)
|
||||||
|
end
|
||||||
|
|
||||||
|
let values_by_color g =
|
||||||
|
let env = G.fold_vertex
|
||||||
|
(fun n env -> ColorEnv.add_elements (G.Mark.get n) !(G.V.label n) env)
|
||||||
|
g.g_graph ColorEnv.empty
|
||||||
|
in
|
||||||
|
ColorEnv.fold (fun _ v acc -> v::acc) env []
|
||||||
|
|
||||||
|
let color g =
|
||||||
|
Dsatur.coloring g.g_graph
|
53
compiler/utilities/minils/interference2dot.ml
Normal file
53
compiler/utilities/minils/interference2dot.ml
Normal file
|
@ -0,0 +1,53 @@
|
||||||
|
open Graph
|
||||||
|
open Interference_graph
|
||||||
|
|
||||||
|
(** Printing *)
|
||||||
|
|
||||||
|
module DotG = struct
|
||||||
|
include G
|
||||||
|
|
||||||
|
let name = ref ""
|
||||||
|
|
||||||
|
let color_to_graphviz_color i =
|
||||||
|
(i * 8364263947 + 855784368)
|
||||||
|
|
||||||
|
(*Functions for printing the graph *)
|
||||||
|
let default_vertex_attributes _ = []
|
||||||
|
let default_edge_attributes _ = []
|
||||||
|
let get_subgraph _ = None
|
||||||
|
|
||||||
|
let graph_attributes _ =
|
||||||
|
[`Label !name]
|
||||||
|
|
||||||
|
let vertex_name v =
|
||||||
|
let rec ivar_name iv =
|
||||||
|
match iv with
|
||||||
|
| Ivar id -> Idents.name id
|
||||||
|
| Ifield(ivar, f) -> (ivar_name ivar)^"_"^(Names.shortname f)
|
||||||
|
in
|
||||||
|
Misc.sanitize_string (ivar_name (List.hd !(V.label v)))
|
||||||
|
|
||||||
|
let vertex_attributes v =
|
||||||
|
let s = String.concat ", " (List.map (fun iv -> ivar_to_string iv) !(V.label v)) in
|
||||||
|
[`Label s; `Color (color_to_graphviz_color (Mark.get v))]
|
||||||
|
|
||||||
|
let edge_attributes e =
|
||||||
|
let style =
|
||||||
|
match E.label e with
|
||||||
|
| Iinterference -> `Solid
|
||||||
|
| Iaffinity -> `Dashed
|
||||||
|
| Isame_value -> `Dotted
|
||||||
|
in
|
||||||
|
[`Style style; `Dir `None]
|
||||||
|
end
|
||||||
|
|
||||||
|
module DotPrint = Graphviz.Dot(DotG)
|
||||||
|
|
||||||
|
let print_graph label filename g =
|
||||||
|
Global_printer.print_type Format.str_formatter g.g_type;
|
||||||
|
let ty_str = Format.flush_str_formatter () in
|
||||||
|
DotG.name := label^" : "^ty_str;
|
||||||
|
let oc = open_out (filename ^ ".dot") in
|
||||||
|
Format.printf "Wrriting to %s.dot@." filename;
|
||||||
|
DotPrint.output_graph oc g.g_graph;
|
||||||
|
close_out oc
|
|
@ -79,6 +79,12 @@ struct
|
||||||
r := !(V.label n2) @ !r;
|
r := !(V.label n2) @ !r;
|
||||||
remove_vertex g n2
|
remove_vertex g n2
|
||||||
)
|
)
|
||||||
|
|
||||||
|
let vertices g =
|
||||||
|
fold_vertex (fun v acc -> v::acc) g []
|
||||||
|
|
||||||
|
let filter_vertices f g =
|
||||||
|
fold_vertex (fun v acc -> if f v then v::acc else acc) g []
|
||||||
end
|
end
|
||||||
|
|
||||||
type interference_graph = {
|
type interference_graph = {
|
||||||
|
@ -172,72 +178,3 @@ let iter_interf f g =
|
||||||
f g (G.E.src e) (G.E.dst e)
|
f g (G.E.src e) (G.E.dst e)
|
||||||
in
|
in
|
||||||
G.iter_edges_e do_f g.g_graph
|
G.iter_edges_e do_f g.g_graph
|
||||||
|
|
||||||
(** Coloring*)
|
|
||||||
module KColor = Coloring.Mark(G)
|
|
||||||
module ColorEnv =
|
|
||||||
ListMap(struct
|
|
||||||
type t = int
|
|
||||||
let compare = compare
|
|
||||||
end)
|
|
||||||
|
|
||||||
let color g =
|
|
||||||
KColor.coloring g.g_graph (Hashtbl.length g.g_hash)
|
|
||||||
|
|
||||||
let values_by_color g =
|
|
||||||
let env = G.fold_vertex
|
|
||||||
(fun n env -> ColorEnv.add_elements (G.Mark.get n) !(G.V.label n) env)
|
|
||||||
g.g_graph ColorEnv.empty
|
|
||||||
in
|
|
||||||
ColorEnv.fold (fun _ v acc -> v::acc) env []
|
|
||||||
|
|
||||||
(** Printing *)
|
|
||||||
|
|
||||||
module DotG = struct
|
|
||||||
include G
|
|
||||||
|
|
||||||
let name = ref ""
|
|
||||||
|
|
||||||
let color_to_graphviz_color i =
|
|
||||||
(i * 8364263947 + 855784368)
|
|
||||||
|
|
||||||
(*Functions for printing the graph *)
|
|
||||||
let default_vertex_attributes _ = []
|
|
||||||
let default_edge_attributes _ = []
|
|
||||||
let get_subgraph _ = None
|
|
||||||
|
|
||||||
let graph_attributes _ =
|
|
||||||
[`Label !name]
|
|
||||||
|
|
||||||
let vertex_name v =
|
|
||||||
let rec ivar_name iv =
|
|
||||||
match iv with
|
|
||||||
| Ivar id -> Idents.name id
|
|
||||||
| Ifield(ivar, f) -> (ivar_name ivar)^"_"^(Names.shortname f)
|
|
||||||
in
|
|
||||||
Misc.sanitize_string (ivar_name (List.hd !(V.label v)))
|
|
||||||
|
|
||||||
let vertex_attributes v =
|
|
||||||
let s = String.concat ", " (List.map (fun iv -> ivar_to_string iv) !(V.label v)) in
|
|
||||||
[`Label s; `Color (color_to_graphviz_color (Mark.get v))]
|
|
||||||
|
|
||||||
let edge_attributes e =
|
|
||||||
let style =
|
|
||||||
match E.label e with
|
|
||||||
| Iinterference -> `Solid
|
|
||||||
| Iaffinity -> `Dashed
|
|
||||||
| Isame_value -> `Dotted
|
|
||||||
in
|
|
||||||
[`Style style]
|
|
||||||
end
|
|
||||||
|
|
||||||
module DotPrint = Graphviz.Dot(DotG)
|
|
||||||
|
|
||||||
let print_graph label filename g =
|
|
||||||
Global_printer.print_type Format.str_formatter g.g_type;
|
|
||||||
let ty_str = Format.flush_str_formatter () in
|
|
||||||
DotG.name := label^" : "^ty_str;
|
|
||||||
let oc = open_out (filename ^ ".dot") in
|
|
||||||
Format.printf "Wrriting to %s.dot@." filename;
|
|
||||||
DotPrint.output_graph oc g.g_graph;
|
|
||||||
close_out oc
|
|
||||||
|
|
Loading…
Reference in a new issue