diff --git a/compiler/minils/analysis/interference.ml b/compiler/minils/analysis/interference.ml index 1f4c5ae..6642f33 100644 --- a/compiler/minils/analysis/interference.ml +++ b/compiler/minils/analysis/interference.ml @@ -8,6 +8,26 @@ open Printf let memalloc_debug = true +let verbose_mode = true +let print_debug0 s = + if verbose_mode then + Format.printf s + +let print_debug1 fmt x = + if verbose_mode then + Format.printf fmt x + +let print_debug2 fmt x y = + if verbose_mode then + Format.printf fmt x y + +let print_debug_ivar_env name env = + if verbose_mode then ( + Format.printf "%s: " name; + IvarEnv.iter (fun k v -> Format.printf "%s : %d; " (ivar_to_string k) v) env; + Format.printf "@." + ) + module TyEnv = ListMap(struct type t = ty @@ -122,7 +142,7 @@ module World = struct let node_for_ivar iv = let rec _node_for_ivar igs iv = match igs with - | [] -> Format.printf "Var not in graph: %s@." (ivar_to_string iv); raise Not_found + | [] -> (*Format.printf "Var not in graph: %s@." (ivar_to_string iv);*) raise Not_found | ig::igs -> (try ig, node_for_value ig iv @@ -190,34 +210,31 @@ let number_uses iv uses = | Not_found -> 0 let add_uses uses iv env = - if World.is_optimized iv then ( - Format.printf "Adding uses of %s@." (ivar_to_string iv); + if World.is_optimized iv then IvarEnv.add iv (number_uses iv uses) env - ) else ( - Format.printf "Ignoring uses of %s@." (ivar_to_string iv); + else env - ) let compute_live_vars eqs = let uses = compute_uses eqs in + print_debug_ivar_env "Uses" uses; let aux (env,res) eq = let decr_uses iv env = if World.is_optimized iv then try IvarEnv.add iv ((IvarEnv.find iv env) - 1) env with - | Not_found -> Format.printf "var not found : %s@." (ivar_to_string iv); assert false + | Not_found ->(* Format.printf "var not found : %s@." (ivar_to_string iv);*) assert false else 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 - - Format.printf " Alive vars : %s@." (String.concat " " (List.map ivar_to_string alive_vars)); - - let res = (eq, alive_vars)::res in - let env = IvarSet.fold (add_uses uses) (InterfRead.def eq) env in - env, res + print_debug1 "Alive vars : %s@." (String.concat " " (List.map ivar_to_string alive_vars)); + let env = IvarSet.fold decr_uses (InterfRead.read eq) env in + let res = (eq, alive_vars)::res in + let env = IvarSet.fold (add_uses uses) (InterfRead.def eq) env in + print_debug_ivar_env "Remaining uses" env; + env, res in let env = IvarSet.fold (add_uses uses) !World.memories IvarEnv.empty in let _, res = List.fold_left aux (env, []) eqs in @@ -483,7 +500,6 @@ let node _ acc f = { f with n_mem_alloc = create_subst_lists igs }, acc let program p = - Format.printf "is_directe %b@." (G.is_directed); let funs = { Mls_mapfold.defaults with Mls_mapfold.node_dec = node } in let p, _ = Mls_mapfold.program_it funs () p in p diff --git a/compiler/obc/transformations/memalloc_apply.ml b/compiler/obc/transformations/memalloc_apply.ml index ad248b8..193cf0c 100644 --- a/compiler/obc/transformations/memalloc_apply.ml +++ b/compiler/obc/transformations/memalloc_apply.ml @@ -43,15 +43,14 @@ let choose_representative m inputs outputs mems ty vars = | [], [Ivar vout], [] -> Lvar vout | [Ivar vin], [Ivar _], [] -> Lvar vin | _, _, _ -> - (* Format.printf "Something is wrong with the coloring : "; - List.iter (fun vd -> Format.printf "%s," (ivar_to_string vd)) vars; - Format.printf "\n Inputs : "; - List.iter (fun vd -> Format.printf "%s," (ivar_to_string vd)) inputs; - Format.printf "\n Outputs : "; - List.iter (fun vd -> Format.printf "%s," (ivar_to_string vd)) outputs; - Format.printf "\n Mem : "; - List.iter (fun vd -> Format.printf "%s," (ivar_to_string vd)) mems; - Format.printf "\n"; *) + Interference.print_debug0 "@.Something is wrong with the coloring : "; + Interference.print_debug1 "%s@." (String.concat " " (List.map ivar_to_string vars)); + Interference.print_debug0 "\tInputs : "; + Interference.print_debug1 "%s@." (String.concat " " (List.map ivar_to_string inputs)); + Interference.print_debug0 "\tOutputs : "; + Interference.print_debug1 "%s@." (String.concat " " (List.map ivar_to_string outputs)); + Interference.print_debug0 "\tMem : "; + Interference.print_debug1 "%s@." (String.concat " " (List.map ivar_to_string mems)); assert false (*something went wrong in the coloring*) in mk_pattern ty desc diff --git a/compiler/utilities/minils/dcoloring.ml b/compiler/utilities/minils/dcoloring.ml index b2dc862..a1244e0 100644 --- a/compiler/utilities/minils/dcoloring.ml +++ b/compiler/utilities/minils/dcoloring.ml @@ -63,7 +63,8 @@ module Dsatur = struct 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 c = (pick_color (colors Iinterference g v) (colors Iaffinity g v)) in + G.Mark.set v c let rec color_vertices g vertices = match vertices with | [] -> () diff --git a/compiler/utilities/minils/interference2dot.ml b/compiler/utilities/minils/interference2dot.ml index 64971e6..83736af 100644 --- a/compiler/utilities/minils/interference2dot.ml +++ b/compiler/utilities/minils/interference2dot.ml @@ -48,6 +48,5 @@ let print_graph label filename g = 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