## lustrec / src / scheduling.ml @ 7dedc5f0

History | View | Annotate | Download (7.19 KB)

1 | b38ffff3 | 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 | 0cbf0839 | ploc | |

12 | open Utils |
||

13 | 6cf31814 | xthirioux | open LustreSpec |

14 | 0cbf0839 | ploc | open Corelang |

15 | open Graph |
||

16 | open Causality |
||

17 | |||

18 | 9aaee7f9 | xthirioux | type schedule_report = |

19 | { |
||

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

21 | 2cf39a8e | xthirioux | schedule : ident list list; |

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

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

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

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

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

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

28 | 9aaee7f9 | xthirioux | } |

29 | 0cbf0839 | ploc | |

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 | 6aeb3388 | xthirioux | 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 | 0cbf0839 | ploc | 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 | 2cf39a8e | xthirioux | |

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.for_all ExprDep.is_instance_var (IdentDepGraph.succ g choice) |
||

47 | |||

48 | 0cbf0839 | ploc | (* 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 | 49ddf66d | ploc | 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 | 0cbf0839 | ploc | end |

64 | |||

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

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

67 | *) |
||

68 | 2cf39a8e | xthirioux | let next_element eq_equiv g sort call pending frontier = |

69 | 6cf31814 | xthirioux | begin |

70 | if ISet.is_empty !pending |
||

71 | then |
||

72 | begin |
||

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

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

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

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

77 | pending := p; |
||

78 | frontier := f; |
||

79 | 2cf39a8e | xthirioux | call := is_call_output choice g; |

80 | 6cf31814 | xthirioux | add_successors eq_equiv g choice pending frontier; |

81 | 2cf39a8e | xthirioux | if not (ExprDep.is_ghost_var choice) |

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

83 | 6cf31814 | xthirioux | end |

84 | else |
||

85 | begin |
||

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

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

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

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

90 | 2cf39a8e | xthirioux | 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 | 6cf31814 | xthirioux | end |

95 | end |
||

96 | |||

97 | 0cbf0839 | ploc | |

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

104 | 0cbf0839 | ploc | 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 | 2cf39a8e | xthirioux | next_element eq_equiv g sorted call pending frontier; |

114 | 0cbf0839 | ploc | 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 | 34a5a072 | xthirioux | Format.fprintf fmt |

131 | 49ddf66d | ploc | "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 | 34a5a072 | xthirioux | let unused = Liveness.compute_unused_variables n gg in |

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

146 | e8c0f452 | xthirioux | |

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

148 | 49ddf66d | ploc | |

149 | 2cf39a8e | xthirioux | Log.report ~level:2 |

150 | 49ddf66d | ploc | (fun fmt -> |

151 | 34a5a072 | xthirioux | Format.fprintf fmt |

152 | 49ddf66d | ploc | "clock disjoint map for node %s: %a" |

153 | n'.node_id |
||

154 | Disjunction.pp_disjoint_map disjoint |
||

155 | ); |
||

156 | 97498b53 | xthirioux | |

157 | 01f1a1f4 | xthirioux | let reuse = Liveness.compute_reuse_policy n sort disjoint gg in |

158 | 2cf39a8e | xthirioux | Log.report ~level:2 |

159 | 49ddf66d | ploc | (fun fmt -> |

160 | 34a5a072 | xthirioux | Format.fprintf fmt |

161 | 49ddf66d | ploc | "reuse policy for node %s: %a" |

162 | n'.node_id |
||

163 | Liveness.pp_reuse_policy reuse |
||

164 | ); |
||

165 | e8c0f452 | xthirioux | |

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

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

168 | pp_error Format.err_formatter v; |
||

169 | raise exc |
||

170 | |||

171 | db1c5c00 | ploc | let schedule_prog prog = |

172 | List.fold_right ( |
||

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

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

175 | | Node nd -> |
||

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

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

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

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

180 | db1c5c00 | ploc | ) |

181 | prog |
||

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

183 | |||

184 | 2cf39a8e | xthirioux | let pp_eq_schedule fmt vl = |

185 | match vl with |
||

186 | | [] -> assert false |
||

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

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

189 | |||

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

191 | IMap.iter |
||

192 | (fun nd report -> |
||

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

194 | nd |
||

195 | 2cf39a8e | xthirioux | (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule) |

196 | d96d54ac | xthirioux | node_schs |

197 | |||

198 | let pp_fanin_table fmt node_schs = |
||

199 | IMap.iter |
||

200 | (fun nd report -> |
||

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

202 | node_schs |
||

203 | |||

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

205 | IMap.iter |
||

206 | (fun nd report -> |
||

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

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

209 | then |
||

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

211 | ISet.iter |
||

212 | (fun u -> |
||

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

214 | u |
||

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

216 | 9aaee7f9 | xthirioux | unused |

217 | ) |
||

218 | node_schs |
||

219 | 0cbf0839 | ploc | |

220 | (* Local Variables: *) |
||

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

222 | (* End: *) |