lustrec / src / scheduling.ml @ ef8a361a
History  View  Annotate  Download (9.1 KB)
1 
(********************************************************************) 

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  
12 
open Utils 
13 
open LustreSpec 
14 
open Corelang 
15 
open Graph 
16 
open Causality 
17  
18 
type schedule_report = 
19 
{ 
20 
(* the scheduled node *) 
21 
node : node_desc; 
22 
(* a schedule computed wrt the dependency graph *) 
23 
schedule : ident list list; 
24 
(* the set of unused variables (no output or mem depends on them) *) 
25 
unused_vars : ISet.t; 
26 
(* the table mapping each local var to its indegree *) 
27 
fanin_table : (ident, int) Hashtbl.t; 
28 
(* the dependency graph *) 
29 
dep_graph : IdentDepGraph.t; 
30 
(* the table mapping each assignment to a reusable variable *) 
31 
(*reuse_table : (ident, var_decl) Hashtbl.t*) 
32 
} 
33  
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 
Moreover, the dependency graph is browsed in a depthfirst manner whenever possible, 
38 
to improve the behavior of optimization algorithms applied in forthcoming compilation steps. 
39 
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  
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 
List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice) 
51  
52 
(* 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 
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 
end 
68  
69 
(* Chooses the next var to be sorted, taking priority into account. 
70 
Modifies [pending] and [frontier] accordingly. 
71 
*) 
72 
let next_element eq_equiv g sort call pending frontier = 
73 
begin 
74 
if ISet.is_empty !pending 
75 
then 
76 
begin 
77 
let choice = ISet.min_elt !frontier in 
78 
(*Format.eprintf "1> %s@." choice;*) 
79 
frontier := ISet.remove choice !frontier; 
80 
let (p, f) = ISet.partition (eq_equiv choice) !frontier in 
81 
pending := p; 
82 
frontier := f; 
83 
call := is_call_output choice g; 
84 
add_successors eq_equiv g choice pending frontier; 
85 
if not (ExprDep.is_ghost_var choice) 
86 
then sort := [choice] :: !sort 
87 
end 
88 
else 
89 
begin 
90 
let choice = ISet.min_elt !pending in 
91 
(*Format.eprintf "2> %s@." choice;*) 
92 
pending := ISet.remove choice !pending; 
93 
add_successors eq_equiv g choice pending frontier; 
94 
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 
end 
99 
end 
100  
101  
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 
let call = ref false in 
108 
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 
next_element eq_equiv g sorted call pending frontier; 
118 
done; 
119 
IdentDepGraph.clear g; 
120 
!sorted 
121 
end 
122  
123 
(* 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 
let schedule_node n = 
132 
(* let node_vars = get_node_vars n in *) 
133 
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  
140 
let n', g = global_dependency n in 
141 

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 
DONE ! 
146 
*) 
147  
148 
let gg = IdentDepGraph.copy g in 
149 
let sort = topological_sort eq_equiv g in 
150 
let unused = Liveness.compute_unused_variables n gg in 
151 
let fanin = Liveness.compute_fanin n gg in 
152 
{ node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; } 
153  
154 
with (Causality.Error err) as exc > 
155 
match err with 
156 
 DataCycle vl > 
157 
let _ (*vl*) = filter_original n vl in 
158 
Causality.pp_error Format.err_formatter err; 
159 
raise exc 
160 
 _ > raise exc 
161  
162 
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 
if !Options.print_reuse 
167 
then 
168 
begin 
169 
Log.report ~level:0 
170 
(fun fmt > 
171 
Format.fprintf fmt 
172 
"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 
"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 
*) 
190 
reuse 
191  
192  
193 
let schedule_prog prog = 
194 
List.fold_right ( 
195 
fun top_decl (accu_prog, sch_map) > 
196 
match top_decl.top_decl_desc with 
197 
 Node nd > 
198 
let report = schedule_node nd in 
199 
{top_decl with top_decl_desc = Node report.node}::accu_prog, 
200 
IMap.add nd.node_id report sch_map 
201 
 _ > top_decl::accu_prog, sch_map 
202 
) 
203 
prog 
204 
([],IMap.empty) 
205 

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  
228 
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 
let pp_schedule fmt node_schs = 
235 
IMap.iter 
236 
(fun nd report > 
237 
Format.fprintf fmt "%s schedule: %a@." 
238 
nd 
239 
(fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule) 
240 
node_schs 
241  
242 
let pp_fanin_table fmt node_schs = 
243 
IMap.iter 
244 
(fun nd report > 
245 
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 
node_schs 
253  
254 
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 
(fun u > 
263 
let vu = get_node_var u nd in 
264 
if vu.var_orig 
265 
then Format.fprintf fmt " Warning: variable '%s' seems unused@, %a@,@," u Location.pp_loc vu.var_loc) 
266 
unused 
267 
) 
268 
node_schs 
269  
270  
271 
(* Local Variables: *) 
272 
(* compilecommand:"make C .." *) 
273 
(* End: *) 