## lustrec / src / scheduling.ml @ 0cbf0839

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: *) |