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


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 "DEBUG coi: %s@." var;*)

53

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

54

let explored = ref ISet.empty in

55

let coi = ref ISet.empty in

56

while not (ISet.is_empty !frontier)

57

do

58

let head = ISet.min_elt !frontier in

59

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

60

frontier := ISet.remove head !frontier;

61

explored := ISet.add head !explored;

62

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

63

List.iter (fun s > if not (ISet.mem s !explored) then frontier := ISet.add s !frontier) (IdentDepGraph.succ g head);

64

done;

65

!coi

66


67

let compute_unused_variables n g =

68

let inputs = ExprDep.node_input_variables n in

69

let mems = ExprDep.node_memory_variables n in

70

let outputs = ExprDep.node_output_variables n in

71

ISet.fold

72

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

73

(ISet.union outputs mems)

74

(ISet.union inputs mems)

75


76

(* computes the set of potentially reusable variables.

77

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

78

let node_reusable_variables node =

79

let mems = ExprDep.node_memory_variables node in

80

List.fold_left

81

(fun acc l >

82

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

83

Disjunction.CISet.empty

84

node.node_locals

85


86

let kill_instance_variables ctx inst =

87

IdentDepGraph.remove_vertex ctx.dep_graph inst

88


89

let kill_root ctx head =

90

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

91


92

(* Recursively removes useless variables,

93

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

94

 [evaluated] is the set of already evaluated variables,

95

wrt the scheduling

96

 does only remove edges, not variables themselves

97

 yet, instance variables are removed

98

*)

99

let remove_roots ctx =

100

let rem = ref true in

101

let remaining = ref ctx.evaluated in

102

while !rem

103

do

104

rem := false;

105

let all_roots = graph_roots ctx.dep_graph in

106

let inst_roots, var_roots = List.partition (fun v > ExprDep.is_instance_var v && v <> Causality.world) all_roots in

107

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

108

if not (Disjunction.CISet.is_empty frontier_roots && inst_roots = []) then

109

begin

110

rem := true;

111

List.iter (kill_instance_variables ctx) inst_roots;

112

Disjunction.CISet.iter (kill_root ctx) frontier_roots;

113

remaining := Disjunction.CISet.diff !remaining frontier_roots

114

end

115

done

116


117

(* checks whether a variable is aliasable,

118

depending on its (address) type *)

119

let is_aliasable var =

120

(not (!Options.mpfr && Types.is_real_type var.var_type)) && Types.is_address_type var.var_type

121


122

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

123

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

124

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

125

let is_aliasable_input node var =

126

let eq_var = get_node_eq var node in

127

let inputs_var =

128

match NodeDep.get_callee eq_var.eq_rhs with

129

 None > []

130

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

131

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

132


133

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

134

[v'] is a dead variable

135

*)

136

let replace_in_dep_graph v v' g =

137

begin

138

IdentDepGraph.add_vertex g v';

139

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

140

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

141

IdentDepGraph.remove_vertex g v

142

end

143


144

let pp_reuse_policy fmt policy =

145

begin

146

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

147

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

148

Format.fprintf fmt "}@."

149

end

150


151

let pp_context fmt ctx =

152

begin

153

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

154

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

155

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

156

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

157

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

158

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

159

end

160


161

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

162

once [var] has been evaluated

163

 [locals] is the set of potentially reusable variables

164

 [evaluated] is the set of evaluated variables

165

 [quasi] is the set of quasireusable variables

166

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

167

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

168

*)

169

let compute_dependencies heads ctx =

170

begin

171

(*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);*)

172

List.iter (kill_root ctx) heads;

173

remove_roots ctx;

174

end

175


176

let compute_evaluated heads ctx =

177

begin

178

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

179

end

180


181

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

182

 [v] has been really used ([v] is its own representative)

183

 same type

184

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

185

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

186

 [v] is not currently in use

187

*)

188

let eligible node ctx heads var v =

189

Hashtbl.find ctx.policy v.var_id == v

190

&& Typing.eq_ground (Types.unclock_type var.var_type) (Types.unclock_type v.var_type)

191

&& not (is_aliasable_input node var.var_id v)

192

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

193

&& (*let repr_v = Hashtbl.find ctx.policy v.var_id*)

194

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

195


196

let compute_reuse node ctx heads var =

197

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

198

let locally_reusable v =

199

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

200

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

201

Log.report ~level:7 (fun fmt > Format.fprintf fmt "eligibles:%a@." Disjunction.pp_ciset eligibles);

202

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

203

Log.report ~level:7 (fun fmt > Format.fprintf fmt "live:%a@." Disjunction.pp_ciset live);

204

try

205

let disjoint_live = Disjunction.CISet.inter disjoint live in

206

Log.report ~level:7 (fun fmt > Format.fprintf fmt "disjoint live:%a@." Disjunction.pp_ciset disjoint_live);

207

let reuse = Disjunction.CISet.max_elt disjoint_live in

208

begin

209

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

210

Hashtbl.add ctx.policy var.var_id reuse;

211

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

212

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

213

end

214

with Not_found >

215

try

216

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

217

Log.report ~level:7 (fun fmt > Format.fprintf fmt "dead:%a@." Disjunction.pp_ciset dead);

218

let reuse = Disjunction.CISet.choose dead in

219

begin

220

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

221

Hashtbl.add ctx.policy var.var_id reuse;

222

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

223

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

224

end

225

with Not_found >

226

begin

227

Hashtbl.add ctx.policy var.var_id var;

228

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

229

end

230


231

let compute_reuse_policy node schedule disjoint g =

232

let sort = ref schedule in

233

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

234

dep_graph = g;

235

disjoint = disjoint;

236

policy = Hashtbl.create 23; } in

237

while !sort <> []

238

do

239

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

240

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

241

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

242

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

243

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

244

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

245

compute_dependencies heads ctx;

246

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

247

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

248

List.iter (compute_reuse node ctx heads) heads;

249

(*compute_evaluated heads ctx;*)

250

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;

251

sort := List.tl !sort;

252

done;

253

IdentDepGraph.clear ctx.dep_graph;

254

ctx.policy

255


256

(* Reuse policy:

257

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

258

 reusing variables with different types would involve:

259

 either dirty castings

260

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

261

... it seems too complex and potentially unsafe

262

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

263

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

264

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

265

 once a policy is set, we need to:

266

 replace each variable by its reuse alias.

267

 simplify resulting equations, as we may now have:

268

x = x; > ; for scalar vars

269

or:

270

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

271

*)

272


273


274

(* the reuse policy seeks to use less local variables

275

by replacing local variables, applying the rules

276

in the following order:

277

1) use another clock disjoint still live variable,

278

with the greatest possible disjoint clock

279

2) reuse a dead variable

280

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

281

 with the same type

282

 not aliasable (i.e. address type)

283

*)

284


285

(* Local Variables: *)

286

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

287

(* End: *)
