## lustrec / src / scheduling.ml @ 6cf31814

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

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 | 6cf31814 | xthirioux | begin |

68 | if ISet.is_empty !pending |
||

69 | then |
||

70 | begin |
||

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

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

73 | 6cf31814 | xthirioux | 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 | 0cbf0839 | ploc | (*Format.eprintf "-2-> %s@." choice;*) |

84 | 6cf31814 | xthirioux | 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 | 0cbf0839 | ploc | |

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 | 6cf31814 | xthirioux | IdentDepGraph.clear g; |

108 | 0cbf0839 | ploc | !sorted |

109 | end |
||

110 | |||

111 | 6cf31814 | xthirioux | (* 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 | 0cbf0839 | ploc | 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 | 6cf31814 | xthirioux | 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 | 0cbf0839 | ploc | (* 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: *) |