1

(********************************************************************)

2

(* *)

3

(* The LustreC compiler toolset / The LustreC Development Team *)

4

(* Copyright 2012   ONERA  CNRS  INPT *)

5

(* *)

6

(* LustreC is free software, distributed WITHOUT ANY WARRANTY *)

7

(* under the terms of the GNU Lesser General Public License *)

8

(* version 2.1. *)

9

(* *)

10

(********************************************************************)

11


12

open Utils

13

open Lustre_types

14

open Corelang

15

open Graph

16

open Causality

17

open Scheduling_type

18


19

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

20

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

21

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

22

Moreover, the dependency graph is browsed in a depthfirst manner whenever possible,

23

to improve the behavior of optimization algorithms applied in forthcoming compilation steps.

24

In the following functions:

25

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

26

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

27

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

28

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

29

 [sort] is the resulting topological order

30

*)

31


32

(* Checks whether the currently scheduled variable [choice]

33

is an output of a call, possibly among others *)

34

let is_call_output choice g =

35

List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice)

36


37

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

38

then removes [v] from [g]

39

*)

40

let add_successors eq_equiv g v pending frontier =

41

let succs_v = IdentDepGraph.succ g v in

42

begin

43

IdentDepGraph.remove_vertex g v;

44

List.iter

45

(fun v' >

46

if is_graph_root v' g then

47

(if eq_equiv v v' then

48

pending := ISet.add v' !pending

49

else

50

frontier := ISet.add v' !frontier)

51

) succs_v;

52

end

53


54

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

55

Modifies [pending] and [frontier] accordingly.

56

*)

57

let next_element eq_equiv g sort call pending frontier =

58

begin

59

if ISet.is_empty !pending

60

then

61

begin

62

let choice = ISet.min_elt !frontier in

63

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

64

frontier := ISet.remove choice !frontier;

65

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

66

pending := p;

67

frontier := f;

68

call := is_call_output choice g;

69

add_successors eq_equiv g choice pending frontier;

70

if not (ExprDep.is_ghost_var choice)

71

then sort := [choice] :: !sort

72

end

73

else

74

begin

75

let choice = ISet.min_elt !pending in

76

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

77

pending := ISet.remove choice !pending;

78

add_successors eq_equiv g choice pending frontier;

79

if not (ExprDep.is_ghost_var choice)

80

then sort := (if !call

81

then (choice :: List.hd !sort) :: List.tl !sort

82

else [choice] :: !sort)

83

end

84

end

85


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 call = ref false in

93

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

94

let pending = ref ISet.empty in

95

let sorted = ref [] in

96

begin

97

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

98

do

99

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

100

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

101

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

102

next_element eq_equiv g sorted call pending frontier;

103

done;

104

IdentDepGraph.clear g;

105

!sorted

106

end

107


108

(* Filters out normalization variables and renames instance variables to keep things readable,

109

in a case of a dependency error *)

110

let filter_original n vl =

111

List.fold_right (fun v res >

112

if ExprDep.is_instance_var v then Format.sprintf "node %s" (ExprDep.undo_instance_var v) :: res else

113

let vdecl = get_node_var v n in

114

if vdecl.var_orig then v :: res else res) vl []

115


116

let schedule_node n =

117

(* let node_vars = get_node_vars n in *)

118

let eq_equiv = ExprDep.node_eq_equiv n in

119

let eq_equiv v1 v2 =

120

try

121

Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2

122

with Not_found > false in

123


124

let n', g = global_dependency n in

125


126

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

127

compute: coi predecessors of outputs

128

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

129

DONE !

130

*)

131


132

let gg = IdentDepGraph.copy g in

133

let sort = topological_sort eq_equiv g in

134

let unused = Liveness.compute_unused_variables n gg in

135

let fanin = Liveness.compute_fanin n gg in

136

{ node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; }

137


138


139

let compute_node_reuse_table report =

140

let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in

141

let reuse = Liveness.compute_reuse_policy report.node report.schedule disjoint report.dep_graph in

142

(*

143

if !Options.print_reuse

144

then

145

begin

146

Log.report ~level:0

147

(fun fmt >

148

Format.fprintf fmt

149

"OPT:%B@." (try (Hashtbl.iter (fun s1 v2 > if s1 = v2.var_id then raise Not_found) reuse; false) with Not_found > true)

150

);

151

Log.report ~level:0

152

(fun fmt >

153

Format.fprintf fmt

154

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

155

n'.node_id

156

Disjunction.pp_disjoint_map disjoint

157

);

158

Log.report ~level:0

159

(fun fmt >

160

Format.fprintf fmt

161

"OPT:reuse policy for node %s: %a"

162

n'.node_id

163

Liveness.pp_reuse_policy reuse

164

);

165

end;

166

*)

167

reuse

168


169


170

let schedule_prog prog =

171

List.fold_right (

172

fun top_decl (accu_prog, sch_map) >

173

match top_decl.top_decl_desc with

174

 Node nd >

175

let report = schedule_node nd in

176

{top_decl with top_decl_desc = Node report.node}::accu_prog,

177

IMap.add nd.node_id report sch_map

178

 _ > top_decl::accu_prog, sch_map

179

)

180

prog

181

([],IMap.empty)

182


183


184

let compute_prog_reuse_table report =

185

IMap.map compute_node_reuse_table report

186


187

(* removes inlined local variables from schedule report,

188

which are now useless *)

189

let remove_node_inlined_locals locals report =

190

let is_inlined v = IMap.exists (fun l _ > v = l) locals in

191

let schedule' =

192

List.fold_right (fun heads q > let heads' = List.filter (fun v > not (is_inlined v)) heads

193

in if heads' = [] then q else heads'::q)

194

report.schedule [] in

195

begin

196

IMap.iter (fun v _ > Hashtbl.remove report.fanin_table v) locals;

197

IMap.iter (fun v _ > let iv = ExprDep.mk_instance_var v

198

in Liveness.replace_in_dep_graph v iv report.dep_graph) locals;

199

{ report with schedule = schedule' }

200

end

201


202

let remove_prog_inlined_locals removed reuse =

203

IMap.mapi (fun id > remove_node_inlined_locals (IMap.find id removed)) reuse

204


205

let pp_eq_schedule fmt vl =

206

match vl with

207

 [] > assert false

208

 [v] > Format.fprintf fmt "%s" v

209

 _ > Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v > Format.fprintf fmt "%s" v)) vl

210


211

let pp_schedule fmt node_schs =

212

IMap.iter

213

(fun nd report >

214

Format.fprintf fmt "%s schedule: %a@."

215

nd

216

(fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)

217

node_schs

218


219

let pp_fanin_table fmt node_schs =

220

IMap.iter

221

(fun nd report >

222

Format.fprintf fmt "%s: %a" nd Liveness.pp_fanin report.fanin_table)

223

node_schs

224


225

let pp_dep_graph fmt node_schs =

226

IMap.iter

227

(fun nd report >

228

Format.fprintf fmt "%s dependency graph: %a" nd pp_dep_graph report.dep_graph)

229

node_schs

230


231

let pp_warning_unused fmt node_schs =

232

IMap.iter

233

(fun nd report >

234

let unused = report.unused_vars in

235

if not (ISet.is_empty unused)

236

then

237

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

238

ISet.iter

239

(fun u >

240

let vu = get_node_var u nd in

241

if vu.var_orig

242

then Format.fprintf fmt " Warning: variable '%s' seems unused@, %a@,@," u Location.pp_loc vu.var_loc)

243

unused

244

)

245

node_schs

246


247


248

(* Local Variables: *)

249

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

250

(* End: *)
