lustrec / src / scheduling.ml @ ef8a361a
History | View | Annotate | Download (9.1 KB)
1 | a2d97a3e | ploc | (********************************************************************) |
---|---|---|---|
2 | (* *) |
||
3 | (* The LustreC compiler toolset / The LustreC Development Team *) |
||
4 | (* Copyright 2012 - -- ONERA - CNRS - INPT *) |
||
5 | (* *) |
||
6 | (* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |
||
7 | (* under the terms of the GNU Lesser General Public License *) |
||
8 | (* version 2.1. *) |
||
9 | (* *) |
||
10 | (********************************************************************) |
||
11 | 22fe1c93 | ploc | |
12 | open Utils |
||
13 | 8ea13d96 | xthirioux | open LustreSpec |
14 | 22fe1c93 | ploc | open Corelang |
15 | open Graph |
||
16 | open Causality |
||
17 | |||
18 | 3bfed7f9 | xthirioux | type schedule_report = |
19 | { |
||
20 | 04a63d25 | xthirioux | (* the scheduled node *) |
21 | node : node_desc; |
||
22 | 8a183477 | xthirioux | (* a schedule computed wrt the dependency graph *) |
23 | a38c681e | xthirioux | schedule : ident list list; |
24 | 8a183477 | xthirioux | (* the set of unused variables (no output or mem depends on them) *) |
25 | 3bfed7f9 | xthirioux | unused_vars : ISet.t; |
26 | 8a183477 | xthirioux | (* the table mapping each local var to its in-degree *) |
27 | fanin_table : (ident, int) Hashtbl.t; |
||
28 | 04a63d25 | xthirioux | (* the dependency graph *) |
29 | dep_graph : IdentDepGraph.t; |
||
30 | bb2ca5f4 | xthirioux | (* the table mapping each assignment to a reusable variable *) |
31 | 04a63d25 | xthirioux | (*reuse_table : (ident, var_decl) Hashtbl.t*) |
32 | 3bfed7f9 | xthirioux | } |
33 | 22fe1c93 | ploc | |
34 | (* Topological sort with a priority for variables belonging in the same equation lhs. |
||
35 | For variables still unrelated, standard compare is used to choose the minimal element. |
||
36 | This priority is used since it helps a lot in factorizing generated code. |
||
37 | b1655a21 | xthirioux | Moreover, the dependency graph is browsed in a depth-first manner whenever possible, |
38 | to improve the behavior of optimization algorithms applied in forthcoming compilation steps. |
||
39 | 22fe1c93 | ploc | In the following functions: |
40 | - [eq_equiv] is the equivalence relation between vars of the same equation lhs |
||
41 | - [g] the (imperative) graph to be topologically sorted |
||
42 | - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var |
||
43 | - [frontier] is the set of unsorted root variables so far, not belonging in [pending] |
||
44 | - [sort] is the resulting topological order |
||
45 | *) |
||
46 | a38c681e | xthirioux | |
47 | (* Checks whether the currently scheduled variable [choice] |
||
48 | is an output of a call, possibly among others *) |
||
49 | let is_call_output choice g = |
||
50 | 04d15b97 | xthirioux | List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice) |
51 | a38c681e | xthirioux | |
52 | 22fe1c93 | ploc | (* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv], |
53 | then removes [v] from [g] |
||
54 | *) |
||
55 | let add_successors eq_equiv g v pending frontier = |
||
56 | let succs_v = IdentDepGraph.succ g v in |
||
57 | begin |
||
58 | IdentDepGraph.remove_vertex g v; |
||
59 | b84a138e | ploc | List.iter |
60 | (fun v' -> |
||
61 | if is_graph_root v' g then |
||
62 | (if eq_equiv v v' then |
||
63 | pending := ISet.add v' !pending |
||
64 | else |
||
65 | frontier := ISet.add v' !frontier) |
||
66 | ) succs_v; |
||
67 | 22fe1c93 | ploc | end |
68 | |||
69 | (* Chooses the next var to be sorted, taking priority into account. |
||
70 | Modifies [pending] and [frontier] accordingly. |
||
71 | *) |
||
72 | a38c681e | xthirioux | let next_element eq_equiv g sort call pending frontier = |
73 | 8ea13d96 | xthirioux | begin |
74 | if ISet.is_empty !pending |
||
75 | then |
||
76 | begin |
||
77 | let choice = ISet.min_elt !frontier in |
||
78 | 22fe1c93 | ploc | (*Format.eprintf "-1-> %s@." choice;*) |
79 | 8ea13d96 | xthirioux | frontier := ISet.remove choice !frontier; |
80 | let (p, f) = ISet.partition (eq_equiv choice) !frontier in |
||
81 | pending := p; |
||
82 | frontier := f; |
||
83 | a38c681e | xthirioux | call := is_call_output choice g; |
84 | 8ea13d96 | xthirioux | add_successors eq_equiv g choice pending frontier; |
85 | a38c681e | xthirioux | if not (ExprDep.is_ghost_var choice) |
86 | then sort := [choice] :: !sort |
||
87 | 8ea13d96 | xthirioux | end |
88 | else |
||
89 | begin |
||
90 | let choice = ISet.min_elt !pending in |
||
91 | 22fe1c93 | ploc | (*Format.eprintf "-2-> %s@." choice;*) |
92 | 8ea13d96 | xthirioux | pending := ISet.remove choice !pending; |
93 | add_successors eq_equiv g choice pending frontier; |
||
94 | a38c681e | xthirioux | if not (ExprDep.is_ghost_var choice) |
95 | then sort := (if !call |
||
96 | then (choice :: List.hd !sort) :: List.tl !sort |
||
97 | else [choice] :: !sort) |
||
98 | 8ea13d96 | xthirioux | end |
99 | end |
||
100 | |||
101 | 22fe1c93 | ploc | |
102 | (* Topological sort of dependency graph [g], with priority. |
||
103 | *) |
||
104 | let topological_sort eq_equiv g = |
||
105 | let roots = graph_roots g in |
||
106 | assert (roots <> []); |
||
107 | a38c681e | xthirioux | let call = ref false in |
108 | 22fe1c93 | ploc | let frontier = ref (List.fold_right ISet.add roots ISet.empty) in |
109 | let pending = ref ISet.empty in |
||
110 | let sorted = ref [] in |
||
111 | begin |
||
112 | while not (ISet.is_empty !frontier && ISet.is_empty !pending) |
||
113 | do |
||
114 | (*Format.eprintf "frontier = {%a}, pending = {%a}@." |
||
115 | (fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier |
||
116 | (fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*) |
||
117 | a38c681e | xthirioux | next_element eq_equiv g sorted call pending frontier; |
118 | 22fe1c93 | ploc | done; |
119 | 8ea13d96 | xthirioux | IdentDepGraph.clear g; |
120 | 22fe1c93 | ploc | !sorted |
121 | end |
||
122 | |||
123 | 54d032f5 | xthirioux | (* Filters out normalization variables and renames instance variables to keep things readable, |
124 | in a case of a dependency error *) |
||
125 | let filter_original n vl = |
||
126 | List.fold_right (fun v res -> |
||
127 | if ExprDep.is_instance_var v then Format.sprintf "node %s" (ExprDep.undo_instance_var v) :: res else |
||
128 | let vdecl = get_node_var v n in |
||
129 | if vdecl.var_orig then v :: res else res) vl [] |
||
130 | |||
131 | 7afcba5a | xthirioux | let schedule_node n = |
132 | 04a63d25 | xthirioux | (* let node_vars = get_node_vars n in *) |
133 | 22fe1c93 | ploc | try |
134 | let eq_equiv = ExprDep.node_eq_equiv n in |
||
135 | let eq_equiv v1 v2 = |
||
136 | try |
||
137 | Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2 |
||
138 | with Not_found -> false in |
||
139 | cd670fe1 | ploc | |
140 | 22fe1c93 | ploc | let n', g = global_dependency n in |
141 | 0e1049dc | xthirioux | |
142 | (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs |
||
143 | compute: coi predecessors of outputs |
||
144 | warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output) |
||
145 | 8a183477 | xthirioux | DONE ! |
146 | 0e1049dc | xthirioux | *) |
147 | |||
148 | a5784e75 | xthirioux | let gg = IdentDepGraph.copy g in |
149 | d4807c3d | xthirioux | let sort = topological_sort eq_equiv g in |
150 | b6a94a4e | xthirioux | let unused = Liveness.compute_unused_variables n gg in |
151 | 8a183477 | xthirioux | let fanin = Liveness.compute_fanin n gg in |
152 | 04a63d25 | xthirioux | { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; } |
153 | ec433d69 | xthirioux | |
154 | eb837d74 | xthirioux | with (Causality.Error err) as exc -> |
155 | match err with |
||
156 | | DataCycle vl -> |
||
157 | dcafc99b | Ploc | let _ (*vl*) = filter_original n vl in |
158 | eb837d74 | xthirioux | Causality.pp_error Format.err_formatter err; |
159 | raise exc |
||
160 | | _ -> raise exc |
||
161 | b1a97ade | xthirioux | |
162 | 04a63d25 | xthirioux | let compute_node_reuse_table report = |
163 | let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in |
||
164 | let reuse = Liveness.compute_reuse_policy report.node report.schedule disjoint report.dep_graph in |
||
165 | (* |
||
166 | 89a70069 | xthirioux | if !Options.print_reuse |
167 | then |
||
168 | begin |
||
169 | Log.report ~level:0 |
||
170 | (fun fmt -> |
||
171 | Format.fprintf fmt |
||
172 | 790765c0 | xthirioux | "OPT:%B@." (try (Hashtbl.iter (fun s1 v2 -> if s1 = v2.var_id then raise Not_found) reuse; false) with Not_found -> true) |
173 | ); |
||
174 | Log.report ~level:0 |
||
175 | (fun fmt -> |
||
176 | Format.fprintf fmt |
||
177 | 89a70069 | xthirioux | "OPT:clock disjoint map for node %s: %a" |
178 | n'.node_id |
||
179 | Disjunction.pp_disjoint_map disjoint |
||
180 | ); |
||
181 | Log.report ~level:0 |
||
182 | (fun fmt -> |
||
183 | Format.fprintf fmt |
||
184 | "OPT:reuse policy for node %s: %a" |
||
185 | n'.node_id |
||
186 | Liveness.pp_reuse_policy reuse |
||
187 | ); |
||
188 | end; |
||
189 | 04a63d25 | xthirioux | *) |
190 | reuse |
||
191 | |||
192 | 22fe1c93 | ploc | |
193 | 88486aaf | ploc | let schedule_prog prog = |
194 | List.fold_right ( |
||
195 | 3bfed7f9 | xthirioux | fun top_decl (accu_prog, sch_map) -> |
196 | 88486aaf | ploc | match top_decl.top_decl_desc with |
197 | | Node nd -> |
||
198 | 04a63d25 | xthirioux | let report = schedule_node nd in |
199 | {top_decl with top_decl_desc = Node report.node}::accu_prog, |
||
200 | 3bfed7f9 | xthirioux | IMap.add nd.node_id report sch_map |
201 | | _ -> top_decl::accu_prog, sch_map |
||
202 | 88486aaf | ploc | ) |
203 | prog |
||
204 | 3bfed7f9 | xthirioux | ([],IMap.empty) |
205 | 04a63d25 | xthirioux | |
206 | |||
207 | let compute_prog_reuse_table report = |
||
208 | IMap.map compute_node_reuse_table report |
||
209 | |||
210 | (* removes inlined local variables from schedule report, |
||
211 | which are now useless *) |
||
212 | let remove_node_inlined_locals locals report = |
||
213 | let is_inlined v = IMap.exists (fun l _ -> v = l) locals in |
||
214 | let schedule' = |
||
215 | List.fold_right (fun heads q -> let heads' = List.filter (fun v -> not (is_inlined v)) heads |
||
216 | in if heads' = [] then q else heads'::q) |
||
217 | report.schedule [] in |
||
218 | begin |
||
219 | IMap.iter (fun v _ -> Hashtbl.remove report.fanin_table v) locals; |
||
220 | IMap.iter (fun v _ -> let iv = ExprDep.mk_instance_var v |
||
221 | in Liveness.replace_in_dep_graph v iv report.dep_graph) locals; |
||
222 | { report with schedule = schedule' } |
||
223 | end |
||
224 | |||
225 | let remove_prog_inlined_locals removed reuse = |
||
226 | IMap.mapi (fun id -> remove_node_inlined_locals (IMap.find id removed)) reuse |
||
227 | 3bfed7f9 | xthirioux | |
228 | a38c681e | xthirioux | let pp_eq_schedule fmt vl = |
229 | match vl with |
||
230 | | [] -> assert false |
||
231 | | [v] -> Format.fprintf fmt "%s" v |
||
232 | | _ -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl |
||
233 | |||
234 | 8a183477 | xthirioux | let pp_schedule fmt node_schs = |
235 | IMap.iter |
||
236 | (fun nd report -> |
||
237 | Format.fprintf fmt "%s schedule: %a@." |
||
238 | nd |
||
239 | a38c681e | xthirioux | (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule) |
240 | 8a183477 | xthirioux | node_schs |
241 | |||
242 | let pp_fanin_table fmt node_schs = |
||
243 | IMap.iter |
||
244 | (fun nd report -> |
||
245 | 04a63d25 | xthirioux | Format.fprintf fmt "%s: %a" nd Liveness.pp_fanin report.fanin_table) |
246 | node_schs |
||
247 | |||
248 | let pp_dep_graph fmt node_schs = |
||
249 | IMap.iter |
||
250 | (fun nd report -> |
||
251 | Format.fprintf fmt "%s dependency graph: %a" nd pp_dep_graph report.dep_graph) |
||
252 | 8a183477 | xthirioux | node_schs |
253 | |||
254 | 3bfed7f9 | xthirioux | let pp_warning_unused fmt node_schs = |
255 | IMap.iter |
||
256 | (fun nd report -> |
||
257 | let unused = report.unused_vars in |
||
258 | if not (ISet.is_empty unused) |
||
259 | then |
||
260 | let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in |
||
261 | ISet.iter |
||
262 | df39e35a | xthirioux | (fun u -> |
263 | let vu = get_node_var u nd in |
||
264 | if vu.var_orig |
||
265 | 04a63d25 | xthirioux | then Format.fprintf fmt " Warning: variable '%s' seems unused@, %a@,@," u Location.pp_loc vu.var_loc) |
266 | 3bfed7f9 | xthirioux | unused |
267 | ) |
||
268 | node_schs |
||
269 | 22fe1c93 | ploc | |
270 | 04a63d25 | xthirioux | |
271 | 22fe1c93 | ploc | (* Local Variables: *) |
272 | (* compile-command:"make -C .." *) |
||
273 | (* End: *) |