lustrec / src / scheduling.ml @ 01c7d5e1
History | View | Annotate | Download (7.08 KB)
1 |
(* ---------------------------------------------------------------------------- |
---|---|
2 |
* SchedMCore - A MultiCore Scheduling Framework |
3 |
* Copyright (C) 2009-2013, ONERA, Toulouse, FRANCE - LIFL, Lille, FRANCE |
4 |
* Copyright (C) 2012-2013, 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 02111-1307 |
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 in-degree *) |
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 |
(* compile-command:"make -C .." *) |
224 |
(* End: *) |