## lustrec / src / scheduling.ml @ e41592cf

History | View | Annotate | Download (8.02 KB)

1 |
(********************************************************************) |
---|---|

2 |
(* *) |

3 |
(* The LustreC compiler toolset / The LustreC Development Team *) |

4 |
(* Copyright 2012 - -- ONERA - CNRS - INPT *) |

5 |
(* *) |

6 |
(* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |

7 |
(* under the terms of the GNU Lesser General Public License *) |

8 |
(* version 2.1. *) |

9 |
(* *) |

10 |
(********************************************************************) |

11 | |

12 |
open Utils |

13 |
open LustreSpec |

14 |
open Corelang |

15 |
open Graph |

16 |
open Causality |

17 | |

18 |
type schedule_report = |

19 |
{ |

20 |
(* a schedule computed wrt the dependency graph *) |

21 |
schedule : ident list list; |

22 |
(* the set of unused variables (no output or mem depends on them) *) |

23 |
unused_vars : ISet.t; |

24 |
(* the table mapping each local var to its in-degree *) |

25 |
fanin_table : (ident, int) Hashtbl.t; |

26 |
(* the table mapping each assignment to a reusable variable *) |

27 |
reuse_table : (ident, var_decl) Hashtbl.t |

28 |
} |

29 | |

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

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

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

33 |
Moreover, the dependency graph is browsed in a depth-first manner whenever possible, |

34 |
to improve the behavior of optimization algorithms applied in forthcoming compilation steps. |

35 |
In the following functions: |

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

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

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

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

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

41 |
*) |

42 | |

43 |
(* Checks whether the currently scheduled variable [choice] |

44 |
is an output of a call, possibly among others *) |

45 |
let is_call_output choice g = |

46 |
List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice) |

47 | |

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

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

50 |
*) |

51 |
let add_successors eq_equiv g v pending frontier = |

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

53 |
begin |

54 |
IdentDepGraph.remove_vertex g v; |

55 |
List.iter |

56 |
(fun v' -> |

57 |
if is_graph_root v' g then |

58 |
(if eq_equiv v v' then |

59 |
pending := ISet.add v' !pending |

60 |
else |

61 |
frontier := ISet.add v' !frontier) |

62 |
) succs_v; |

63 |
end |

64 | |

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

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

67 |
*) |

68 |
let next_element eq_equiv g sort call pending frontier = |

69 |
begin |

70 |
if ISet.is_empty !pending |

71 |
then |

72 |
begin |

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

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

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

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

77 |
pending := p; |

78 |
frontier := f; |

79 |
call := is_call_output choice g; |

80 |
add_successors eq_equiv g choice pending frontier; |

81 |
if not (ExprDep.is_ghost_var choice) |

82 |
then sort := [choice] :: !sort |

83 |
end |

84 |
else |

85 |
begin |

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

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

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

89 |
add_successors eq_equiv g choice pending frontier; |

90 |
if not (ExprDep.is_ghost_var choice) |

91 |
then sort := (if !call |

92 |
then (choice :: List.hd !sort) :: List.tl !sort |

93 |
else [choice] :: !sort) |

94 |
end |

95 |
end |

96 | |

97 | |

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

99 |
*) |

100 |
let topological_sort eq_equiv g = |

101 |
let roots = graph_roots g in |

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

103 |
let call = ref false in |

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

105 |
let pending = ref ISet.empty in |

106 |
let sorted = ref [] in |

107 |
begin |

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

109 |
do |

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

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

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

113 |
next_element eq_equiv g sorted call pending frontier; |

114 |
done; |

115 |
IdentDepGraph.clear g; |

116 |
!sorted |

117 |
end |

118 | |

119 |
(* Filters out normalization variables and renames instance variables to keep things readable, |

120 |
in a case of a dependency error *) |

121 |
let filter_original n vl = |

122 |
List.fold_right (fun v res -> |

123 |
if ExprDep.is_instance_var v then Format.sprintf "node %s" (ExprDep.undo_instance_var v) :: res else |

124 |
let vdecl = get_node_var v n in |

125 |
if vdecl.var_orig then v :: res else res) vl [] |

126 | |

127 |
let schedule_node n = |

128 |
let node_vars = get_node_vars n in |

129 |
try |

130 |
let eq_equiv = ExprDep.node_eq_equiv n in |

131 |
let eq_equiv v1 v2 = |

132 |
try |

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

134 |
with Not_found -> false in |

