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

137 
Log.report ~level:5 
138 
(fun fmt > 
139 
Format.eprintf 
140 
"clock disjoint map for node %s: %a" 
141 
n'.node_id 
142 
Disjunction.pp_disjoint_map disjoint 
143 
); 
144  
145 
let reuse = Liveness.reuse_policy n sort death in 
146 
Log.report ~level:5 
147 
(fun fmt > 
148 
Format.eprintf 
149 
"reuse policy for node %s: %a" 
150 
n'.node_id 
151 
Liveness.pp_reuse_policy reuse 
152 
); 
153 

154 
n', sort 
155 
(* let sorted = TopologicalDepGraph.fold (fun x res > if ExprDep.is_instance_var x then res else x::res) g []*) 
156 
with (Causality.Cycle v) as exc > 
157 
pp_error Format.err_formatter v; 
158 
raise exc 
159  
160 
let schedule_prog prog = 
161 
List.fold_right ( 
162 
fun top_decl (accu_prog, sch_map) > 
163 
match top_decl.top_decl_desc with 
164 
 Node nd > 
165 
let nd', sch = schedule_node nd in 
166 
{top_decl with top_decl_desc = Node nd'}::accu_prog, (nd.node_id, sch)::sch_map 
167 
 _ > top_decl::accu_prog, sch_map 
168 
) 
169 
prog 
170 
([],[]) 
171  
172  
173 
(* Local Variables: *) 
174 
(* compilecommand:"make C .." *) 
175 
(* End: *) 