lustrec / src / scheduling.ml @ 01c7d5e1
History  View  Annotate  Download (7.08 KB)
1 
(*  

2 
* SchedMCore  A MultiCore Scheduling Framework 
3 
* Copyright (C) 20092013, ONERA, Toulouse, FRANCE  LIFL, Lille, FRANCE 
4 
* Copyright (C) 20122013, INPT, Toulouse, FRANCE 
5 
* 
6 
* This file is part of Prelude 
7 
* 
8 
* Prelude is free software; you can redistribute it and/or 
9 
* modify it under the terms of the GNU Lesser General Public License 
10 
* as published by the Free Software Foundation ; either version 2 of 
11 
* the License, or (at your option) any later version. 
12 
* 
13 
* Prelude is distributed in the hope that it will be useful, but 
14 
* WITHOUT ANY WARRANTY ; without even the implied warranty of 
15 
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 
16 
* Lesser General Public License for more details. 
17 
* 
18 
* You should have received a copy of the GNU Lesser General Public 
19 
* License along with this program ; if not, write to the Free Software 
20 
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 021111307 
21 
* USA 
22 
* *) 
23  
24 
(* This module is used for the lustre to C compiler *) 
25  
26 
open Utils 
27 
open LustreSpec 
28 
open Corelang 
29 
open Graph 
30 
open Causality 
31  
32 
type schedule_report = 
33 
{ 
34 
(* a schedule computed wrt the dependency graph *) 
35 
schedule : ident list; 
36 
(* the set of unused variables (no output or mem depends on them) *) 
37 
unused_vars : ISet.t; 
38 
(* the table mapping each local var to its indegree *) 
39 
fanin_table : (ident, int) Hashtbl.t; 
40 
(* the table mapping each assignment to a set of dead/reusable variables *) 
41 
death_table : (ident, ISet.t) Hashtbl.t 
42 
} 
43  
44 
(* Topological sort with a priority for variables belonging in the same equation lhs. 
45 
For variables still unrelated, standard compare is used to choose the minimal element. 
46 
This priority is used since it helps a lot in factorizing generated code. 
47 
In the following functions: 
48 
 [eq_equiv] is the equivalence relation between vars of the same equation lhs 
49 
 [g] the (imperative) graph to be topologically sorted 
50 
 [pending] is the set of unsorted root variables so far, equivalent to the last sorted var 
51 
 [frontier] is the set of unsorted root variables so far, not belonging in [pending] 
52 
 [sort] is the resulting topological order 
53 
*) 
54 
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv], 
55 
then removes [v] from [g] 
56 
*) 
57 
let add_successors eq_equiv g v pending frontier = 
58 
let succs_v = IdentDepGraph.succ g v in 
59 
begin 
60 
IdentDepGraph.remove_vertex g v; 
61 
List.iter 
62 
(fun v' > 
63 
if is_graph_root v' g then 
64 
(if eq_equiv v v' then 
65 
pending := ISet.add v' !pending 
66 
else 
67 
frontier := ISet.add v' !frontier) 
68 
) succs_v; 
69 
end 
70  
71 
(* Chooses the next var to be sorted, taking priority into account. 
72 
Modifies [pending] and [frontier] accordingly. 
73 
*) 
74 
let next_element eq_equiv g sort pending frontier = 
75 
begin 
76 
if ISet.is_empty !pending 
77 
then 
78 
begin 
79 
let choice = ISet.min_elt !frontier in 
80 
(*Format.eprintf "1> %s@." choice;*) 
81 
frontier := ISet.remove choice !frontier; 
82 
let (p, f) = ISet.partition (eq_equiv choice) !frontier in 
83 
pending := p; 
84 
frontier := f; 
85 
add_successors eq_equiv g choice pending frontier; 
86 
if not (ExprDep.is_ghost_var choice) 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) then sort := choice :: !sort 
95 
end 
96 
end 
97  
98  
99 
(* Topological sort of dependency graph [g], with priority. 
100 
*) 
101 
let topological_sort eq_equiv g = 
102 
let roots = graph_roots g in 
103 
assert (roots <> []); 
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 pending frontier; 
114 
done; 
115 
IdentDepGraph.clear g; 
116 
!sorted 
117 
end 
118  
119 
let schedule_node n = 
120 
try 
121 
let eq_equiv = ExprDep.node_eq_equiv n in 
122 
let eq_equiv v1 v2 = 
123 
try 
124 
Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2 
125 
with Not_found > false in 
126  
127 
let n', g = global_dependency n in 
128 
Log.report ~level:5 
129 
(fun fmt > 
130 
Format.eprintf 
131 
"dependency graph for node %s: %a" 
132 
n'.node_id 
133 
pp_dep_graph g 
134 
); 
135 

