diff --git a/compiler/minils/transformations/schedule_interf.ml b/compiler/minils/transformations/schedule_interf.ml new file mode 100644 index 0000000..1157ef3 --- /dev/null +++ b/compiler/minils/transformations/schedule_interf.ml @@ -0,0 +1,174 @@ +(** A scheduler that tries to minimize interference between variables, in + order to have a more efficient memory allocation. *) +open Idents +open Minils +open Mls_utils +open Misc +open Sgraph + +module EqMap = + Map.Make ( + struct type t = eq + let compare = compare + end) + +let eq_clock eq = + eq.eq_rhs.e_ck + +module Cost = +struct + (** Returns the minimum of the values in the map. + Picks an equation with the clock ck if possible. *) + let min_map ck m = + let one_min k d (v,eq,same_ck) = + match eq with + | None -> (d, Some k, eq_clock k = ck) + | Some eq -> + if d < v then + (d, Some k, eq_clock eq = ck) + else if d = v & not same_ck & eq_clock eq = ck then + (v, Some k, true) + else + (v, Some eq, same_ck) + in + let _, eq, _ = EqMap.fold one_min m (0, None, false) in + match eq with + | None -> assert false + | Some eq -> eq + + (** Remove from the elements the elements whose value is zero or negative. *) + let remove_null m = + let check_not_null k d m = + if d > 0 then Env.add k d m else m + in + Env.fold check_not_null m Env.empty + + (** [remove_uses l m] decrease by one the value in the map m of each element + in the list l. This corresponds to removing one use for each variable. *) + let remove_uses l m = + let remove_one_use k d m = + if (List.mem k l) & (d - 1 > 0) then + Env.add k (d-1) m + else + m + in + Env.fold remove_one_use m m + + (** Returns the list of variables killed by an equation (ie vars + used by the equation and with use count equal to 1). *) + let killed_vars eq var_uses = + let is_killed acc v = + begin try + if Env.find v var_uses = 1 then + acc + 1 + else + acc + with Not_found -> + Format.printf "not found variable : %s" (name v); assert false + end + in + List.fold_left is_killed 0 (Vars.read false eq) + + (** [uses x eq_list] returns the number of uses of the variable x + in the lits of equations eq_list. *) + let uses x eq_list = + let appears_in_eq x eq = + if List.mem x (Vars.read false eq) then + 1 + else + 0 + in + List.fold_left (fun v eq -> (appears_in_eq x eq) + v) 0 eq_list + + (** Adds variables from the list l to the map m. + eq_list is used to compute the initial number of uses of this variable. *) + let add_vars l eq_list m = + List.fold_left (fun m v -> Env.add v (uses v eq_list) m) m l + + (** Compute the cost of all the equations in rem_eqs using var_uses. + So far, it uses only the number of killed and defined variables. *) + let compute_costs var_uses rem_eqs = + let cost eq = + let nb_killed_vars = killed_vars eq var_uses in + let nb_def_vars = List.length (Vars.def [] eq) in + nb_def_vars - nb_killed_vars + in + List.fold_left (fun m eq -> EqMap.add eq (cost eq) m) EqMap.empty rem_eqs + + (** Initialize the costs data structure. *) + let init_cost eq_list inputs = + add_vars inputs eq_list Env.empty + + (** [update_cost eq eq_list var_uses] updates the costs data structure + after eq has been chosen as the next equation to be scheduled. + It updates uses and adds the new variables defined by this equation. + *) + let update_cost eq eq_list var_uses = + let var_uses = remove_uses (Vars.read false eq) var_uses in + add_vars (Vars.def [] eq) eq_list var_uses + + (** Returns the next equation, chosen from the list of equations rem_eqs *) + let next_equation rem_eqs ck var_uses = + let eq_cost = compute_costs var_uses rem_eqs in + min_map ck eq_cost +end + +(** Returns the list of 'free' nodes in the dependency graph (nodes without + predecessors). *) +let free_eqs node_list = + let is_free n = + (List.length n.g_depends_on) = 0 + in + List.map (fun n -> n.g_containt) (List.filter is_free node_list) + +let rec node_for_eq eq nodes_list = + match nodes_list with + | [] -> raise Not_found + | n::nodes_list -> + if eq = n.g_containt then + n + else + node_for_eq eq nodes_list + +(** Remove an equation from the dependency graph. All the edges to + other nodes are removed. *) +let remove_eq eq node_list = + let n = node_for_eq eq node_list in + List.iter (remove_depends n) n.g_depends_on; + List.iter (fun n2 -> remove_depends n2 n) n.g_depends_by; + List.filter (fun n2 -> n.g_tag <> n2.g_tag) node_list + +(** Main function to schedule a node. *) +let schedule eq_list inputs node_list = + let rec schedule_aux rem_eqs sched_eqs node_list ck costs = + match rem_eqs with + | [] -> sched_eqs + | _ -> + (* First choose the next equation to schedule depending on costs*) + let eq = Cost.next_equation rem_eqs ck costs in + (* remove it from the dependency graph *) + let node_list = remove_eq eq node_list in + (* update the list of equations ready to be scheduled *) + let rem_eqs = free_eqs node_list in + (* compute new costs for the next step *) + let costs = Cost.update_cost eq eq_list costs in + schedule_aux rem_eqs (eq::sched_eqs) node_list (eq_clock eq) costs + in + let costs = Cost.init_cost eq_list inputs in + let rem_eqs = free_eqs node_list in + List.rev (schedule_aux rem_eqs [] node_list Clocks.Cbase costs) + +let schedule_contract c = + c + +let node _ () f = + let contract = optional schedule_contract f.n_contract in + let inputs = List.map (fun vd -> vd.v_ident) (f.n_input@f.n_local) in + let node_list, _ = DataFlowDep.build f.n_equs in + let f = { f with n_equs = schedule f.n_equs inputs node_list; n_contract = contract } in + f, () + +let program p = + let funs = { Mls_mapfold.defaults with Mls_mapfold.node_dec = node } in + let p, () = Mls_mapfold.program_it funs () p in + p