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 Corelang

28

open Graph

29

open Causality

30


31


32

(* Tests whether [v] is a root of graph [g], i.e. a source *)

33

let is_graph_root v g =

34

IdentDepGraph.in_degree g v = 0

35


36

(* Computes the set of graph roots, i.e. the sources of acyclic graph [g] *)

37

let graph_roots g =

38

IdentDepGraph.fold_vertex

39

(fun v roots > if is_graph_root v g then v::roots else roots)

40

g []

41


42

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

43

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

44

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

45

In the following functions:

46

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

47

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

48

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

49

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

50

 [sort] is the resulting topological order

51

*)

52

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

53

then removes [v] from [g]

54

*)

55

let add_successors eq_equiv g v pending frontier =

56

let succs_v = IdentDepGraph.succ g v in

57

begin

58

IdentDepGraph.remove_vertex g v;

59

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;

60

end

61


62

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

63

Modifies [pending] and [frontier] accordingly.

64

*)

65

let next_element eq_equiv g sort pending frontier =

66

if ISet.is_empty !pending

67

then

68

begin

69

let choice = ISet.min_elt !frontier in

70

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

71

frontier := ISet.remove choice !frontier;

72

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

73

pending := p;

74

frontier := f;

75

add_successors eq_equiv g choice pending frontier;

76

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

77

end

78

else

79

begin

80

let choice = ISet.min_elt !pending in

81

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

82

pending := ISet.remove choice !pending;

83

add_successors eq_equiv g choice pending frontier;

84

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

85

end

86


87

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

88

*)

89

let topological_sort eq_equiv g =

90

let roots = graph_roots g in

91

assert (roots <> []);

92

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

93

let pending = ref ISet.empty in

94

let sorted = ref [] in

95

begin

96

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

97

do

98

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

99

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

100

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

101

next_element eq_equiv g sorted pending frontier;

102

done;

103

!sorted

104

end

105


106

let schedule_node n =

107

try

108

let eq_equiv = ExprDep.node_eq_equiv n in

109

let eq_equiv v1 v2 =

110

try

111

Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2

112

with Not_found > false in

113

let n', g = global_dependency n in

114

n', topological_sort eq_equiv g

115

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

116

with (Causality.Cycle v) as exc >

117

pp_error Format.err_formatter v;

118

raise exc

119


120


121

(* Local Variables: *)

122

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

123

(* End: *)