136 
(* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs 
137 
compute: coi predecessors of outputs 
138 
warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output) 
139 
DONE ! 
140 
*) 
141  
142 
let gg = IdentDepGraph.copy g in 
143 
let sort = topological_sort eq_equiv g in 
144 
let unused = Liveness.compute_unused n gg in 
145 
let fanin = Liveness.compute_fanin n gg in 
146 
let death = Liveness.death_table n gg sort in 
147 
Log.report ~level:5 
148 
(fun fmt > 
149 
Format.eprintf 
150 
"death table for node %s: %a" 
151 
n'.node_id 
152 
Liveness.pp_death_table death 
153 
); 
154  
155 
let disjoint = Disjunction.clock_disjoint_map (get_node_vars n) in 
156 

157 
Log.report ~level:5 
158 
(fun fmt > 
159 
Format.eprintf 
160 
"clock disjoint map for node %s: %a" 
161 
n'.node_id 
162 
Disjunction.pp_disjoint_map disjoint 
163 
); 
164  
165 
let reuse = Liveness.reuse_policy n sort death in 
166 
Log.report ~level:5 
167 
(fun fmt > 
168 
Format.eprintf 
169 
"reuse policy for node %s: %a" 
170 
n'.node_id 
171 
Liveness.pp_reuse_policy reuse 
172 
); 
173 

174 
n', { schedule = sort; unused_vars = unused; fanin_table = fanin; death_table = death } 
175 
with (Causality.Cycle v) as exc > 
176 
pp_error Format.err_formatter v; 
177 
raise exc 
178  
179 
let schedule_prog prog = 
180 
List.fold_right ( 
181 
fun top_decl (accu_prog, sch_map) > 
182 
match top_decl.top_decl_desc with 
183 
 Node nd > 
184 
let nd', report = schedule_node nd in 
185 
{top_decl with top_decl_desc = Node nd'}::accu_prog, 
186 
IMap.add nd.node_id report sch_map 
187 
 _ > top_decl::accu_prog, sch_map 
188 
) 
189 
prog 
190 
([],IMap.empty) 
191  
192 
let pp_schedule fmt node_schs = 
193 
IMap.iter 
194 
(fun nd report > 
195 
Format.fprintf fmt "%s schedule: %a@." 
196 
nd 
197 
(fprintf_list ~sep:" ; " (fun fmt v > Format.fprintf fmt "%s" v)) report.schedule) 
198 
node_schs 
199  
200 
let pp_fanin_table fmt node_schs = 
201 
IMap.iter 
202 
(fun nd report > 
203 
Format.fprintf fmt "%s : %a" nd Liveness.pp_fanin report.fanin_table) 
204 
node_schs 
205  
206 
let pp_warning_unused fmt node_schs = 
207 
IMap.iter 
208 
(fun nd report > 
209 
let unused = report.unused_vars in 
210 
if not (ISet.is_empty unused) 
211 
then 
212 
let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd > nd  _ > assert false in 
213 
ISet.iter 
214 
(fun u > 
215 
Format.fprintf fmt "Warning: variable '%s' seems unused@.%a@." 
216 
u 
217 
Location.pp_loc (get_node_var u nd).var_loc) 
218 
unused 
219 
) 
220 
node_schs 
221  
222 
(* Local Variables: *) 
223 
(* compilecommand:"make C .." *) 
224 
(* End: *) 