## lustrec / src / scheduling.ml @ 36454535

History | View | Annotate | Download (7.07 KB)

1 | 0cbf0839 | ploc | (* ---------------------------------------------------------------------------- |
---|---|---|---|

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 | 6cf31814 | xthirioux | open LustreSpec |

28 | 0cbf0839 | ploc | open Corelang |

29 | open Graph |
||

30 | open Causality |
||

31 | |||

32 | 9aaee7f9 | xthirioux | type schedule_report = |

33 | { |
||

34 | d96d54ac | xthirioux | (* a schedule computed wrt the dependency graph *) |

35 | 9aaee7f9 | xthirioux | schedule : ident list; |

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

37 | 9aaee7f9 | xthirioux | unused_vars : ISet.t; |

38 | d96d54ac | xthirioux | (* the table mapping each local var to its in-degree *) |

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

40 | 1837ce98 | xthirioux | (* the table mapping each assignment to a reusable variable *) |

41 | reuse_table : (ident, ident) Hashtbl.t |
||

42 | 9aaee7f9 | xthirioux | } |

43 | 0cbf0839 | ploc | |

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

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

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

47 | In the following functions: |
||

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

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

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

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

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

53 | *) |
||

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

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

56 | *) |
||

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

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

59 | begin |
||

60 | IdentDepGraph.remove_vertex g v; |
||

61 | 49ddf66d | ploc | List.iter |

62 | (fun v' -> |
||

63 | if is_graph_root v' g then |
||

64 | (if eq_equiv v v' then |
||

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

66 | else |
||

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

68 | ) succs_v; |
||

69 | 0cbf0839 | ploc | end |

70 | |||

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

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

73 | *) |
||

74 | let next_element eq_equiv g sort pending frontier = |
||

75 | 6cf31814 | xthirioux | begin |

76 | if ISet.is_empty !pending |
||

77 | then |
||

78 | begin |
||

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

80 | 0cbf0839 | ploc | (*Format.eprintf "-1-> %s@." choice;*) |

81 | 6cf31814 | xthirioux | frontier := ISet.remove choice !frontier; |

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

83 | pending := p; |
||

84 | frontier := f; |
||

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

86 | 9aaee7f9 | xthirioux | if not (ExprDep.is_ghost_var choice) then sort := choice :: !sort |

87 | 6cf31814 | xthirioux | end |

88 | else |
||

89 | begin |
||

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

91 | 0cbf0839 | ploc | (*Format.eprintf "-2-> %s@." choice;*) |

92 | 6cf31814 | xthirioux | pending := ISet.remove choice !pending; |

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

94 | 9aaee7f9 | xthirioux | if not (ExprDep.is_ghost_var choice) then sort := choice :: !sort |

95 | 6cf31814 | xthirioux | end |

96 | end |
||

97 | |||

98 | 0cbf0839 | ploc | |

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

100 | *) |
||

101 | let topological_sort eq_equiv g = |
||

102 | let roots = graph_roots g in |
||

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

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 pending frontier; |
||

114 | done; |
||

115 | 6cf31814 | xthirioux | IdentDepGraph.clear g; |

116 | 0cbf0839 | ploc | !sorted |

117 | end |
||

118 | |||

119 | e8c0f452 | xthirioux | let schedule_node n = |

120 | 0cbf0839 | ploc | try |

121 | let eq_equiv = ExprDep.node_eq_equiv n in |
||

122 | let eq_equiv v1 v2 = |
||

123 | try |
||

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

125 | with Not_found -> false in |
||

126 | 522938b5 | ploc | |

127 | 0cbf0839 | ploc | let n', g = global_dependency n in |

128 | 49ddf66d | ploc | Log.report ~level:5 |

129 | (fun fmt -> |
||

130 | Format.eprintf |
||

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

132 | n'.node_id |
||

133 | pp_dep_graph g |
||

134 | ); |
||

135 | c1b14ce6 | xthirioux | |

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

137 | compute: coi predecessors of outputs |
||

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

139 | d96d54ac | xthirioux | DONE ! |

140 | c1b14ce6 | xthirioux | *) |

141 | |||

