## lustrec / src / scheduling.ml @ d4807c3d

History | View | Annotate | Download (4.82 KB)

1 | 22fe1c93 | 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 | 8ea13d96 | xthirioux | open LustreSpec |

28 | 22fe1c93 | ploc | open Corelang |

29 | open Graph |
||

30 | open Causality |
||

31 | |||

32 | |||

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

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

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

36 | In the following functions: |
||

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

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

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

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

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

42 | *) |
||

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

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

45 | *) |
||

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

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

48 | begin |
||

49 | IdentDepGraph.remove_vertex g v; |
||

50 | 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; |
||

51 | end |
||

52 | |||

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

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

55 | *) |
||

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

57 | 8ea13d96 | xthirioux | begin |

58 | if ISet.is_empty !pending |
||

59 | then |
||

60 | begin |
||

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

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

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

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

65 | pending := p; |
||

66 | frontier := f; |
||

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

68 | if not (ExprDep.is_instance_var choice) then sort := choice :: !sort |
||

69 | end |
||

70 | else |
||

71 | begin |
||

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

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

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

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

76 | if not (ExprDep.is_instance_var choice) then sort := choice :: !sort |
||

77 | end |
||

78 | end |
||

79 | |||

80 | 22fe1c93 | ploc | |

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

82 | *) |
||

83 | let topological_sort eq_equiv g = |
||

84 | let roots = graph_roots g in |
||

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

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

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

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

89 | begin |
||

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

91 | do |
||

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

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

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

95 | next_element eq_equiv g sorted pending frontier; |
||

96 | done; |
||

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

98 | 22fe1c93 | ploc | !sorted |

99 | end |
||

100 | |||

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

102 | 22fe1c93 | ploc | try |

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

104 | let eq_equiv v1 v2 = |
||

105 | try |
||

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

107 | with Not_found -> false in |
||

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

109 | 8ea13d96 | xthirioux | Log.report ~level:5 (fun fmt -> Format.eprintf "dependency graph for node %s: %a" n'.node_id pp_dep_graph g); |

110 | a5784e75 | xthirioux | let gg = IdentDepGraph.copy g in |

111 | d4807c3d | xthirioux | let sort = topological_sort eq_equiv g in |

112 | a5784e75 | xthirioux | |

113 | 695d6f2f | xthirioux | let death = Liveness.death_table n gg sort in |

114 | Log.report ~level:5 (fun fmt -> Format.eprintf "death table for node %s: %a" n'.node_id Liveness.pp_death_table death); |
||

115 | 7afcba5a | xthirioux | |

116 | 695d6f2f | xthirioux | let reuse = Liveness.reuse_policy n sort death in |

117 | Log.report ~level:5 (fun fmt -> Format.eprintf "reuse policy for node %s: %a" n'.node_id Liveness.pp_reuse_policy reuse); |
||

118 | 7afcba5a | xthirioux | |

119 | 695d6f2f | xthirioux | n', sort |

120 | 22fe1c93 | ploc | (* let sorted = TopologicalDepGraph.fold (fun x res -> if ExprDep.is_instance_var x then res else x::res) g []*) |

121 | with (Causality.Cycle v) as exc -> |
||

122 | pp_error Format.err_formatter v; |
||

123 | raise exc |
||

124 | |||

125 | |||

126 | (* Local Variables: *) |
||

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

128 | (* End: *) |