## lustrec / src / scheduling.ml @ 8ea13d96

History | View | Annotate | Download (6.37 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 LustreSpec |

28 |
open Corelang |

29 |
open Graph |

30 |
open Causality |

31 | |

32 | |

33 |
(* Tests whether [v] is a root of graph [g], i.e. a source *) |

34 |
let is_graph_root v g = |

35 |
IdentDepGraph.in_degree g v = 0 |

36 | |

37 |
(* Computes the set of graph roots, i.e. the sources of acyclic graph [g] *) |

38 |
let graph_roots g = |

39 |
IdentDepGraph.fold_vertex |

40 |
(fun v roots -> if is_graph_root v g then v::roots else roots) |

41 |
g [] |

42 | |

43 |
(* Topological sort with a priority for variables belonging in the same equation lhs. |

44 |
For variables still unrelated, standard compare is used to choose the minimal element. |

45 |
This priority is used since it helps a lot in factorizing generated code. |

46 |
In the following functions: |

47 |
- [eq_equiv] is the equivalence relation between vars of the same equation lhs |

48 |
- [g] the (imperative) graph to be topologically sorted |

49 |
- [pending] is the set of unsorted root variables so far, equivalent to the last sorted var |

50 |
- [frontier] is the set of unsorted root variables so far, not belonging in [pending] |

51 |
- [sort] is the resulting topological order |

52 |
*) |

53 |
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv], |

54 |
then removes [v] from [g] |

55 |
*) |

56 |
let add_successors eq_equiv g v pending frontier = |

57 |
let succs_v = IdentDepGraph.succ g v in |

58 |
begin |

59 |
IdentDepGraph.remove_vertex g v; |

60 |
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; |

61 |
end |

62 | |

63 |
(* Chooses the next var to be sorted, taking priority into account. |

64 |
Modifies [pending] and [frontier] accordingly. |

65 |
*) |

66 |
let next_element eq_equiv g sort pending frontier = |

67 |
begin |

68 |
if ISet.is_empty !pending |

69 |
then |

70 |
begin |

71 |
let choice = ISet.min_elt !frontier in |

72 |
(*Format.eprintf "-1-> %s@." choice;*) |

73 |
frontier := ISet.remove choice !frontier; |

74 |
let (p, f) = ISet.partition (eq_equiv choice) !frontier in |

75 |
pending := p; |

76 |
frontier := f; |

77 |
add_successors eq_equiv g choice pending frontier; |

78 |
if not (ExprDep.is_instance_var choice) then sort := choice :: !sort |

79 |
end |

80 |
else |

81 |
begin |

82 |
let choice = ISet.min_elt !pending in |

83 |
(*Format.eprintf "-2-> %s@." choice;*) |

84 |
pending := ISet.remove choice !pending; |

85 |
add_successors eq_equiv g choice pending frontier; |

86 |
if not (ExprDep.is_instance_var choice) then sort := choice :: !sort |

87 |
end |

88 |
end |

89 | |

90 | |

91 |
(* Topological sort of dependency graph [g], with priority. |

92 |
*) |

93 |
let topological_sort eq_equiv g = |

94 |
let roots = graph_roots g in |

95 |
assert (roots <> []); |

96 |
let frontier = ref (List.fold_right ISet.add roots ISet.empty) in |

97 |
let pending = ref ISet.empty in |

98 |
let sorted = ref [] in |

99 |
begin |

100 |
while not (ISet.is_empty !frontier && ISet.is_empty !pending) |

101 |
do |

102 |
(*Format.eprintf "frontier = {%a}, pending = {%a}@." |

103 |
(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier |

104 |
(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*) |

105 |
next_element eq_equiv g sorted pending frontier; |

106 |
done; |

107 |
IdentDepGraph.clear g; |

108 |
!sorted |

109 |
end |

110 | |

111 |
(* Computes the last dependency |

112 |
*) |

113 | |

114 |
(* Computes the death table of [node] wrt dep graph [g] and topological [sort]. |

115 |
The death table is a mapping: ident -> Set(ident) such that: |

116 |
death x is the set of local variables which get dead (i.e. unused) |

117 |
after x is evaluated, but were until live. |

118 |
*) |

119 |
let death_table node g sort = |

120 |
let death = Hashtbl.create 23 in |

121 |
let sort = ref (List.rev sort) in |

122 |
let buried = ref ISet.empty in |

123 |
begin |

124 |
buried := ExprDep.node_memory_variables node; |

125 |
buried := List.fold_left (fun dead (v : var_decl) -> ISet.add v.var_id dead) !buried node.node_outputs; |

126 |
(* We could also try to reuse input variables, due to C parameter copying semantics *) |

127 |
buried := List.fold_left (fun dead (v : var_decl) -> ISet.add v.var_id dead) !buried node.node_inputs; |

128 |
while (!sort <> []) |

129 |
do |

130 |
let head = List.hd !sort in |

131 |
let dead = IdentDepGraph.fold_succ |

132 |
(fun tgt dead -> if not (ExprDep.is_instance_var tgt || ISet.mem tgt !buried) then ISet.add tgt dead else dead) |

133 |
g head ISet.empty in |

134 |
buried := ISet.union !buried dead; |

135 |
Hashtbl.add death head dead; |

136 |
sort := List.tl !sort |

137 |
done; |

138 |
IdentDepGraph.clear g; |

139 |
death |

140 |
end |

141 | |

142 |
let pp_death_table fmt death = |

143 |
begin |

144 |
Format.fprintf fmt "{ /* death table */@."; |

145 |
Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> { %a }@." s (Utils.fprintf_list ~sep:", " Format.pp_print_string) (ISet.elements t)) death; |

146 |
Format.fprintf fmt "}@." |

147 |
end |

148 | |

149 |
let schedule_node n = |

150 |
try |

151 |
let eq_equiv = ExprDep.node_eq_equiv n in |

152 |
let eq_equiv v1 v2 = |

153 |
try |

154 |
Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2 |

155 |
with Not_found -> false in |

156 |
let n', g = global_dependency n in |

157 |
Log.report ~level:5 (fun fmt -> Format.eprintf "dependency graph for node %s: %a" n'.node_id pp_dep_graph g); |

158 |
let gg = IdentDepGraph.copy g in |

159 |
let sort = topological_sort eq_equiv g in |

160 |
let death = death_table n gg sort in |

161 |
Log.report ~level:5 (fun fmt -> Format.eprintf "death table for node %s: %a" n'.node_id pp_death_table death); |

162 |
n', sort, death |

163 |
(* let sorted = TopologicalDepGraph.fold (fun x res -> if ExprDep.is_instance_var x then res else x::res) g []*) |

164 |
with (Causality.Cycle v) as exc -> |

165 |
pp_error Format.err_formatter v; |

166 |
raise exc |

167 | |

168 | |

169 |
(* Local Variables: *) |

170 |
(* compile-command:"make -C .." *) |

171 |
(* End: *) |