1

(* 

2

* SchedMCore  A MultiCore Scheduling Framework

3

* Copyright (C) 20092013, ONERA, Toulouse, FRANCE  LIFL, Lille, FRANCE

4

* Copyright (C) 20122013, 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 021111307

21

* USA

22

* *)

23


24

(* This module is used for the lustre to C compiler *)

25


26

open Utils

27

open LustreSpec

28

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

begin

58

if ISet.is_empty !pending

59

then

60

begin

61

let choice = ISet.min_elt !frontier in

62

(*Format.eprintf "1> %s@." choice;*)

63

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

(*Format.eprintf "2> %s@." choice;*)

74

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


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

IdentDepGraph.clear g;

98

!sorted

99

end

100


101

let schedule_node n =

102

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

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

110

let gg = IdentDepGraph.copy g in

111

let sort = topological_sort eq_equiv g in

112


113

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


116

let disjoint = Disjunction.clock_disjoint_map (node_vars n) in

117

Log.report ~level:5 (fun fmt > Format.eprintf "clock disjoint map for node %s: %a" n'.node_id Disjunction.pp_disjoint_map disjoint);

118


119

let reuse = Liveness.reuse_policy n sort death in

120

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

121


122

n', sort

123

(* let sorted = TopologicalDepGraph.fold (fun x res > if ExprDep.is_instance_var x then res else x::res) g []*)

124

with (Causality.Cycle v) as exc >

125

pp_error Format.err_formatter v;

126

raise exc

127


128


129

(* Local Variables: *)

130

(* compilecommand:"make C .." *)

131

(* End: *)