135 | |

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

137 |
Log.report ~level:5 |

138 |
(fun fmt -> |

139 |
Format.fprintf fmt |

140 |
"dependency graph for node %s: %a" |

141 |
n'.node_id |

142 |
pp_dep_graph g |

143 |
); |

144 | |

145 |
(* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs |

146 |
compute: coi predecessors of outputs |

147 |
warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output) |

148 |
DONE ! |

149 |
*) |

150 | |

151 |
let gg = IdentDepGraph.copy g in |

152 |
let sort = topological_sort eq_equiv g in |

153 |
let unused = Liveness.compute_unused_variables n gg in |

154 |
let fanin = Liveness.compute_fanin n gg in |

155 | |

156 |
let (disjoint, reuse) = |

157 |
if !Options.optimization >= 3 |

158 |
then |

159 |
let disjoint = Disjunction.clock_disjoint_map node_vars in |

160 |
(disjoint, |

161 |
Liveness.compute_reuse_policy n sort disjoint gg) |

162 |
else |

163 |
(Hashtbl.create 1, |

164 |
Hashtbl.create 1) in |

165 | |

166 |
if !Options.print_reuse |

167 |
then |

168 |
begin |

169 |
Log.report ~level:0 |

170 |
(fun fmt -> |

171 |
Format.fprintf fmt |

172 |
"OPT:%B@." (try (Hashtbl.iter (fun s1 v2 -> if s1 = v2.var_id then raise Not_found) reuse; false) with Not_found -> true) |

173 |
); |

174 |
Log.report ~level:0 |

175 |
(fun fmt -> |

176 |
Format.fprintf fmt |

177 |
"OPT:clock disjoint map for node %s: %a" |

178 |
n'.node_id |

179 |
Disjunction.pp_disjoint_map disjoint |

180 |
); |

181 |
Log.report ~level:0 |

182 |
(fun fmt -> |

183 |
Format.fprintf fmt |

184 |
"OPT:reuse policy for node %s: %a" |

185 |
n'.node_id |

186 |
Liveness.pp_reuse_policy reuse |

187 |
); |

188 |
end; |

189 |
n', { schedule = sort; unused_vars = unused; fanin_table = fanin; reuse_table = reuse } |

190 |
with (Causality.Cycle vl) as exc -> |

191 |
let vl = filter_original n vl in |

192 |
pp_error Format.err_formatter vl; |

193 |
raise exc |

194 | |

195 |
let schedule_prog prog = |

196 |
List.fold_right ( |

197 |
fun top_decl (accu_prog, sch_map) -> |

198 |
match top_decl.top_decl_desc with |

199 |
| Node nd -> |

200 |
let nd', report = schedule_node nd in |

201 |
{top_decl with top_decl_desc = Node nd'}::accu_prog, |

202 |
IMap.add nd.node_id report sch_map |

203 |
| _ -> top_decl::accu_prog, sch_map |

204 |
) |

205 |
prog |

206 |
([],IMap.empty) |

207 | |

208 |
let pp_eq_schedule fmt vl = |

209 |
match vl with |

210 |
| [] -> assert false |

211 |
| [v] -> Format.fprintf fmt "%s" v |

212 |
| _ -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl |

213 | |

214 |
let pp_schedule fmt node_schs = |

215 |
IMap.iter |

216 |
(fun nd report -> |

217 |
Format.fprintf fmt "%s schedule: %a@." |

218 |
nd |

219 |
(fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule) |

220 |
node_schs |

221 | |

222 |
let pp_fanin_table fmt node_schs = |

223 |
IMap.iter |

224 |
(fun nd report -> |

225 |
Format.fprintf fmt "%s : %a" nd Liveness.pp_fanin report.fanin_table) |

226 |
node_schs |

227 | |

228 |
let pp_warning_unused fmt node_schs = |

229 |
IMap.iter |

230 |
(fun nd report -> |

231 |
let unused = report.unused_vars in |

232 |
if not (ISet.is_empty unused) |

233 |
then |

234 |
let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in |

235 |
ISet.iter |

236 |
(fun u -> |

237 |
let vu = get_node_var u nd in |

238 |
if vu.var_orig |

239 |
then Format.fprintf fmt "Warning: variable '%s' seems unused@.%a@." u Location.pp_loc vu.var_loc) |

240 |
unused |

241 |
) |

242 |
node_schs |

243 | |

244 |
(* Local Variables: *) |

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

246 |
(* End: *) |