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 LustreSpec

14

open Corelang

15

open Graph

16

open Causality

17


18

type context =

19

{

20

mutable evaluated : Disjunction.CISet.t;

21

dep_graph : IdentDepGraph.t;

22

disjoint : (ident, Disjunction.CISet.t) Hashtbl.t;

23

policy : (ident, var_decl) Hashtbl.t;

24

}

25


26

(* computes the indegree for each local variable of node [n], according to dep graph [g].

27

*)

28

let compute_fanin n g =

29

let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in

30

let inputs = ExprDep.node_input_variables n in

31

let fanin = Hashtbl.create 23 in

32

begin

33

IdentDepGraph.iter_vertex

34

(fun v >

35

if ISet.mem v locals

36

then Hashtbl.add fanin v (IdentDepGraph.in_degree g v) else

37

if ExprDep.is_read_var v && not (ISet.mem v inputs)

38

then Hashtbl.add fanin (ExprDep.undo_read_var v) (IdentDepGraph.in_degree g v)) g;

39

fanin

40

end

41


42

let pp_fanin fmt fanin =

43

begin

44

Format.fprintf fmt "{ /* locals fanin: */@.";

45

Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %d@." s t) fanin;

46

Format.fprintf fmt "}@."

47

end

48


49

(* computes the cone of influence of a given [var] wrt a dependency graph [g].

50

*)

51

let cone_of_influence g var =

52

(*Format.printf "coi: %s@." var;*)

53

let frontier = ref (ISet.add var ISet.empty) in

54

let coi = ref ISet.empty in

55

while not (ISet.is_empty !frontier)

56

do

57

let head = ISet.min_elt !frontier in

58

(*Format.printf "head: %s@." head;*)

59

frontier := ISet.remove head !frontier;

60

if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi;

61

List.iter (fun s > frontier := ISet.add s !frontier) (IdentDepGraph.succ g head);

62

done;

63

!coi

64


65

let compute_unused_variables n g =

66

let inputs = ExprDep.node_input_variables n in

67

let mems = ExprDep.node_memory_variables n in

68

let outputs = ExprDep.node_output_variables n in

69

ISet.fold

70

(fun var unused > ISet.diff unused (cone_of_influence g var))

71

(ISet.union outputs mems)

72

(ISet.union inputs mems)

73


74

