lustrec / src / scheduling.ml @ 22fe1c93
History | View | Annotate | Download (4.6 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 Corelang |
28 |
open Graph |
29 |
open Causality |
30 |
|
31 |
|
32 |
(* Tests whether [v] is a root of graph [g], i.e. a source *) |
33 |
let is_graph_root v g = |
34 |
IdentDepGraph.in_degree g v = 0 |
35 |
|
36 |
(* Computes the set of graph roots, i.e. the sources of acyclic graph [g] *) |
37 |
let graph_roots g = |
38 |
IdentDepGraph.fold_vertex |
39 |
(fun v roots -> if is_graph_root v g then v::roots else roots) |
40 |
g [] |
41 |
|
42 |
(* Topological sort with a priority for variables belonging in the same equation lhs. |
43 |
For variables still unrelated, standard compare is used to choose the minimal element. |
44 |
This priority is used since it helps a lot in factorizing generated code. |
45 |
In the following functions: |
46 |
- [eq_equiv] is the equivalence relation between vars of the same equation lhs |
47 |
- [g] the (imperative) graph to be topologically sorted |
48 |
- [pending] is the set of unsorted root variables so far, equivalent to the last sorted var |
49 |
- [frontier] is the set of unsorted root variables so far, not belonging in [pending] |
50 |
- [sort] is the resulting topological order |
51 |
*) |
52 |
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv], |
53 |
then removes [v] from [g] |
54 |
*) |
55 |
let add_successors eq_equiv g v pending frontier = |
56 |
let succs_v = IdentDepGraph.succ g v in |
57 |
begin |
58 |
IdentDepGraph.remove_vertex g v; |
59 |
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; |
60 |
end |
61 |
|
62 |
(* Chooses the next var to be sorted, taking priority into account. |
63 |
Modifies [pending] and [frontier] accordingly. |
64 |
*) |
65 |
let next_element eq_equiv g sort pending frontier = |
66 |
if ISet.is_empty !pending |
67 |
then |
68 |
begin |
69 |
let choice = ISet.min_elt !frontier in |
70 |
(*Format.eprintf "-1-> %s@." choice;*) |
71 |
frontier := ISet.remove choice !frontier; |
72 |
let (p, f) = ISet.partition (eq_equiv choice) !frontier in |
73 |
pending := p; |
74 |
frontier := f; |
75 |
add_successors eq_equiv g choice pending frontier; |
76 |
if not (ExprDep.is_instance_var choice) then sort := choice :: !sort; |
77 |
end |
78 |
else |
79 |
begin |
80 |
let choice = ISet.min_elt !pending in |
81 |
(*Format.eprintf "-2-> %s@." choice;*) |
82 |
pending := ISet.remove choice !pending; |
83 |
add_successors eq_equiv g choice pending frontier; |
84 |
if not (ExprDep.is_instance_var choice) then sort := choice :: !sort; |
85 |
end |
86 |
|
87 |
(* Topological sort of dependency graph [g], with priority. |
88 |
*) |
89 |
let topological_sort eq_equiv g = |
90 |
let roots = graph_roots g in |
91 |
assert (roots <> []); |
92 |
let frontier = ref (List.fold_right ISet.add roots ISet.empty) in |
93 |
let pending = ref ISet.empty in |
94 |
let sorted = ref [] in |
95 |
begin |
96 |
while not (ISet.is_empty !frontier && ISet.is_empty !pending) |
97 |
do |
98 |
(*Format.eprintf "frontier = {%a}, pending = {%a}@." |
99 |
(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier |
100 |
(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*) |
101 |
next_element eq_equiv g sorted pending frontier; |
102 |
done; |
103 |
!sorted |
104 |
end |
105 |
|
106 |
let schedule_node n = |
107 |
try |
108 |
let eq_equiv = ExprDep.node_eq_equiv n in |
109 |
let eq_equiv v1 v2 = |
110 |
try |
111 |
Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2 |
112 |
with Not_found -> false in |
113 |
let n', g = global_dependency n in |
114 |
n', topological_sort eq_equiv g |
115 |
(* let sorted = TopologicalDepGraph.fold (fun x res -> if ExprDep.is_instance_var x then res else x::res) g []*) |
116 |
with (Causality.Cycle v) as exc -> |
117 |
pp_error Format.err_formatter v; |
118 |
raise exc |
119 |
|
120 |
|
121 |
(* Local Variables: *) |
122 |
(* compile-command:"make -C .." *) |
123 |
(* End: *) |