Project

General

Profile

Download (12.3 KB) Statistics
| Branch: | Tag: | Revision:
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 in-degree 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 quasi-reusable 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
(* compile-command:"make -C .." *)
287
(* End: *)
(5-5/6)