lustrec / src / scheduling.ml @ 45c13277
History  View  Annotate  Download (7.01 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 
In the following functions: 
34 
 [eq_equiv] is the equivalence relation between vars of the same equation lhs 
35 
 [g] the (imperative) graph to be topologically sorted 
36 
 [pending] is the set of unsorted root variables so far, equivalent to the last sorted var 
37 
 [frontier] is the set of unsorted root variables so far, not belonging in [pending] 
38 
 [sort] is the resulting topological order 
39 
*) 
40  
41 
(* Checks whether the currently scheduled variable [choice] 
42 
is an output of a call, possibly among others *) 
43 
let is_call_output choice g = 
44 
List.for_all ExprDep.is_instance_var (IdentDepGraph.succ g choice) 
45  
46 
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv], 
47 
then removes [v] from [g] 
48 
*) 
49 
let add_successors eq_equiv g v pending frontier = 
50 
let succs_v = IdentDepGraph.succ g v in 
51 
begin 
52 
IdentDepGraph.remove_vertex g v; 
53 
List.iter 
54 
(fun v' > 
55 
if is_graph_root v' g then 
56 
(if eq_equiv v v' then 
57 
pending := ISet.add v' !pending 
58 
else 
59 
frontier := ISet.add v' !frontier) 
60 
) succs_v; 
61 
end 
62  
63 
(* Chooses the next var to be sorted, taking priority into account. 
64 
Modifies [pending] and [frontier] accordingly. 
65 
*) 
66 
let next_element eq_equiv g sort call pending frontier = 
67 
begin 
68 
if ISet.is_empty !pending 
69 
then 
70 
begin 
71 
let choice = ISet.min_elt !frontier in 
72 
(*Format.eprintf "1> %s@." choice;*) 
73 
frontier := ISet.remove choice !frontier; 
74 
let (p, f) = ISet.partition (eq_equiv choice) !frontier in 
75 
pending := p; 
76 
frontier := f; 
77 
call := is_call_output choice g; 
78 
add_successors eq_equiv g choice pending frontier; 
79 
if not (ExprDep.is_ghost_var choice) 
80 
then sort := [choice] :: !sort 
81 
end 
82 
else 
83 
begin 
84 
let choice = ISet.min_elt !pending in 
85 
(*Format.eprintf "2> %s@." choice;*) 
86 
pending := ISet.remove choice !pending; 
87 
add_successors eq_equiv g choice pending frontier; 
88 
if not (ExprDep.is_ghost_var choice) 
89 
then sort := (if !call 
90 
then (choice :: List.hd !sort) :: List.tl !sort 
91 
else [choice] :: !sort) 
92 
end 
93 
end 
94  
95  
96 
(* Topological sort of dependency graph [g], with priority. 
97 
*) 
98 
let topological_sort eq_equiv g = 
99 
let roots = graph_roots g in 
100 
assert (roots <> []); 
101 
let call = ref false in 
102 
let frontier = ref (List.fold_right ISet.add roots ISet.empty) in 
103 
let pending = ref ISet.empty in 
104 
let sorted = ref [] in 
105 
begin 
106 
while not (ISet.is_empty !frontier && ISet.is_empty !pending) 
107 
do 
108 
(*Format.eprintf "frontier = {%a}, pending = {%a}@." 
109 
(fun fmt > ISet.iter (fun e > Format.pp_print_string fmt e)) !frontier 
110 
(fun fmt > ISet.iter (fun e > Format.pp_print_string fmt e)) !pending;*) 
111 
next_element eq_equiv g sorted call pending frontier; 
112 
done; 
113 
IdentDepGraph.clear g; 
114 
!sorted 
115 
end 
116  
117 
let schedule_node n = 
118 
try 
119 
let eq_equiv = ExprDep.node_eq_equiv n in 
120 
let eq_equiv v1 v2 = 
121 
try 
122 
Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2 
123 
with Not_found > false in 
124  
125 
let n', g = global_dependency n in 
126 
Log.report ~level:5 
127 
(fun fmt > 
128 
Format.fprintf fmt 
129 
"dependency graph for node %s: %a" 
130 
n'.node_id 
131 
pp_dep_graph g 
132 
); 
133 

134 
(* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs 
135 
compute: coi predecessors of outputs 
136 
warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output) 
137 
DONE ! 
138 
*) 
139  
140 
let gg = IdentDepGraph.copy g in 
141 
let sort = topological_sort eq_equiv g in 
142 
let unused = Liveness.compute_unused_variables n gg in 
143 
let fanin = Liveness.compute_fanin n gg in 
144  
145 
let disjoint = Disjunction.clock_disjoint_map (get_node_vars n) in 
146 

147 
Log.report ~level:2 
148 
(fun fmt > 
149 
Format.fprintf fmt 
150 
"clock disjoint map for node %s: %a" 
151 
n'.node_id 
152 
Disjunction.pp_disjoint_map disjoint 
153 
); 
154  
155 
let reuse = Liveness.compute_reuse_policy n sort disjoint gg in 
156 
Log.report ~level:2 
157 
(fun fmt > 
158 
Format.fprintf fmt 
159 
"reuse policy for node %s: %a" 
160 
n'.node_id 
161 
Liveness.pp_reuse_policy reuse 
162 
); 
163 

164 
n', { schedule = sort; unused_vars = unused; fanin_table = fanin; reuse_table = reuse } 
165 
with (Causality.Cycle v) as exc > 
166 
pp_error Format.err_formatter v; 
167 
raise exc 
168  
169 
let schedule_prog prog = 
170 
List.fold_right ( 
171 
fun top_decl (accu_prog, sch_map) > 
172 
match top_decl.top_decl_desc with 
173 
 Node nd > 
174 
let nd', report = schedule_node nd in 
175 
{top_decl with top_decl_desc = Node nd'}::accu_prog, 
176 
IMap.add nd.node_id report sch_map 
177 
 _ > top_decl::accu_prog, sch_map 
178 
) 
179 
prog 
180 
([],IMap.empty) 
181  
182 
let pp_eq_schedule fmt vl = 
183 
match vl with 
184 
 [] > assert false 
185 
 [v] > Format.fprintf fmt "%s" v 
186 
 _ > Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v > Format.fprintf fmt "%s" v)) vl 
187 

188 
let pp_schedule fmt node_schs = 
189 
IMap.iter 
190 
(fun nd report > 
191 
Format.fprintf fmt "%s schedule: %a@." 
192 
nd 
193 
(fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule) 
194 
node_schs 
195  
196 
let pp_fanin_table fmt node_schs = 
197 
IMap.iter 
198 
(fun nd report > 
199 
Format.fprintf fmt "%s : %a" nd Liveness.pp_fanin report.fanin_table) 
200 
node_schs 
201  
202 
let pp_warning_unused fmt node_schs = 
203 
IMap.iter 
204 
(fun nd report > 
205 
let unused = report.unused_vars in 
206 
if not (ISet.is_empty unused) 
207 
then 
208 
let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd > nd  _ > assert false in 
209 
ISet.iter 
210 
(fun u > 
211 
Format.fprintf fmt "Warning: variable '%s' seems unused@.%a@." 
212 
u 
213 
Location.pp_loc (get_node_var u nd).var_loc) 
214 
unused 
215 
) 
216 
node_schs 
217  
218 
(* Local Variables: *) 
219 
(* compilecommand:"make C .." *) 
220 
(* End: *) 