lustrec / src / scheduling.ml @ 88486aaf
History  View  Annotate  Download (5.34 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 (fun v' > if is_graph_root v' g then (if eq_equiv v v' then pending := ISet.add v' !pending else frontier := ISet.add v' !frontier)) succs_v; 
51 
end 
52  
53 
(* Chooses the next var to be sorted, taking priority into account. 
54 
Modifies [pending] and [frontier] accordingly. 
55 
*) 
56 
let next_element eq_equiv g sort pending frontier = 
57 
begin 
58 
if ISet.is_empty !pending 
59 
then 
60 
begin 
61 
let choice = ISet.min_elt !frontier in 
62 
(*Format.eprintf "1> %s@." choice;*) 
63 
frontier := ISet.remove choice !frontier; 
64 
let (p, f) = ISet.partition (eq_equiv choice) !frontier in 
65 
pending := p; 
66 
frontier := f; 
67 
add_successors eq_equiv g choice pending frontier; 
68 
if not (ExprDep.is_instance_var choice) then sort := choice :: !sort 
69 
end 
70 
else 
71 
begin 
72 
let choice = ISet.min_elt !pending in 
73 
(*Format.eprintf "2> %s@." choice;*) 
74 
pending := ISet.remove choice !pending; 
75 
add_successors eq_equiv g choice pending frontier; 
76 
if not (ExprDep.is_instance_var choice) then sort := choice :: !sort 
77 
end 
78 
end 
79  
80  
81 
(* Topological sort of dependency graph [g], with priority. 
82 
*) 
83 
let topological_sort eq_equiv g = 
84 
let roots = graph_roots g in 
85 
assert (roots <> []); 
86 
let frontier = ref (List.fold_right ISet.add roots ISet.empty) in 
87 
let pending = ref ISet.empty in 
88 
let sorted = ref [] in 
89 
begin 
90 
while not (ISet.is_empty !frontier && ISet.is_empty !pending) 
91 
do 
92 
(*Format.eprintf "frontier = {%a}, pending = {%a}@." 
93 
(fun fmt > ISet.iter (fun e > Format.pp_print_string fmt e)) !frontier 
94 
(fun fmt > ISet.iter (fun e > Format.pp_print_string fmt e)) !pending;*) 
95 
next_element eq_equiv g sorted pending frontier; 
96 
done; 
97 
IdentDepGraph.clear g; 
98 
!sorted 
99 
end 
100  
101 
let schedule_node n = 
102 
try 
103 
let eq_equiv = ExprDep.node_eq_equiv n in 
104 
let eq_equiv v1 v2 = 
105 
try 
106 
Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2 
107 
with Not_found > false in 
108 
let n', g = global_dependency n in 
109 
Log.report ~level:5 (fun fmt > Format.eprintf "dependency graph for node %s: %a" n'.node_id pp_dep_graph g); 
110 
let gg = IdentDepGraph.copy g in 
111 
let sort = topological_sort eq_equiv g in 
112  
113 
let death = Liveness.death_table n gg sort in 
114 
Log.report ~level:5 (fun fmt > Format.eprintf "death table for node %s: %a" n'.node_id Liveness.pp_death_table death); 
115  
116 
let disjoint = Disjunction.clock_disjoint_map (node_vars n) in 
117 
Log.report ~level:5 (fun fmt > Format.eprintf "clock disjoint map for node %s: %a" n'.node_id Disjunction.pp_disjoint_map disjoint); 
118  
119 
let reuse = Liveness.reuse_policy n sort death in 
120 
Log.report ~level:5 (fun fmt > Format.eprintf "reuse policy for node %s: %a" n'.node_id Liveness.pp_reuse_policy reuse); 
121 

122 
n', sort 
123 
(* let sorted = TopologicalDepGraph.fold (fun x res > if ExprDep.is_instance_var x then res else x::res) g []*) 
124 
with (Causality.Cycle v) as exc > 
125 
pp_error Format.err_formatter v; 
126 
raise exc 
127  
128 
let schedule_prog prog = 
129 
List.fold_right ( 
130 
fun top_decl (accu_prog, sch_map) > 
131 
match top_decl.top_decl_desc with 
132 
 Node nd > 
133 
let nd', sch = schedule_node nd in 
134 
{top_decl with top_decl_desc = Node nd'}::accu_prog, (nd.node_id, sch)::sch_map 
135 
 _ > top_decl::accu_prog, sch_map 
136 
) 
137 
prog 
138 
([],[]) 
139  
140  
141 
(* Local Variables: *) 
142 
(* compilecommand:"make C .." *) 
143 
(* End: *) 