From 1059329c0e9152cd5e086e01f690eb3bfffb4a0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= Date: Wed, 20 Apr 2011 15:41:15 +0200 Subject: [PATCH] Interference compiles --- compiler/minils/analysis/interference.ml | 256 ++++++++++++------ compiler/minils/minils.ml | 2 +- .../utilities/minils/interference_graph.ml | 3 +- compiler/utilities/misc.ml | 7 +- compiler/utilities/misc.mli | 12 + 5 files changed, 190 insertions(+), 90 deletions(-) diff --git a/compiler/minils/analysis/interference.ml b/compiler/minils/analysis/interference.ml index f6ec0fe..ae3d1b9 100644 --- a/compiler/minils/analysis/interference.ml +++ b/compiler/minils/analysis/interference.ml @@ -1,22 +1,85 @@ open Idents +open Types +open Clocks +open Signature +open Minils open Interference_graph module TyEnv = - ListMap.Make (struct - type t = Types.ty + ListMap(struct + type t = ty let compare = Global_compare.type_compare end) +module InterfRead = struct + let rec vars_ck acc = function + | Con(_, _, n) -> IvarSet.add (Ivar n) acc + | Cbase | Cvar { contents = Cindex _ } -> acc + | Cvar { contents = Clink ck } -> vars_ck acc ck + + let rec ivar_of_extvalue w = match w.w_desc with + | Wvar x -> Ivar x + | Wfield(w, f) -> Ifield (ivar_of_extvalue w, f) + | Wwhen(w, _, _) -> ivar_of_extvalue w + | Wconst _ -> assert false + + let ivars_of_extvalues wl = + let tr_one acc w = match w.w_desc with + | Wconst _ -> acc + | _ -> (ivar_of_extvalue w)::acc + in + List.fold_left tr_one [] wl + + let read_extvalue funs acc w = + (* recursive call *) + let _, acc = Mls_mapfold.extvalue funs acc w in + let acc = + match w.w_desc with + | Wconst _ -> acc + | _ -> IvarSet.add (ivar_of_extvalue w) acc + in + w, vars_ck acc w.w_ck + + let read_exp funs acc e = + (* recursive call *) + let _, acc = Mls_mapfold.exp funs acc e in + (* special cases *) + let acc = match e.e_desc with + | Emerge(x,_) | Eapp(_, _, Some x) + | Eiterator (_, _, _, _, _, Some x) -> IvarSet.add (Ivar x) acc + | _ -> acc + in + e, vars_ck acc e.e_ck + + let rec vars_pat acc = function + | Evarpat x -> IvarSet.add (Ivar x) acc + | Etuplepat pat_list -> List.fold_left vars_pat acc pat_list + + let def eq = + vars_pat IvarSet.empty eq.eq_lhs + + let read_exp e = + let funs = { Mls_mapfold.defaults with + Mls_mapfold.exp = read_exp; + Mls_mapfold.extvalue = read_extvalue } in + let _, acc = Mls_mapfold.exp_it funs IvarSet.empty e in + acc + + let read eq = + read_exp eq.eq_rhs +end + + module World = struct - let vds = ref Idents.Env.empty + let vds = ref Env.empty let memories = ref IvarSet.empty - let init_world f = + let init f = (* build vds cache *) - let build env vd = - Idents.Env.add vd.v_ident vd env + let build env vds = + List.fold_left (fun env vd -> Env.add vd.v_ident vd env) env vds in - let env = build Idents.Env.empty f.n_input in + let env = build Env.empty f.n_input in let env = build env f.n_output in let env = build env f.n_local in vds := env; @@ -25,34 +88,34 @@ module World = struct memories := List.fold_left (fun s (x, _) -> IvarSet.add (Ivar x) s) IvarSet.empty mems let vd_from_ident x = - Idents.Env.find x !vds + Env.find x !vds let rec ivar_type iv = match iv with | Ivar x -> let vd = vd_from_ident x in vd.v_type | Ifield(_, f) -> - Modules.find_field f + Tid (Modules.find_field f) let is_optimized_ty ty = - match unalias_type ty with + match Modules.unalias_type ty with | Tarray _ -> true | Tid n -> - (match find_type n with - | Tstruct _ -> true + (match Modules.find_type n with + | Signature.Tstruct _ -> true | _ -> false) - | Tinvalid -> false + | _ -> false let is_optimized iv = is_optimized_ty (ivar_type iv) let is_memory x = - Idents.IdentSet.mem x !memories + IvarSet.mem (Ivar x) !memories let igs = ref [] let node_for_ivar iv = - let rec _node_for_ivar igs x = + let rec _node_for_ivar igs iv = match igs with | [] -> (*Format.eprintf "Var not in graph: %s\n" (ivar_to_string x); *) raise Not_found | ig::igs -> @@ -61,7 +124,7 @@ module World = struct with Not_found -> _node_for_ivar igs iv) in - _node_for_ivar !World.igs iv + _node_for_ivar !igs iv let node_for_name x = node_for_ivar (Ivar x) @@ -69,36 +132,43 @@ end (** Helper functions to work with the multiple interference graphs *) -let by_ivar f x y = +let by_ivar def f x y = let igx, nodex = World.node_for_ivar x in let igy, nodey = World.node_for_ivar y in if igx == igy then f igx nodex nodey + else + def -let by_name f x y = +let by_name def f x y = let igx, nodex = World.node_for_name x in let igy, nodey = World.node_for_name y in if igx == igy then f igx nodex nodey + else + def -let add_interference_link_from_name = by_name add_interference_link -let add_interference_link_from_ivar = by_ivar add_interference_link -let add_affinity_link_from_name = by_name add_affinity_link -let coalesce_from_name = by_name coalesce -let have_same_value_from_name = by_name have_same_value +let add_interference_link_from_name = by_name () add_interference_link +let add_interference_link_from_ivar = by_ivar () add_interference_link +let add_affinity_link_from_name = by_name () add_affinity_link +let add_affinity_link_from_ivar = by_ivar () add_affinity_link +let add_same_value_link_from_name = by_name () add_affinity_link +let add_same_value_link_from_ivar = by_ivar () add_affinity_link +let coalesce_from_name = by_name () coalesce +let have_same_value_from_name = by_name false have_same_value (** Returns a map giving the number of uses of each ivar in the equations [eqs]. *) let compute_uses eqs = let aux env eq = - let incr_uses env iv = + let incr_uses iv env = if IvarEnv.mem iv env then IvarEnv.add iv ((IvarEnv.find iv env) + 1) env else IvarEnv.add iv 1 env in - List.fold_left incr_uses env (InterfRead.read eq) + IvarSet.fold incr_uses (InterfRead.read eq) env in List.fold_left aux IvarEnv.empty eqs @@ -108,16 +178,16 @@ let number_uses iv uses = with | Not_found -> 0 -let add_uses uses env iv = +let add_uses uses iv env = if World.is_optimized iv then IvarEnv.add iv (number_uses iv uses) env else env -let compute_live_vars mems eqs = +let compute_live_vars eqs = let uses = compute_uses eqs in let aux eq (env,res) = - let decr_uses env iv = + let decr_uses iv env = if World.is_optimized iv then try IvarEnv.add iv ((IvarEnv.find iv env) - 1) env @@ -126,43 +196,47 @@ let compute_live_vars mems eqs = else env in - let env = List.fold_left decr_uses env (InterfRead.read eq) in - let alive_vars = IvarEnv.fold (fun iv n acc -> if acc > 0 then iv::acc else acc) 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 res = (eq, alive_vars)::res in - let env = List.fold_left (add_uses uses) env (InterfRead.def eq) in + let env = IvarSet.fold (add_uses uses) (InterfRead.def eq) env in env, res in - let env = List.fold_left (add_uses uses) IvarEnv.empty mems in + let env = IvarSet.fold (add_uses uses) !World.memories IvarEnv.empty in let _, res = List.fold_right aux eqs (env, []) in res -let disjoint_clock is_mem ck1 ck2 = - match vdx.v_clock, vdy.v_clock with - | Clocks.Con(ck1, c1, n1), Clocks.Con(ck2,c2,n2) -> - let separated_by_reset = - (match x_is_mem, y_is_mem with - | true, true -> are_separated_by_reset c1 c2 - | _, _ -> true) in - ck1 = ck2 & n1 = n2 & c1 <> c2 & separated_by_reset - | _ -> false +let rec disjoint_clock is_mem ck1 ck2 = + match ck1, ck2 with + | Cbase, Cbase -> false + | Con(ck1, c1, n1), Con(ck2,c2,n2) -> + if ck1 = ck2 & n1 = n2 & c1 <> c2 then + true + else + disjoint_clock is_mem ck1 ck2 + (*let separated_by_reset = + (match x_is_mem, y_is_mem with + | true, true -> are_separated_by_reset c1 c2 + | _, _ -> true) in *) + | _ -> false (** [should_interfere x y] returns whether variables x and y can interfere. *) -let should_interfere x y = +let should_interfere (x, y) = let vdx = World.vd_from_ident x in let vdy = World.vd_from_ident y in - if Global_compare.compare_type vdx.v_type vdy.v_type <> 0 then + if Global_compare.type_compare vdx.v_type vdy.v_type <> 0 then false else ( let x_is_mem = World.is_memory x in let y_is_mem = World.is_memory y in - let are_copies = have_same_value_by_name x y in + let are_copies = have_same_value_from_name x y in let disjoint_clocks = disjoint_clock (x_is_mem && y_is_mem) vdx.v_clock vdy.v_clock in not (disjoint_clocks or are_copies) ) -let should_interfere = memoize_couple should_interfere +let should_interfere = Misc.memoize_couple should_interfere (** Builds the (empty) interference graphs corresponding to the variable declaration list vds. It just creates one graph per type @@ -170,7 +244,7 @@ let should_interfere = memoize_couple should_interfere let init_interference_graph f = (** Adds a node to the list of nodes for the given type. *) let add_node env iv ty = - let ty = unalias_type ty in + let ty = Modules.unalias_type ty in if World.is_optimized_ty ty then TyEnv.add_element ty (mk_node iv) env else @@ -182,7 +256,7 @@ let init_interference_graph f = (match ty with | Tid n -> (try - let fields = find_struct n in + let fields = Modules.find_struct n in List.fold_left (fun env { f_name = f; f_type = ty } -> add_ivar env (Ifield (iv, f)) ty) env fields with @@ -193,9 +267,9 @@ let init_interference_graph f = in (* do not add not linear inputs*) let vds = (*List.filter is_linear f.n_input @ *) f.n_output @ f.n_local in - let env = Idents.Env.fold - (fun _ vd env -> add_ivar env (Ivar vd.v_ident) vd.v_type) TyEnv.empty vds in - World.igs := TyEnv.fold mk_graph [] env + let env = List.fold_left + (fun env vd -> add_ivar env (Ivar vd.v_ident) vd.v_type) TyEnv.empty vds in + World.igs := TyEnv.fold (fun ty l acc -> (mk_graph l ty)::acc) env [] (** Adds interferences between all the variables in @@ -205,26 +279,33 @@ let init_interference_graph f = let rec add_interferences_from_list force vars = let add_interference x y = match x, y with - | IVar x, IVar y -> - if force or should_interfere x y then - add_interference_link_from_ivar (IVar x) (IVar y) + | Ivar x, Ivar y -> + if force or should_interfere (x, y) then + add_interference_link_from_ivar (Ivar x) (Ivar y) | _, _ -> add_interference_link_from_ivar x y in - iter_couple add_interference vars + Misc.iter_couple add_interference vars (** Adds to the interference graphs [igs] the interference resulting from the live vars sets stored in hash. *) -let add_interferences igs live_vars = +let add_interferences live_vars = List.iter (fun (_, vars) -> add_interferences_from_list false vars) live_vars +(** @return whether [ty] corresponds to a record type. *) +let is_record_type ty = match ty with + | Tid n -> + (match Modules.find_type n with + | Tstruct _ -> true + | _ -> false) + | _ -> false (** [filter_vars l] returns a list of variables whose fields appear in a list of ivar.*) let rec filter_fields = function | [] -> [] - | (IField (id, f))::l -> id::(filter_fields l) + | (Ifield (id, _))::l -> id::(filter_fields l) | _::l -> filter_fields l (** Returns all the fields of a variable (when it corresponds to a record). *) @@ -233,7 +314,7 @@ let rec record_vars acc iv ty = match ty with | Tid n -> (try - let fields = find_struct n in + let fields = Modules.find_struct n in List.fold_left (fun acc { f_name = n; f_type = ty } -> record_vars acc (Ifield(iv, n)) ty) acc fields with @@ -245,20 +326,20 @@ let rec record_vars acc iv ty = every equation. If x is live in eq, then so are all x.f. *) let fix_records_live_vars live_vars = let fix_one_list vars = - List.fold_left (fun acc iv -> record_vars [] iv (World.ivar_type)) [] vars + List.fold_left (fun acc iv -> record_vars acc iv (World.ivar_type iv)) [] vars in List.map (fun (eq, vars) -> eq, fix_one_list vars) live_vars (** Adds the interference between records variables caused by interferences between their fields. *) let add_records_field_interferences () = - let add_record_interf n1 n2 = - if interfere n1 n2 then - let v1 = filter_fields n1 in - let v2 = filter_fields n2 in - iter_couple add_interference_link_from_name v1 v2 + let add_record_interf g n1 n2 = + if interfere g n1 n2 then + let v1 = filter_fields !(G.V.label n1) in + let v2 = filter_fields !(G.V.label n2) in + Misc.iter_couple_2 add_interference_link_from_ivar v1 v2 in - List.iter (fun ig -> iter_interf add_record_interf ig.g_nodes) igs + List.iter (iter_interf add_record_interf) !World.igs @@ -266,34 +347,37 @@ let add_records_field_interferences () = the links corresponding to the equation. Interferences corresponding to live vars sets are already added by build_interf_graph. *) -let process_eq ({ eq_lhs = pat; eq_rhs = e } as eq) = +let process_eq ({ eq_lhs = pat; eq_rhs = e } as eq) = (** Other cases*) match pat, e.e_desc with (* | Eapp ({ a_op = (Efun f | Enode f) }, e_list, _) -> let targeting = (find_value f).node_targeting in apply_targeting igs targeting e_list pat eq *) - | _, Eiterator(Imap, { a_op = Enode f | Efun f }, _, e_list, _) -> - let invars = List.map var_from_exp e_list in - let outvars = vars_from_pat pat in + | _, Eiterator(Imap, { a_op = Enode _ | Efun _ }, _, _, w_list, _) -> + let invars = InterfRead.ivars_of_extvalues w_list in + let outvars = IvarSet.elements (InterfRead.def eq) in List.iter (fun inv -> List.iter - (add_affinity_link_from_name inv) outvars) invars - | Evarpat x, Efby(_, e) -> (* x = _ fby y *) - let y = assert_1 (InterfRead.read e) in - add_affinity_link_from_name y x - | Evarpat x, Eextvalue { w_desc = Wvar y } -> + (add_affinity_link_from_ivar inv) outvars) invars + | Evarpat x, Efby(_, w) -> (* x = _ fby y *) + (match w.w_desc with + | Wconst _ -> () + | _ -> add_affinity_link_from_ivar (InterfRead.ivar_of_extvalue w) (Ivar x) ) + | Evarpat x, Eextvalue w -> (* Add links between variables with the same value *) - add_same_value_link_from_name y x + (match w.w_desc with + | Wconst _ -> () + | _ -> add_same_value_link_from_ivar (InterfRead.ivar_of_extvalue w) (Ivar x) ) | _ -> () (* do nothing *) (** Add the special init and return equations to the dependency graph (resp at the bottom and top) *) let add_init_return_eq f = (** a_1,..,a_p = __init__ *) - let eq_init = mk_equation (pat_from_dec_list f.n_input) - (mk_extvalue_exp (Wconst (mk_static_int 0))) in + let eq_init = mk_equation (Mls_utils.pat_from_dec_list f.n_input) + (mk_extvalue_exp Initial.tint (Wconst (Initial.mk_static_int 0))) in (** __return__ = o_1,..,o_q *) let eq_return = mk_equation (Etuplepat []) - (mk_exp (tuple_from_dec_list f.n_output)) in + (mk_exp Tinvalid (Mls_utils.tuple_from_dec_list f.n_output)) in (eq_init::f.n_equs)@[eq_return] @@ -326,11 +410,11 @@ let build_interf_graph f = if a and b are shared, then a.f and b.f are too. *) let color_fields ig = let process n = - let fields = filter_fields (G.label n) in + let fields = filter_fields !(G.V.label n) in match fields with | [] -> () | id::_ -> (* we only look at the first as they will all have the same color *) - let _, top_node = node_for_name id in + let _, top_node = World.node_for_ivar id in G.Mark.set n (G.Mark.get top_node) in G.iter_vertex process ig.g_graph @@ -338,11 +422,11 @@ let color_fields ig = (** Color an interference graph.*) let color_interf_graphs igs = let record_igs, igs = - List.partition (fun ig -> is_record_type ig.g_info) igs in + List.partition (fun ig -> is_record_type ig.g_type) igs in (* First color interference graphs of record types *) List.iter color record_igs; (* Then update fields colors *) - List.iter (color_fields record_igs) igs; + List.iter color_fields igs; (* and finish the coloring *) List.iter color igs @@ -350,19 +434,19 @@ let color_interf_graphs igs = from the interference graph.*) let create_subst_lists igs = let create_one_ig ig = - List.map (fun x -> ig.g_info, x) (values_by_color ig) + List.map (fun x -> ig.g_type, x) (values_by_color ig) in List.flatten (List.map create_one_ig igs) -let node f = +let node funs acc f = (** Build the interference graphs *) let igs = build_interf_graph f in (** Color the graph *) color_interf_graphs igs; (** Remember the choice we made for code generation *) - { f with n_mem_alloc = create_subst_lists igs } + { f with n_mem_alloc = create_subst_lists igs }, acc let program p = - let funs = { Mls_mapfold.defaults with node_dec = node } in - let p, _ = Mls_mapfold.program_it funs ([], []) p in + 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/minils/minils.ml b/compiler/minils/minils.ml index 766bcc3..e7ccb9a 100644 --- a/compiler/minils/minils.ml +++ b/compiler/minils/minils.ml @@ -155,7 +155,7 @@ let mk_exp ty ?(clock = fresh_clock()) ?(loc = no_location) desc = { e_desc = desc; e_ty = ty; e_ck = clock; e_loc = loc } -let extvalue_exp ?(clock = fresh_clock()) ?(loc = no_location) ty desc = +let mk_extvalue_exp ?(clock = fresh_clock()) ?(loc = no_location) ty desc = mk_exp ~clock:clock ~loc:loc ty (Eextvalue (mk_extvalue ~clock:clock ~loc:loc ~ty:ty desc)) let mk_var_dec ?(loc = no_location) ?(clock = fresh_clock()) ident ty = diff --git a/compiler/utilities/minils/interference_graph.ml b/compiler/utilities/minils/interference_graph.ml index 20a91ea..8cea39a 100644 --- a/compiler/utilities/minils/interference_graph.ml +++ b/compiler/utilities/minils/interference_graph.ml @@ -42,7 +42,6 @@ let rec ivar_to_string = function | Ivar n -> Idents.name n | Ifield(iv,f) -> (ivar_to_string iv)^"."^(Names.shortname f) - module VertexValue = struct type t = ivar list ref (*let compare = compare @@ -170,7 +169,7 @@ let coalesce g n1 n2 = let iter_interf f g = let do_f e = if G.E.label e = Iinterference then - f (G.V.label (G.E.src e)) (G.V.label (G.E.dst e)) + f g (G.E.src e) (G.E.dst e) in G.iter_edges_e do_f g.g_graph diff --git a/compiler/utilities/misc.ml b/compiler/utilities/misc.ml index 6548c11..2d6376f 100644 --- a/compiler/utilities/misc.ml +++ b/compiler/utilities/misc.ml @@ -227,6 +227,7 @@ let split_string s separator = Str.split (separator |> Str.quote |> Str.regexp) let file_extension s = split_string s "." |> last_element +(** Memoize the result of the function [f]*) let memoize f = let map = Hashtbl.create 100 in fun x -> @@ -235,6 +236,8 @@ let memoize f = with | Not_found -> let r = f x in Hashtbl.add map x r; r +(** Memoize the result of the function [f], taht should expect a + tuple as input and be reflexive (f (x,y) = f (y,x)) *) let memoize_couple f = let map = Hashtbl.create 100 in fun (x,y) -> @@ -251,4 +254,6 @@ let rec iter_couple f l = match l with List.iter (f x) l; iter_couple f l - +(** [iter_couple_2 f l1 l2] calls f for all x in [l1] and y in [l2]. *) +let iter_couple_2 f l1 l2 = + List.iter (fun v1 -> List.iter (f v1) l2) l1 diff --git a/compiler/utilities/misc.mli b/compiler/utilities/misc.mli index 16783a9..ce808d0 100644 --- a/compiler/utilities/misc.mli +++ b/compiler/utilities/misc.mli @@ -77,6 +77,11 @@ val mapi3: (int -> 'a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list val fold_righti : (int -> 'a -> 'b -> 'b) -> 'a list -> 'b -> 'b +(** [iter_couple f l] calls f for all x and y distinct in [l]. *) +val iter_couple : ('a -> 'a -> unit) -> 'a list -> unit +(** [iter_couple_2 f l1 l2] calls f for all x in [l1] and y in [l2]. *) +val iter_couple_2 : ('a -> 'a -> unit) -> 'a list -> 'a list -> unit + (** Functions to decompose a list into a tuple *) val assert_empty : 'a list -> unit val assert_1 : 'a list -> 'a @@ -102,3 +107,10 @@ val internal_error : string -> int -> 'a (** Unsupported : Is used when something should work but is not currently supported *) val unsupported : string -> int -> 'a + +(** Memoize the result of the function [f]*) +val memoize : ('a -> 'b) -> ('a -> 'b) + +(** Memoize the result of the function [f], taht should expect a + tuple as input and be reflexive (f (x,y) = f (y,x)) *) +val memoize_couple : (('a * 'a) -> 'b) -> (('a * 'a) -> 'b)