lustrec / src / scheduling.ml @ c825868a
History  View  Annotate  Download (7.85 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 
(* a schedule computed wrt the dependency graph *) 
21 
schedule : ident list list; 
22 
(* the set of unused variables (no output or mem depends on them) *) 
23 
unused_vars : ISet.t; 
24 
(* the table mapping each local var to its indegree *) 
25 
fanin_table : (ident, int) Hashtbl.t; 
26 
(* the table mapping each assignment to a reusable variable *) 
27 
reuse_table : (ident, var_decl) Hashtbl.t 
28 
} 
29  
30 
(* Topological sort with a priority for variables belonging in the same equation lhs. 
31 
For variables still unrelated, standard compare is used to choose the minimal element. 
32 
This priority is used since it helps a lot in factorizing generated code. 
33 
Moreover, the dependency graph is browsed in a depthfirst manner whenever possible, 
34 
to improve the behavior of optimization algorithms applied in forthcoming compilation steps. 
35 
In the following functions: 
36 
 [eq_equiv] is the equivalence relation between vars of the same equation lhs 
37 
 [g] the (imperative) graph to be topologically sorted 
38 
 [pending] is the set of unsorted root variables so far, equivalent to the last sorted var 
39 
 [frontier] is the set of unsorted root variables so far, not belonging in [pending] 
40 
 [sort] is the resulting topological order 
41 
*) 
42  
43 
(* Checks whether the currently scheduled variable [choice] 
44 
is an output of a call, possibly among others *) 
45 
let is_call_output choice g = 
46 
List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice) 
47  
48 
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv], 
49 
then removes [v] from [g] 
50 
*) 
51 
let add_successors eq_equiv g v pending frontier = 
52 
let succs_v = IdentDepGraph.succ g v in 
53 
begin 
54 
IdentDepGraph.remove_vertex g v; 
55 
List.iter 
56 
(fun v' > 
57 
if is_graph_root v' g then 
58 
(if eq_equiv v v' then 
59 
pending := ISet.add v' !pending 
60 
else 
61 
frontier := ISet.add v' !frontier) 
62 
) succs_v; 
63 
end 
64  
65 
(* Chooses the next var to be sorted, taking priority into account. 
66 
Modifies [pending] and [frontier] accordingly. 
67 
*) 
68 
let next_element eq_equiv g sort call pending frontier = 
69 
begin 
70 
if ISet.is_empty !pending 
71 
then 
72 
begin 
73 
let choice = ISet.min_elt !frontier in 
74 
(*Format.eprintf "1> %s@." choice;*) 
75 
frontier := ISet.remove choice !frontier; 
76 
let (p, f) = ISet.partition (eq_equiv choice) !frontier in 
77 
pending := p; 
78 
frontier := f; 
79 
call := is_call_output choice g; 
80 
add_successors eq_equiv g choice pending frontier; 
81 
if not (ExprDep.is_ghost_var choice) 
82 
then sort := [choice] :: !sort 
83 
end 
84 
else 
85 
begin 
86 
let choice = ISet.min_elt !pending in 
87 
(*Format.eprintf "2> %s@." choice;*) 
88 
pending := ISet.remove choice !pending; 
89 
add_successors eq_equiv g choice pending frontier; 
90 
if not (ExprDep.is_ghost_var choice) 
91 
then sort := (if !call 
92 
then (choice :: List.hd !sort) :: List.tl !sort 
93 
else [choice] :: !sort) 
94 
end 
95 
end 
96  
97  
98 
(* Topological sort of dependency graph [g], with priority. 
99 
*) 
100 
let topological_sort eq_equiv g = 
101 
let roots = graph_roots g in 
102 
assert (roots <> []); 
103 
let call = ref false in 
104 
let frontier = ref (List.fold_right ISet.add roots ISet.empty) in 
105 
let pending = ref ISet.empty in 
106 
let sorted = ref [] in 
107 
begin 
108 
while not (ISet.is_empty !frontier && ISet.is_empty !pending) 
109 
do 
110 
(*Format.eprintf "frontier = {%a}, pending = {%a}@." 
111 
(fun fmt > ISet.iter (fun e > Format.pp_print_string fmt e)) !frontier 
112 
(fun fmt > ISet.iter (fun e > Format.pp_print_string fmt e)) !pending;*) 
113 
next_element eq_equiv g sorted call pending frontier; 
114 
done; 
115 
IdentDepGraph.clear g; 
116 
!sorted 
117 
end 
118  
119 
(* Filters out normalization variables and renames instance variables to keep things readable, 
120 
in a case of a dependency error *) 
121 
let filter_original n vl = 
122 
List.fold_right (fun v res > 
123 
if ExprDep.is_instance_var v then Format.sprintf "node %s" (ExprDep.undo_instance_var v) :: res else 
124 
let vdecl = get_node_var v n in 
125 
if vdecl.var_orig then v :: res else res) vl [] 
126  
127 
let schedule_node n = 
128 
let node_vars = get_node_vars n in 
129 
try 
130 
let eq_equiv = ExprDep.node_eq_equiv n in 
131 
let eq_equiv v1 v2 = 
132 
try 
133 
Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2 
134 
with Not_found > false in 
135  
136 
let n', g = global_dependency n in 
137 
Log.report ~level:5 
138 
(fun fmt > 
139 
Format.fprintf fmt 
140 
"dependency graph for node %s: %a" 
141 
n'.node_id 
142 
pp_dep_graph g 
143 
); 
144 

145 
(* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs 
146 
compute: coi predecessors of outputs 
147 
warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output) 
148 
DONE ! 
149 
*) 
150  
151 
let gg = IdentDepGraph.copy g in 
152 
let sort = topological_sort eq_equiv g in 
153 
let unused = Liveness.compute_unused_variables n gg in 
154 
let fanin = Liveness.compute_fanin n gg in 
155 

