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

History | View | Annotate | Download (9.52 KB)

1 | a2d97a3e | ploc | (********************************************************************) |
---|---|---|---|

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 | 22fe1c93 | ploc | |

12 | open Utils |
||

13 | 8446bf03 | ploc | open Lustre_types |

14 | 22fe1c93 | ploc | open Corelang |

15 | open Graph |
||

16 | open Causality |
||

17 | 95fb046e | ploc | open Scheduling_type |

18 | 22fe1c93 | ploc | |

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

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

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

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

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

24 | 22fe1c93 | ploc | In the following functions: |

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

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

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

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

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

30 | *) |
||

31 | a38c681e | xthirioux | |

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

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

34 | let is_call_output choice g = |
||

35 | 04d15b97 | xthirioux | List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice) |

36 | a38c681e | xthirioux | |

37 | 22fe1c93 | ploc | (* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv], |

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

39 | *) |
||

40 | let add_successors eq_equiv g v pending frontier = |
||

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

42 | begin |
||

43 | IdentDepGraph.remove_vertex g v; |
||

44 | b84a138e | ploc | List.iter |

45 | (fun v' -> |
||

46 | if is_graph_root v' g then |
||

47 | (if eq_equiv v v' then |
||

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

49 | else |
||

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

51 | ) succs_v; |
||

52 | 22fe1c93 | ploc | end |

53 | |||

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

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

56 | *) |
||

57 | a38c681e | xthirioux | let next_element eq_equiv g sort call pending frontier = |

58 | 8ea13d96 | xthirioux | begin |

59 | if ISet.is_empty !pending |
||

60 | then |
||

61 | begin |
||

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

63 | 22fe1c93 | ploc | (*Format.eprintf "-1-> %s@." choice;*) |

64 | 8ea13d96 | xthirioux | frontier := ISet.remove choice !frontier; |

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

66 | pending := p; |
||

67 | frontier := f; |
||

68 | a38c681e | xthirioux | call := is_call_output choice g; |

69 | 8ea13d96 | xthirioux | add_successors eq_equiv g choice pending frontier; |

70 | a38c681e | xthirioux | if not (ExprDep.is_ghost_var choice) |

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

72 | 8ea13d96 | xthirioux | end |

73 | else |
||

74 | begin |
||

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

76 | 22fe1c93 | ploc | (*Format.eprintf "-2-> %s@." choice;*) |

77 | 8ea13d96 | xthirioux | pending := ISet.remove choice !pending; |

78 | add_successors eq_equiv g choice pending frontier; |
||

79 | a38c681e | xthirioux | if not (ExprDep.is_ghost_var choice) |

