lustrec / src / scheduling.ml @ cd670fe1
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  
116 
let n', g = global_dependency n in 
117 
Log.report ~level:5 
118 
(fun fmt > 
119 
Format.eprintf 
120 
"dependency graph for node %s: %a" 
121 
n'.node_id 
122 
pp_dep_graph g 
123 
); 
124 
let gg = IdentDepGraph.copy g in 
125 
let sort = topological_sort eq_equiv g in 
126  
127 
let death = Liveness.death_table n gg sort in 
128 
Log.report ~level:5 
129 
(fun fmt > 
130 
Format.eprintf 
131 
"death table for node %s: %a" 
132 
n'.node_id 
133 
Liveness.pp_death_table death 
134 
); 
135  
136 
let disjoint = Disjunction.clock_disjoint_map (node_vars n) in 
137 

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

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