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

type schedule_report =

33

{

34

schedule : ident list;

35

unused_vars : ISet.t;

36

death_table : (ident, ISet.t) Hashtbl.t

37

}

38


39

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

40

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

41

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

42

In the following functions:

43

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

44

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

45

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

46

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

47

 [sort] is the resulting topological order

48

*)

49

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

50

then removes [v] from [g]

51

*)

52

let add_successors eq_equiv g v pending frontier =

53

let succs_v = IdentDepGraph.succ g v in

54

begin

55

IdentDepGraph.remove_vertex g v;

56

List.iter

57

(fun v' >

58

if is_graph_root v' g then

59

(if eq_equiv v v' then

60

pending := ISet.add v' !pending

61

else

62

frontier := ISet.add v' !frontier)

63

) succs_v;

64

end

65


66

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

67

Modifies [pending] and [frontier] accordingly.

68

*)

69

let next_element eq_equiv g sort pending frontier =

70

begin

71

if ISet.is_empty !pending

72

then

73

begin

74

let choice = ISet.min_elt !frontier in

75

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

76

frontier := ISet.remove choice !frontier;

77

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

78

pending := p;

79

frontier := f;

80

add_successors eq_equiv g choice pending frontier;

81

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

82

end

83

else

84

begin

85

let choice = ISet.min_elt !pending in

86

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

87

pending := ISet.remove choice !pending;

88

add_successors eq_equiv g choice pending frontier;

89

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

90

end

91

end

92


93


94

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

95

*)

96

let topological_sort eq_equiv g =

97

let roots = graph_roots g in

98

assert (roots <> []);

99

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

100

let pending = ref ISet.empty in

101

let sorted = ref [] in

102

begin

103

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

104

do

105

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

106

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

107

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

108

next_element eq_equiv g sorted pending frontier;

109

done;

110

IdentDepGraph.clear g;

111

!sorted

112

end

113


114

let schedule_node n =

115

try

116

let eq_equiv = ExprDep.node_eq_equiv n in

117

let eq_equiv v1 v2 =

118

try

119

Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2

120

with Not_found > false in

121


122

let n', g = global_dependency n in

123

Log.report ~level:5

124

(fun fmt >

125

Format.eprintf

126

"dependency graph for node %s: %a"

127

n'.node_id

128

pp_dep_graph g

129

);

130


131

(* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs

132

compute: coi predecessors of outputs

133

warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)

134

*)

135


136

let gg = IdentDepGraph.copy g in

137

let sort = topological_sort eq_equiv g in

138

let unused = Liveness.compute_unused n gg in

139

let death = Liveness.death_table n gg sort in

140

Log.report ~level:5

141

(fun fmt >

142

Format.eprintf

143

"death table for node %s: %a"

144

n'.node_id

145

Liveness.pp_death_table death

146

);

147


148

let disjoint = Disjunction.clock_disjoint_map (node_vars n) in

149


150

Log.report ~level:5

151

(fun fmt >

152

Format.eprintf

153

"clock disjoint map for node %s: %a"

154

n'.node_id

155

Disjunction.pp_disjoint_map disjoint

156

);

157


158

let reuse = Liveness.reuse_policy n sort death in

159

Log.report ~level:5

160

(fun fmt >

161

Format.eprintf

162

"reuse policy for node %s: %a"

163

n'.node_id

164

Liveness.pp_reuse_policy reuse

165

);

166


167

n', { schedule = sort; unused_vars = unused; death_table = death }

168

with (Causality.Cycle v) as exc >

169

pp_error Format.err_formatter v;

170

raise exc

171


172

let schedule_prog prog =

173

List.fold_right (

174

fun top_decl (accu_prog, sch_map) >

175

match top_decl.top_decl_desc with

176

 Node nd >

177

let nd', report = schedule_node nd in

178

{top_decl with top_decl_desc = Node nd'}::accu_prog,

179

IMap.add nd.node_id report sch_map

180

 _ > top_decl::accu_prog, sch_map

181

)

182

prog

183

([],IMap.empty)

184


185

let pp_warning_unused fmt node_schs =

186

IMap.iter

187

(fun nd report >

188

let unused = report.unused_vars in

189

if not (ISet.is_empty unused)

190

then

191

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

192

ISet.iter

193

(fun u >

194

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

195

u

196

Location.pp_loc (node_var u nd).var_loc)

197

unused

198

)

199

node_schs

200


201

(* Local Variables: *)

202

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

203

(* End: *)