80 | then sort := (if !call |
||

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

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

83 | 8ea13d96 | xthirioux | end |

84 | end |
||

85 | |||

86 | 22fe1c93 | ploc | |

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 | a38c681e | xthirioux | let call = ref false in |

93 | 22fe1c93 | ploc | let frontier = ref (List.fold_right ISet.add roots ISet.empty) in |

94 | let pending = ref ISet.empty in |
||

95 | let sorted = ref [] in |
||

96 | begin |
||

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

98 | do |
||

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

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

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

102 | a38c681e | xthirioux | next_element eq_equiv g sorted call pending frontier; |

103 | 22fe1c93 | ploc | done; |

104 | 8ea13d96 | xthirioux | IdentDepGraph.clear g; |

105 | 22fe1c93 | ploc | !sorted |

106 | end |
||

107 | |||

108 | 54d032f5 | xthirioux | (* Filters out normalization variables and renames instance variables to keep things readable, |

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

110 | let filter_original n vl = |
||

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

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

113 | let vdecl = get_node_var v n in |
||

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

115 | |||

116 | 7afcba5a | xthirioux | let schedule_node n = |

117 | 04a63d25 | xthirioux | (* let node_vars = get_node_vars n in *) |

118 | e7cc5186 | ploc | let eq_equiv = ExprDep.node_eq_equiv n in |

119 | let eq_equiv v1 v2 = |
||

120 | try |
||

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

122 | with Not_found -> false in |
||

123 | cd670fe1 | ploc | |

124 | e7cc5186 | ploc | let n', g = global_dependency n in |

125 | |||

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

127 | 0e1049dc | xthirioux | compute: coi predecessors of outputs |

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

129 | e7cc5186 | ploc | DONE ! |

130 | *) |
||

131 | 0e1049dc | xthirioux | |

132 | e7cc5186 | ploc | let gg = IdentDepGraph.copy g in |

133 | let sort = topological_sort eq_equiv g in |
||

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

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

136 | { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; } |
||

137 | ec433d69 | xthirioux | |

138 | b1a97ade | xthirioux | |

139 | 04a63d25 | xthirioux | let compute_node_reuse_table report = |

140 | let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in |
||

141 | let reuse = Liveness.compute_reuse_policy report.node report.schedule disjoint report.dep_graph in |
||

142 | (* |
||

143 | 89a70069 | xthirioux | if !Options.print_reuse |

144 | then |
||

145 | begin |
||

146 | Log.report ~level:0 |
||

147 | (fun fmt -> |
||

148 | Format.fprintf fmt |
||

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

150 | ); |
||

151 | Log.report ~level:0 |
||

152 | (fun fmt -> |
||

153 | Format.fprintf fmt |
||

154 | 89a70069 | xthirioux | "OPT:clock disjoint map for node %s: %a" |

155 | n'.node_id |
||

156 | Disjunction.pp_disjoint_map disjoint |
||

157 | ); |
||

158 | Log.report ~level:0 |
||

159 | (fun fmt -> |
||

160 | Format.fprintf fmt |
||

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

162 | n'.node_id |
||

163 | Liveness.pp_reuse_policy reuse |
||

164 | ); |
||

165 | end; |
||

166 | 04a63d25 | xthirioux | *) |

167 | reuse |
||

168 | |||

169 | 22fe1c93 | ploc | |

170 | 88486aaf | ploc | let schedule_prog prog = |

171 | List.fold_right ( |
||

172 | 3bfed7f9 | xthirioux | fun top_decl (accu_prog, sch_map) -> |

173 | 88486aaf | ploc | match top_decl.top_decl_desc with |

174 | f4050bef | ploc | | Node nd -> |

175 | let report = schedule_node nd in |
||

176 | {top_decl with top_decl_desc = Node report.node}::accu_prog, |
||

177 | IMap.add nd.node_id report sch_map |
||

178 | 3bfed7f9 | xthirioux | | _ -> top_decl::accu_prog, sch_map |

179 | 88486aaf | ploc | ) |

180 | prog |
||

181 | 3bfed7f9 | xthirioux | ([],IMap.empty) |

182 | 04a63d25 | xthirioux | |

183 | |||

184 | let compute_prog_reuse_table report = |
||

185 | IMap.map compute_node_reuse_table report |
||

186 | |||

187 | (* removes inlined local variables from schedule report, |
||

188 | which are now useless *) |
||

189 | let remove_node_inlined_locals locals report = |
||

190 | let is_inlined v = IMap.exists (fun l _ -> v = l) locals in |
||

191 | let schedule' = |
||

192 | List.fold_right (fun heads q -> let heads' = List.filter (fun v -> not (is_inlined v)) heads |
||

193 | in if heads' = [] then q else heads'::q) |
||

194 | report.schedule [] in |
||

195 | begin |
||

196 | IMap.iter (fun v _ -> Hashtbl.remove report.fanin_table v) locals; |
||

197 | IMap.iter (fun v _ -> let iv = ExprDep.mk_instance_var v |
||

198 | in Liveness.replace_in_dep_graph v iv report.dep_graph) locals; |
||

199 | { report with schedule = schedule' } |
||

200 | end |
||

201 | |||

202 | let remove_prog_inlined_locals removed reuse = |
||

203 | IMap.mapi (fun id -> remove_node_inlined_locals (IMap.find id removed)) reuse |
||

204 | 3bfed7f9 | xthirioux | |

205 | a38c681e | xthirioux | let pp_eq_schedule fmt vl = |

206 | match vl with |
||

207 | | [] -> assert false |
||

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

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

210 | |||

211 | 8a183477 | xthirioux | let pp_schedule fmt node_schs = |

212 | IMap.iter |
||

213 | (fun nd report -> |
||

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

215 | nd |
||

216 | a38c681e | xthirioux | (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule) |

217 | 8a183477 | xthirioux | node_schs |

218 | |||

219 | let pp_fanin_table fmt node_schs = |
||

220 | IMap.iter |
||

221 | (fun nd report -> |
||

222 | 04a63d25 | xthirioux | Format.fprintf fmt "%s: %a" nd Liveness.pp_fanin report.fanin_table) |

223 | node_schs |
||

224 | |||

225 | let pp_dep_graph fmt node_schs = |
||

226 | IMap.iter |
||

227 | (fun nd report -> |
||

228 | Format.fprintf fmt "%s dependency graph: %a" nd pp_dep_graph report.dep_graph) |
||

229 | 8a183477 | xthirioux | node_schs |

230 | |||

231 | 3bfed7f9 | xthirioux | let pp_warning_unused fmt node_schs = |

232 | IMap.iter |
||

233 | (fun nd report -> |
||

234 | let unused = report.unused_vars in |
||

235 | if not (ISet.is_empty unused) |
||

236 | then |
||

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

238 | ISet.iter |
||

239 | df39e35a | xthirioux | (fun u -> |

240 | let vu = get_node_var u nd in |
||

241 | if vu.var_orig |
||

242 | 04a63d25 | xthirioux | then Format.fprintf fmt " Warning: variable '%s' seems unused@, %a@,@," u Location.pp_loc vu.var_loc) |

243 | 3bfed7f9 | xthirioux | unused |

244 | ) |
||

245 | node_schs |
||

246 | 22fe1c93 | ploc | |

247 | 04a63d25 | xthirioux | |

248 | eb9a8c3c | ploc | (* Sort eqs according to schedule *) |

249 | (* Sort the set of equations of node [nd] according |
||

250 | to the computed schedule [sch] |
||

251 | *) |
||

252 | let sort_equations_from_schedule nd sch = |
||

253 | (* Format.eprintf "%s schedule: %a@." *) |
||

254 | (* nd.node_id *) |
||

255 | (* (Utils.fprintf_list ~sep:" ; " Scheduling.pp_eq_schedule) sch; *) |
||

256 | let eqs, auts = get_node_eqs nd in |
||

257 | assert (auts = []); (* Automata should be expanded by now *) |
||

258 | let split_eqs = Splitting.tuple_split_eq_list eqs in |
||

259 | let eqs_rev, remainder = |
||

260 | List.fold_left |
||

261 | (fun (accu, node_eqs_remainder) vl -> |
||

262 | if List.exists (fun eq -> List.exists (fun v -> List.mem v eq.eq_lhs) vl) accu |
||

263 | then |
||

264 | (accu, node_eqs_remainder) |
||

265 | else |
||

266 | let eq_v, remainder = find_eq vl node_eqs_remainder in |
||

267 | eq_v::accu, remainder |
||

268 | ) |
||

269 | ([], split_eqs) |
||

270 | sch |
||

271 | in |
||

272 | begin |
||

273 | if List.length remainder > 0 then ( |
||

274 | let eqs, auts = get_node_eqs nd in |
||

275 | assert (auts = []); (* Automata should be expanded by now *) |
||

276 | Format.eprintf "Equations not used are@.%a@.Full equation set is:@.%a@.@?" |
||

277 | Printers.pp_node_eqs remainder |
||

278 | Printers.pp_node_eqs eqs; |
||

279 | assert false); |
||

280 | List.rev eqs_rev |
||

281 | end |
||

282 | |||

283 | 22fe1c93 | ploc | (* Local Variables: *) |

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

285 | (* End: *) |