(* computes the set of potentially reusable variables.

75

We don't reuse input variables, due to possible aliasing *)

76

let node_reusable_variables node =

77

let mems = ExprDep.node_memory_variables node in

78

List.fold_left

79

(fun acc l >

80

if ISet.mem l.var_id mems then acc else Disjunction.CISet.add l acc)

81

Disjunction.CISet.empty

82

node.node_locals

83


84

let kill_root ctx head =

85

IdentDepGraph.iter_succ (IdentDepGraph.remove_edge ctx.dep_graph head.var_id) ctx.dep_graph head.var_id

86


87

(* Recursively removes useless variables,

88

i.e. [ctx.evaluated] variables that are current roots of the dep graph [ctx.dep_graph]

89

 [evaluated] is the set of already evaluated variables,

90

wrt the scheduling

91

 does only remove edges, not variables themselves

92

*)

93

let remove_roots ctx =

94

let rem = ref true in

95

let remaining = ref ctx.evaluated in

96

while !rem

97

do

98

rem := false;

99

let all_roots = graph_roots ctx.dep_graph in

100

let frontier_roots = Disjunction.CISet.filter (fun v > List.mem v.var_id all_roots) !remaining in

101

if not (Disjunction.CISet.is_empty frontier_roots) then

102

begin

103

rem := true;

104

Disjunction.CISet.iter (kill_root ctx) frontier_roots;

105

remaining := Disjunction.CISet.diff !remaining frontier_roots

106

end

107

done

108


109

(* checks whether a variable is aliasable,

110

depending on its (address) type *)

111

let is_aliasable var =

112

Types.is_address_type var.var_type

113


114

(* checks whether a variable [v] is an input of the [var] equation, with an address type.

115

if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node,

116

because [v] may not be dead in the callee node when [var] is assigned *)

117

let is_aliasable_input node var =

118

let eq_var = get_node_eq var node in

119

let inputs_var =

120

match NodeDep.get_callee eq_var.eq_rhs with

121

 None > []

122

 Some (_, args) > List.fold_right (fun e r > match e.expr_desc with Expr_ident id > id::r  _ > r) args [] in

123

fun v > is_aliasable v && List.mem v.var_id inputs_var

124


125

(* replace variable [v] by [v'] in graph [g].

126

[v'] is a dead variable

127

*)

128

let replace_in_dep_graph v v' g =

129

begin

130

IdentDepGraph.add_vertex g v';

131

IdentDepGraph.iter_succ (fun s > IdentDepGraph.add_edge g v' s) g v;

132

IdentDepGraph.iter_pred (fun p > IdentDepGraph.add_edge g p v') g v;

133

IdentDepGraph.remove_vertex g v

134

end

135


136

let pp_reuse_policy fmt policy =

137

begin

138

Format.fprintf fmt "{ /* reuse policy */@.";

139

Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %s@." s t.var_id) policy;

140

Format.fprintf fmt "}@."

141

end

142


143

let pp_context fmt ctx =

144

begin

145

Format.fprintf fmt "{ /*BEGIN context */@.";

146

Format.fprintf fmt "eval=%a;@." Disjunction.pp_ciset ctx.evaluated;

147

Format.fprintf fmt "graph=%a;@." pp_dep_graph ctx.dep_graph;

148

Format.fprintf fmt "disjoint=%a;@." Disjunction.pp_disjoint_map ctx.disjoint;

149

Format.fprintf fmt "policy=%a;@." pp_reuse_policy ctx.policy;

150

Format.fprintf fmt "/* END context */ }@.";

151

end

152


153

(* computes the reusable dependencies of variable [var] in graph [g],

154

once [var] has been evaluated

155

 [locals] is the set of potentially reusable variables

156

 [evaluated] is the set of evaluated variables

157

 [quasi] is the set of quasireusable variables

158

 [reusable] is the set of dead/reusable dependencies of [var] in graph [g]

159

 [policy] is the reuse map (which domain is [evaluated])

160

*)

161

let compute_dependencies heads ctx =

162

begin

163

(*Log.report ~level:6 (fun fmt > Format.fprintf fmt "compute_reusable_dependencies %a %a %a@." Disjunction.pp_ciset locals Printers.pp_var_name var pp_context ctx);*)

164

List.iter (kill_root ctx) heads;

165

remove_roots ctx;

166

end

167


168

let compute_evaluated heads ctx =

169

begin

170

List.iter (fun head > ctx.evaluated < Disjunction.CISet.add head ctx.evaluated) heads;

171

end

172


173

(* tests whether a variable [v] may be (re)used instead of [var]. The conditions are:

174

 same type

175

 [v] is not an aliasable input of the equation defining [var]

176

 [v] is not one of the current heads (which contain [var])

177

 the representative of [v] is not currently in use

178

*)

179

let eligible node ctx heads var v =

180

Typing.eq_ground var.var_type v.var_type

181

&& not (is_aliasable_input node var.var_id v)

182

&& not (List.exists (fun h > h.var_id = v.var_id) heads)

183

&& let repr_v = Hashtbl.find ctx.policy v.var_id

184

in not (Disjunction.CISet.exists (fun p > IdentDepGraph.mem_edge ctx.dep_graph p.var_id repr_v.var_id) ctx.evaluated)

185


186

let compute_reuse node ctx heads var =

187

let disjoint = Hashtbl.find ctx.disjoint var.var_id in

188

let locally_reusable v =

189

IdentDepGraph.fold_pred (fun p r > r && Disjunction.CISet.exists (fun d > p = d.var_id) disjoint) ctx.dep_graph v.var_id true in

190

let eligibles = Disjunction.CISet.filter (eligible node ctx heads var) ctx.evaluated in

191

let quasi_dead, live = Disjunction.CISet.partition locally_reusable eligibles in

192

try

193

let disjoint_live = Disjunction.CISet.inter disjoint live in

194

let reuse = Disjunction.CISet.max_elt disjoint_live in

195

let reuse' = Hashtbl.find ctx.policy reuse.var_id in

196

begin

197

IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;

198

if reuse != reuse' then IdentDepGraph.add_edge ctx.dep_graph reuse.var_id reuse'.var_id;

199

Hashtbl.add ctx.policy var.var_id reuse';

200

ctx.evaluated < Disjunction.CISet.add var ctx.evaluated;

201

(*Format.eprintf "%s reused by live@." var.var_id;*)

202

end

203

with Not_found >

204

try

205

let dead = Disjunction.CISet.filter (fun v > is_graph_root v.var_id ctx.dep_graph) quasi_dead in

206

let reuse = Disjunction.CISet.choose dead in

207

let reuse' = Hashtbl.find ctx.policy reuse.var_id in

208

begin

209

IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;

210

if reuse != reuse' then IdentDepGraph.add_edge ctx.dep_graph reuse.var_id reuse'.var_id;

211

Hashtbl.add ctx.policy var.var_id reuse';

212

ctx.evaluated < Disjunction.CISet.add var ctx.evaluated;

213

(*Format.eprintf "%s reused by dead %a@." var.var_id Disjunction.pp_ciset dead;*)

214

end

215

with Not_found >

216

begin

217

Hashtbl.add ctx.policy var.var_id var;

218

ctx.evaluated < Disjunction.CISet.add var ctx.evaluated;

219

end

220


221

let compute_reuse_policy node schedule disjoint g =

222

let sort = ref schedule in

223

let ctx = { evaluated = Disjunction.CISet.empty;

224

dep_graph = g;

225

disjoint = disjoint;

226

policy = Hashtbl.create 23; } in

227

while !sort <> []

228

do

229

Log.report ~level:6 (fun fmt > Format.fprintf fmt "new context:%a@." pp_context ctx);

230

let heads = List.map (fun v > get_node_var v node) (List.hd !sort) in

231

Log.report ~level:6 (fun fmt > Format.fprintf fmt "NEW HEADS:");

232

List.iter (fun head > Log.report ~level:6 (fun fmt > Format.fprintf fmt "%s " head.var_id)) heads;

233

Log.report ~level:6 (fun fmt > Format.fprintf fmt "@.");

234

Log.report ~level:6 (fun fmt > Format.fprintf fmt "COMPUTE_DEPENDENCIES@.");

235

compute_dependencies heads ctx;

236

Log.report ~level:6 (fun fmt > Format.fprintf fmt "new context:%a@." pp_context ctx);

237

Log.report ~level:6 (fun fmt > Format.fprintf fmt "COMPUTE_REUSE@.");

238

List.iter (compute_reuse node ctx heads) heads;

239

(*compute_evaluated heads ctx;*)

240

List.iter (fun head > Log.report ~level:6 (fun fmt > Format.fprintf fmt "reuse %s instead of %s@." (Hashtbl.find ctx.policy head.var_id).var_id head.var_id)) heads;

241

sort := List.tl !sort;

242

done;

243

IdentDepGraph.clear ctx.dep_graph;

244

ctx.policy

245


246

(* Reuse policy:

247

 could reuse variables with the same type exactly only (simple).

248

 reusing variables with different types would involve:

249

 either dirty castings

250

 or complex inclusion expression (for instance: array <> array cell, struct <> struct field) to be able to reuse only some parts of structured data.

251

... it seems too complex and potentially unsafe

252

 for node instance calls: output variables could NOT reuse aliasable input variables,

253

even if inputs become dead, because the correctness would depend on the scheduling

254

of the callee (so, the compiling strategy could NOT be modular anymore).

255

 once a policy is set, we need to:

256

 replace each variable by its reuse alias.

257

 simplify resulting equations, as we may now have:

258

x = x; > ; for scalar vars

259

or:

260

x = &{ f1 = x>f1; f2 = t; } > x>f2 = t; for struct vars

261

*)

262


263


264

(* the reuse policy seeks to use less local variables

265

by replacing local variables, applying the rules

266

in the following order:

267

1) use another clock disjoint still live variable,

268

with the greatest possible disjoint clock

269

2) reuse a dead variable

270

For the sake of safety, we replace variables by others:

271

 with the same type

272

 not aliasable (i.e. address type)

273

*)

274


275

(* Local Variables: *)

276

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

277

(* End: *)
