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 fanin = Hashtbl.create 23 in

31

begin

32

IdentDepGraph.iter_vertex (fun v > if ISet.mem v locals then Hashtbl.add fanin v (IdentDepGraph.in_degree g v)) g;

33

fanin

34

end

35


36

let pp_fanin fmt fanin =

37

begin

38

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

39

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

40

Format.fprintf fmt "}@."

41

end

42


43

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

44

*)

45

let cone_of_influence g var =

46

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

47

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

48

let coi = ref ISet.empty in

49

while not (ISet.is_empty !frontier)

50

do

51

let head = ISet.min_elt !frontier in

52

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

53

frontier := ISet.remove head !frontier;

54

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

55

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

56

done;

57

!coi

58


59

let compute_unused_variables n g =

60

let inputs = ExprDep.node_input_variables n in

61

let mems = ExprDep.node_memory_variables n in

62

let outputs = ExprDep.node_output_variables n in

63

ISet.fold

64

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

65

(ISet.union outputs mems)

66

(ISet.union inputs mems)

67


68

(* computes the set of potentially reusable variables.

69

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

70

let node_reusable_variables node =

71

let mems = ExprDep.node_memory_variables node in

72

List.fold_left

73

(fun acc l >

74

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

75

Disjunction.CISet.empty

76

node.node_locals

77


78

let kill_root ctx head =

79

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

80


81

(* Recursively removes useless variables,

82

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

83

 [evaluated] is the set of already evaluated variables,

84

wrt the scheduling

85

 does only remove edges, not variables themselves

86

*)

87

let remove_roots ctx =

88

let rem = ref true in

89

let remaining = ref ctx.evaluated in

90

while !rem

91

do

92

rem := false;

93

let all_roots = graph_roots ctx.dep_graph in

94

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

95

if not (Disjunction.CISet.is_empty frontier_roots) then

96

begin

97

rem := true;

98

Disjunction.CISet.iter (kill_root ctx) frontier_roots;

99

remaining := Disjunction.CISet.diff !remaining frontier_roots

100

end

101

done

102


103

(* checks whether a variable is aliasable,

104

depending on its (address) type *)

105

let is_aliasable var =

106

Types.is_address_type var.var_type

107


108

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

109

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

110

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

111

let is_aliasable_input node var =

112

let eq_var = get_node_eq var node in

113

let inputs_var =

114

match NodeDep.get_callee eq_var.eq_rhs with

115

 None > []

116

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

117

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

118


119

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

120

[v'] is a dead variable

121

*)

122

let replace_in_dep_graph v v' g =

123

begin

124

IdentDepGraph.add_vertex g v';

125

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

126

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

127

IdentDepGraph.remove_vertex g v

128

end

129


130

let pp_reuse_policy fmt policy =

131

begin

132

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

133

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

134

Format.fprintf fmt "}@."

135

end

136


137

let pp_context fmt ctx =

138

begin

139

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

140

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

141

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

142

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

143

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

144

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

145

end

146


147

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

148

once [var] has been evaluated

149

 [locals] is the set of potentially reusable variables

150

 [evaluated] is the set of evaluated variables

151

 [quasi] is the set of quasireusable variables

152

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

153

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

154

*)

155

let compute_dependencies heads ctx =

156

begin

157

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

158

List.iter (kill_root ctx) heads;

159

remove_roots ctx;

160

end

161


162

let compute_evaluated heads ctx =

163

begin

164

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

165

end

166


167

let compute_reuse node ctx var =

168

let aliasable = is_aliasable_input node var.var_id in

169

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

170

let eligible v =

171

Typing.eq_ground var.var_type v.var_type

172

&& not (aliasable v) in

173

let locally_reusable v =

174

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

175

let eligibles = Disjunction.CISet.filter eligible ctx.evaluated in

176

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

177

try

178

let disjoint_live = Disjunction.CISet.inter disjoint live in

179

let reuse = Disjunction.CISet.max_elt disjoint_live in

180

begin

181

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

182

Hashtbl.add ctx.policy var.var_id (Hashtbl.find ctx.policy reuse.var_id);

183

end

184

with Not_found >

185

try

186

let reuse = Disjunction.CISet.choose dead in

187

begin

188

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

189

Hashtbl.add ctx.policy var.var_id (Hashtbl.find ctx.policy reuse.var_id);

190

end

191

with Not_found >

192

begin

193

Hashtbl.add ctx.policy var.var_id var;

194

end

195


196

let compute_reuse_policy node schedule disjoint g =

197

let sort = ref schedule in

198

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

199

dep_graph = g;

200

disjoint = disjoint;

201

policy = Hashtbl.create 23; } in

202

while !sort <> []

203

do

204

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

205

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

206

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

207

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

208

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

209

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

210

compute_dependencies heads ctx;

211

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

212

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

213

List.iter (compute_reuse node ctx) heads;

214

compute_evaluated heads ctx;

215

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;

216

sort := List.tl !sort;

217

done;

218

IdentDepGraph.clear ctx.dep_graph;

219

ctx.policy

220


221

(* Reuse policy:

222

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

223

 reusing variables with different types would involve:

224

 either dirty castings

225

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

226

... it seems too complex and potentially unsafe

227

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

228

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

229

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

230

 once a policy is set, we need to:

231

 replace each variable by its reuse alias.

232

 simplify resulting equations, as we may now have:

233

x = x; > ; for scalar vars

234

or:

235

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

236

*)

237


238


239

(* the reuse policy seeks to use less local variables

240

by replacing local variables, applying the rules

241

in the following order:

242

1) use another clock disjoint still live variable,

243

with the greatest possible disjoint clock

244

2) reuse a dead variable

245

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

246

 with the same type

247

 not aliasable (i.e. address type)

248

*)

249


250

(* Local Variables: *)

251

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

252

(* End: *)