156 
let (disjoint, reuse) = 
157 
if !Options.optimization >= 3 
158 
then 
159 
let disjoint = Disjunction.clock_disjoint_map node_vars in 
160 
(disjoint, 
161 
Liveness.compute_reuse_policy n sort disjoint gg) 
162 
else 
163 
(Hashtbl.create 1, 
164 
Hashtbl.create 1) 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:clock disjoint map for node %s: %a" 
173 
n'.node_id 
174 
Disjunction.pp_disjoint_map disjoint 
175 
); 
176 
Log.report ~level:0 
177 
(fun fmt > 
178 
Format.fprintf fmt 
179 
"OPT:reuse policy for node %s: %a" 
180 
n'.node_id 
181 
Liveness.pp_reuse_policy reuse 
182 
); 
183 
end; 
184 
n', { schedule = sort; unused_vars = unused; fanin_table = fanin; reuse_table = reuse } 
185 
with (Causality.Cycle vl) as exc > 
186 
let vl = filter_original n vl in 
187 
pp_error Format.err_formatter vl; 
188 
raise exc 
189  
190 
let schedule_prog prog = 
191 
List.fold_right ( 
192 
fun top_decl (accu_prog, sch_map) > 
193 
match top_decl.top_decl_desc with 
194 
 Node nd > 
195 
let nd', report = schedule_node nd in 
196 
{top_decl with top_decl_desc = Node nd'}::accu_prog, 
197 
IMap.add nd.node_id report sch_map 
198 
 _ > top_decl::accu_prog, sch_map 
199 
) 
200 
prog 
201 
([],IMap.empty) 
202  
203 
let pp_eq_schedule fmt vl = 
204 
match vl with 
205 
 [] > assert false 
206 
 [v] > Format.fprintf fmt "%s" v 
207 
 _ > Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v > Format.fprintf fmt "%s" v)) vl 
208 

209 
let pp_schedule fmt node_schs = 
210 
IMap.iter 
211 
(fun nd report > 
212 
Format.fprintf fmt "%s schedule: %a@." 
213 
nd 
214 
(fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule) 
215 
node_schs 
216  
217 
let pp_fanin_table fmt node_schs = 
218 
IMap.iter 
219 
(fun nd report > 
220 
Format.fprintf fmt "%s : %a" nd Liveness.pp_fanin report.fanin_table) 
221 
node_schs 
222  
223 
let pp_warning_unused fmt node_schs = 
224 
IMap.iter 
225 
(fun nd report > 
226 
let unused = report.unused_vars in 
227 
if not (ISet.is_empty unused) 
228 
then 
229 
let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd > nd  _ > assert false in 
230 
ISet.iter 
231 
(fun u > 
232 
let vu = get_node_var u nd in 
233 
if vu.var_orig 
234 
then Format.fprintf fmt "Warning: variable '%s' seems unused@.%a@." u Location.pp_loc vu.var_loc) 
235 
unused 
236 
) 
237 
node_schs 
238  
239 
(* Local Variables: *) 
240 
(* compilecommand:"make C .." *) 
241 
(* End: *) 