142 | 3c48346d | xthirioux | let gg = IdentDepGraph.copy g in |

143 | 84d9893e | xthirioux | let sort = topological_sort eq_equiv g in |

144 | 9aaee7f9 | xthirioux | let unused = Liveness.compute_unused n gg in |

145 | d96d54ac | xthirioux | let fanin = Liveness.compute_fanin n gg in |

146 | d4101ea0 | xthirioux | let death = Liveness.death_table n gg sort in |

147 | 49ddf66d | ploc | Log.report ~level:5 |

148 | (fun fmt -> |
||

149 | Format.eprintf |
||

150 | "death table for node %s: %a" |
||

151 | n'.node_id |
||

152 | Liveness.pp_death_table death |
||

153 | ); |
||

154 | e8c0f452 | xthirioux | |

155 | 0038002e | ploc | let disjoint = Disjunction.clock_disjoint_map (get_node_vars n) in |

156 | 49ddf66d | ploc | |

157 | Log.report ~level:5 |
||

158 | (fun fmt -> |
||

159 | Format.eprintf |
||

160 | "clock disjoint map for node %s: %a" |
||

161 | n'.node_id |
||

162 | Disjunction.pp_disjoint_map disjoint |
||

163 | ); |
||

164 | 97498b53 | xthirioux | |

165 | 1837ce98 | xthirioux | let reuse = Liveness.reuse_policy n sort death disjoint in |

166 | 49ddf66d | ploc | Log.report ~level:5 |

167 | (fun fmt -> |
||

168 | Format.eprintf |
||

169 | "reuse policy for node %s: %a" |
||

170 | n'.node_id |
||

171 | Liveness.pp_reuse_policy reuse |
||

172 | ); |
||

173 | e8c0f452 | xthirioux | |

174 | 1837ce98 | xthirioux | n', { schedule = sort; unused_vars = unused; fanin_table = fanin; reuse_table = reuse } |

175 | 0cbf0839 | ploc | with (Causality.Cycle v) as exc -> |

176 | pp_error Format.err_formatter v; |
||

177 | raise exc |
||

178 | |||

179 | db1c5c00 | ploc | let schedule_prog prog = |

180 | List.fold_right ( |
||

181 | 9aaee7f9 | xthirioux | fun top_decl (accu_prog, sch_map) -> |

182 | db1c5c00 | ploc | match top_decl.top_decl_desc with |

183 | | Node nd -> |
||

184 | 9aaee7f9 | xthirioux | let nd', report = schedule_node nd in |

185 | c1b14ce6 | xthirioux | {top_decl with top_decl_desc = Node nd'}::accu_prog, |

186 | 9aaee7f9 | xthirioux | IMap.add nd.node_id report sch_map |

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

188 | db1c5c00 | ploc | ) |

189 | prog |
||

190 | 9aaee7f9 | xthirioux | ([],IMap.empty) |

191 | |||

192 | d96d54ac | xthirioux | let pp_schedule fmt node_schs = |

193 | IMap.iter |
||

194 | (fun nd report -> |
||

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

196 | nd |
||

197 | (fprintf_list ~sep:" ; " (fun fmt v -> Format.fprintf fmt "%s" v)) report.schedule) |
||

198 | node_schs |
||

199 | |||

200 | let pp_fanin_table fmt node_schs = |
||

201 | IMap.iter |
||

202 | (fun nd report -> |
||

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

204 | node_schs |
||

205 | |||

206 | 9aaee7f9 | xthirioux | let pp_warning_unused fmt node_schs = |

207 | IMap.iter |
||

208 | (fun nd report -> |
||

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

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

211 | then |
||

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

213 | ISet.iter |
||

214 | (fun u -> |
||

215 | Format.fprintf fmt "Warning: variable '%s' seems unused@.%a@." |
||

216 | u |
||

217 | 0038002e | ploc | Location.pp_loc (get_node_var u nd).var_loc) |

218 | 9aaee7f9 | xthirioux | unused |

219 | ) |
||

220 | node_schs |
||

221 | 0cbf0839 | ploc | |

222 | (* Local Variables: *) |
||

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

224 | (* End: *) |