lustrec / src / scheduling.ml @ a38c681e
History  View  Annotate  Download (7.47 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 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 reusable variable *) 
41 
reuse_table : (ident, var_decl) 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  
55 
(* Checks whether the currently scheduled variable [choice] 
56 
is an output of a call, possibly among others *) 
57 
let is_call_output choice g = 
58 
List.for_all ExprDep.is_instance_var (IdentDepGraph.succ g choice) 
59  
60 
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv], 
61 
then removes [v] from [g] 
62 
*) 
63 
let add_successors eq_equiv g v pending frontier = 
64 
let succs_v = IdentDepGraph.succ g v in 
65 
begin 
66 
IdentDepGraph.remove_vertex g v; 
67 
List.iter 
68 
(fun v' > 
69 
if is_graph_root v' g then 
70 
(if eq_equiv v v' then 
71 
pending := ISet.add v' !pending 
72 
else 
73 
frontier := ISet.add v' !frontier) 
74 
) succs_v; 
75 
end 
76  
77 
(* Chooses the next var to be sorted, taking priority into account. 
78 
Modifies [pending] and [frontier] accordingly. 
79 
*) 
80 
let next_element eq_equiv g sort call pending frontier = 
81 
begin 
82 
if ISet.is_empty !pending 
83 
then 
84 
begin 
85 
let choice = ISet.min_elt !frontier in 
86 
(*Format.eprintf "1> %s@." choice;*) 
87 
frontier := ISet.remove choice !frontier; 
88 
let (p, f) = ISet.partition (eq_equiv choice) !frontier in 
89 
pending := p; 
90 
frontier := f; 
91 
call := is_call_output choice g; 
92 
add_successors eq_equiv g choice pending frontier; 
93 
if not (ExprDep.is_ghost_var choice) 
94 
then sort := [choice] :: !sort 
95 
end 
96 
else 
97 
begin 
98 
let choice = ISet.min_elt !pending in 
99 
(*Format.eprintf "2> %s@." choice;*) 
100 
pending := ISet.remove choice !pending; 
101 
add_successors eq_equiv g choice pending frontier; 
102 
if not (ExprDep.is_ghost_var choice) 
103 
then sort := (if !call 
104 
then (choice :: List.hd !sort) :: List.tl !sort 
105 
else [choice] :: !sort) 
106 
end 
107 
end 
108  
109  
110 
(* Topological sort of dependency graph [g], with priority. 
111 
*) 
112 
let topological_sort eq_equiv g = 
113 
let roots = graph_roots g in 
114 
assert (roots <> []); 
115 
let call = ref false in 
116 
let frontier = ref (List.fold_right ISet.add roots ISet.empty) in 
117 
let pending = ref ISet.empty in 
118 
let sorted = ref [] in 
119 
begin 
120 
while not (ISet.is_empty !frontier && ISet.is_empty !pending) 
121 
do 
122 
(*Format.eprintf "frontier = {%a}, pending = {%a}@." 
123 
(fun fmt > ISet.iter (fun e > Format.pp_print_string fmt e)) !frontier 
124 
(fun fmt > ISet.iter (fun e > Format.pp_print_string fmt e)) !pending;*) 
125 
next_element eq_equiv g sorted call pending frontier; 
126 
done; 
127 
IdentDepGraph.clear g; 
128 
!sorted 
129 
end 
130  
131 
let schedule_node n = 
132 
try 
133 
let eq_equiv = ExprDep.node_eq_equiv n in 
134 
let eq_equiv v1 v2 = 
135 
try 
136 
Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2 
137 
with Not_found > false in 
138  
139 
let n', g = global_dependency n in 
140 
Log.report ~level:5 
141 
(fun fmt > 
142 
Format.fprintf fmt 
143 
"dependency graph for node %s: %a" 
144 
n'.node_id 
145 
pp_dep_graph g 
146 
); 
147 

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

161 
Log.report ~level:2 
162 
(fun fmt > 
163 
Format.fprintf fmt 
164 
"clock disjoint map for node %s: %a" 
165 
n'.node_id 
166 
Disjunction.pp_disjoint_map disjoint 
167 
); 
168  
169 
let reuse = Hashtbl.create 23 (*Liveness.compute_reuse_policy n sort disjoint gg*) in 
170 
Log.report ~level:2 
171 
(fun fmt > 
172 
Format.fprintf fmt 
173 
"reuse policy for node %s: %a" 
174 
n'.node_id 
175 
Liveness.pp_reuse_policy reuse 
176 
); 
177 

178 
n', { schedule = sort; unused_vars = unused; fanin_table = fanin; reuse_table = reuse } 
179 
with (Causality.Cycle v) as exc > 
180 
pp_error Format.err_formatter v; 
181 
raise exc 
182  
183 
let schedule_prog prog = 
184 
List.fold_right ( 
185 
fun top_decl (accu_prog, sch_map) > 
186 
match top_decl.top_decl_desc with 
187 
 Node nd > 
188 
let nd', report = schedule_node nd in 
189 
{top_decl with top_decl_desc = Node nd'}::accu_prog, 
190 
IMap.add nd.node_id report sch_map 
191 
 _ > top_decl::accu_prog, sch_map 
192 
) 
193 
prog 
194 
([],IMap.empty) 
195  
196 
let pp_eq_schedule fmt vl = 
197 
match vl with 
198 
 [] > assert false 
199 
 [v] > Format.fprintf fmt "%s" v 
200 
 _ > Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v > Format.fprintf fmt "%s" v)) vl 
201 

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