Project

General

Profile

Download (12.2 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 Causality
16

    
17
type context =
18
{
19
  mutable evaluated : Disjunction.CISet.t;
20
  dep_graph : IdentDepGraph.t;
21
  disjoint : (ident, Disjunction.CISet.t) Hashtbl.t;
22
  policy : (ident, var_decl) Hashtbl.t;
23
}
24

    
25
(* computes the in-degree for each local variable of node [n], according to dep graph [g].
26
*)
27
let compute_fanin n g =
28
  let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in
29
  let inputs = ExprDep.node_input_variables n in
30
  let fanin = Hashtbl.create 23 in
31
  begin
32
    IdentDepGraph.iter_vertex
33
      (fun v ->
34
	if ISet.mem v locals
35
	then Hashtbl.add fanin v (IdentDepGraph.in_degree g v) else
36
	if ExprDep.is_read_var v && not (ISet.mem v inputs)
37
	then Hashtbl.add fanin (ExprDep.undo_read_var v) (IdentDepGraph.in_degree g v)) g;
38
    fanin
39
  end
40
 
41
let pp_fanin fmt fanin =
42
  begin
43
    Format.fprintf fmt "{ /* locals fanin: */@.";
44
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %d@." s t) fanin;
45
    Format.fprintf fmt "}@."
46
  end
47

    
48
(* computes the cone of influence of a given [var] wrt a dependency graph [g].
49
*)
50
let cone_of_influence g var =
51
 (*Format.printf "coi: %s@." var;*)
52
 let frontier = ref (ISet.add var ISet.empty) in
53
 let coi = ref ISet.empty in
54
 while not (ISet.is_empty !frontier)
55
 do
56
   let head = ISet.min_elt !frontier in
57
   (*Format.printf "head: %s@." head;*)
58
   frontier := ISet.remove head !frontier;
59
   if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi;
60
   List.iter (fun s -> frontier := ISet.add s !frontier) (IdentDepGraph.succ g head);
61
 done;
62
 !coi
63

    
64
let compute_unused_variables n g =
65
  let inputs = ExprDep.node_input_variables n in
66
  let mems = ExprDep.node_memory_variables n in
67
  let outputs = ExprDep.node_output_variables n in
68
  ISet.fold
69
    (fun var unused -> ISet.diff unused (cone_of_influence g var))
70
    (ISet.union outputs mems)
71
    (ISet.union inputs mems)
72

    
73
(* computes the set of potentially reusable variables.
74
   We don't reuse input variables, due to possible aliasing *)
75
let node_reusable_variables node =
76
  let mems = ExprDep.node_memory_variables node in
77
  List.fold_left
78
    (fun acc l ->
79
      if ISet.mem l.var_id mems then acc else Disjunction.CISet.add l acc)
80
    Disjunction.CISet.empty
81
    node.node_locals
82

    
83
let kill_instance_variables ctx inst =
84
  IdentDepGraph.remove_vertex ctx.dep_graph inst
85

    
86
let kill_root ctx head =
87
  IdentDepGraph.iter_succ (IdentDepGraph.remove_edge ctx.dep_graph head.var_id) ctx.dep_graph head.var_id
88

    
89
(* Recursively removes useless variables,
90
   i.e. [ctx.evaluated] variables that are current roots of the dep graph [ctx.dep_graph]
91
   - [evaluated] is the set of already evaluated variables,
92
     wrt the scheduling
93
   - does only remove edges, not variables themselves
94
   - yet, instance variables are removed
95
*)
96
let remove_roots ctx =
97
  let rem = ref true in
98
  let remaining = ref ctx.evaluated in
99
  while !rem
100
  do
101
    rem := false;
102
    let all_roots = graph_roots ctx.dep_graph in
103
    let inst_roots, var_roots = List.partition (fun v -> ExprDep.is_instance_var v && v <> Causality.world) all_roots in
104
    let frontier_roots = Disjunction.CISet.filter (fun v -> List.mem v.var_id var_roots) !remaining in
105
    if not (Disjunction.CISet.is_empty frontier_roots && inst_roots = []) then
106
      begin
107
	rem := true;
108
	List.iter (kill_instance_variables ctx) inst_roots;
109
	Disjunction.CISet.iter (kill_root ctx) frontier_roots;
110
	remaining := Disjunction.CISet.diff !remaining frontier_roots
111
      end
112
  done
113
 
114
(* checks whether a variable is aliasable,
115
   depending on its (address) type *)
116
let is_aliasable var =
117
  (not (!Options.mpfr && Types.is_real_type var.var_type)) && Types.is_address_type var.var_type
118
 
119
(* checks whether a variable [v] is an input of the [var] equation, with an address type.
120
   if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node,
121
   because [v] may not be dead in the callee node when [var] is assigned *)
122
let is_aliasable_input node var =
123
  let eq_var = get_node_eq var node in
124
  let inputs_var =
125
    match NodeDep.get_callee eq_var.eq_rhs with
126
    | None           -> []
127
    | Some (_, args) -> List.fold_right (fun e r -> match e.expr_desc with Expr_ident id -> id::r | _ -> r) args [] in
128
  fun v -> is_aliasable v && List.mem v.var_id inputs_var
129

    
130
(* replace variable [v] by [v'] in graph [g].
131
   [v'] is a dead variable
132
*)
133
let replace_in_dep_graph v v' g =
134
  begin
135
    IdentDepGraph.add_vertex g v';
136
    IdentDepGraph.iter_succ (fun s -> IdentDepGraph.add_edge g v' s) g v;
137
    IdentDepGraph.iter_pred (fun p -> IdentDepGraph.add_edge g p v') g v;
138
    IdentDepGraph.remove_vertex g v
139
  end
140

    
141
let pp_reuse_policy fmt policy =
142
  begin
143
    Format.fprintf fmt "{ /* reuse policy */@.";
144
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %s@." s t.var_id) policy;
145
    Format.fprintf fmt "}@."
146
  end
147

    
148
let pp_context fmt ctx =
149
  begin
150
    Format.fprintf fmt "{ /*BEGIN context */@.";
151
    Format.fprintf fmt "eval=%a;@." Disjunction.pp_ciset ctx.evaluated;
152
    Format.fprintf fmt "graph=%a;@." pp_dep_graph ctx.dep_graph;
153
    Format.fprintf fmt "disjoint=%a;@." Disjunction.pp_disjoint_map ctx.disjoint;
154
    Format.fprintf fmt "policy=%a;@." pp_reuse_policy ctx.policy;
155
    Format.fprintf fmt "/* END context */ }@.";
156
  end
157

    
158
(* computes the reusable dependencies of variable [var] in graph [g],
159
   once [var] has been evaluated
160
   - [locals] is the set of potentially reusable variables
161
   - [evaluated] is the set of evaluated variables
162
   - [quasi] is the set of quasi-reusable variables
163
   - [reusable] is the set of dead/reusable dependencies of [var] in graph [g]
164
   - [policy] is the reuse map (which domain is [evaluated])
165
*)
166
let compute_dependencies heads ctx =
167
  begin
168
    (*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);*)
169
    List.iter (kill_root ctx) heads;
170
    remove_roots ctx;
171
  end
172

    
173
let compute_evaluated heads ctx =
174
  begin
175
    List.iter (fun head -> ctx.evaluated <- Disjunction.CISet.add head ctx.evaluated) heads;
176
  end
177

    
178
(* tests whether a variable [v] may be (re)used instead of [var]. The conditions are:
179
   - [v] has been really used ([v] is its own representative)
180
   - same type
181
   - [v] is not an aliasable input of the equation defining [var]
182
   - [v] is not one of the current heads (which contain [var])
183
   - [v] is not currently in use
184
 *)
185
let eligible node ctx heads var v =
186
     Hashtbl.find ctx.policy v.var_id == v
187
  && Typing.eq_ground (Types.unclock_type var.var_type) (Types.unclock_type v.var_type)
188
  && not (is_aliasable_input node var.var_id v)
189
  && not (List.exists (fun h -> h.var_id = v.var_id) heads)
190
  && (*let repr_v = Hashtbl.find ctx.policy v.var_id*)
191
     not (Disjunction.CISet.exists (fun p -> IdentDepGraph.mem_edge ctx.dep_graph p.var_id v.var_id) ctx.evaluated)
192

    
193
let compute_reuse node ctx heads var =
194
  let disjoint = Hashtbl.find ctx.disjoint var.var_id in
195
  let locally_reusable v =
196
    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
197
  let eligibles = Disjunction.CISet.filter (eligible node ctx heads var) ctx.evaluated in
198
  Log.report ~level:7 (fun fmt -> Format.fprintf fmt "eligibles:%a@." Disjunction.pp_ciset eligibles);
199
  let quasi_dead, live = Disjunction.CISet.partition locally_reusable eligibles in
200
  Log.report ~level:7 (fun fmt -> Format.fprintf fmt "live:%a@." Disjunction.pp_ciset live);
201
  try
202
    let disjoint_live = Disjunction.CISet.inter disjoint live in
203
    Log.report ~level:7 (fun fmt -> Format.fprintf fmt "disjoint live:%a@." Disjunction.pp_ciset disjoint_live);
204
    let reuse = Disjunction.CISet.max_elt disjoint_live in
205
    begin
206
      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;
207
      Hashtbl.add ctx.policy var.var_id reuse;
208
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
209
      (*Format.eprintf "%s reused by live@." var.var_id;*)
210
    end
211
  with Not_found ->
212
  try
213
    let dead = Disjunction.CISet.filter (fun v -> is_graph_root v.var_id ctx.dep_graph) quasi_dead in
214
    Log.report ~level:7 (fun fmt -> Format.fprintf fmt "dead:%a@." Disjunction.pp_ciset dead);
215
    let reuse = Disjunction.CISet.choose dead in
216
    begin
217
      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;
218
      Hashtbl.add ctx.policy var.var_id reuse;
219
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
220
      (*Format.eprintf "%s reused by dead %s@." var.var_id reuse.var_id;*)
221
    end
222
      with Not_found ->
223
    begin
224
      Hashtbl.add ctx.policy var.var_id var;
225
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
226
    end
227

    
228
let compute_reuse_policy node schedule disjoint g =
229
  let sort = ref schedule in
230
  let ctx = { evaluated = Disjunction.CISet.empty;
231
	      dep_graph = g;
232
	      disjoint  = disjoint;
233
	      policy    = Hashtbl.create 23; } in
234
  while !sort <> []
235
  do
236
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);
237
    let heads = List.map (fun v -> get_node_var v node) (List.hd !sort) in
238
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "NEW HEADS:");
239
    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;
240
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "@.");
241
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_DEPENDENCIES@.");
242
    compute_dependencies heads ctx;
243
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);
244
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_REUSE@.");
245
    List.iter (compute_reuse node ctx heads) heads;
246
    (*compute_evaluated heads ctx;*)
247
    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;
248
    sort := List.tl !sort;
249
  done;
250
  IdentDepGraph.clear ctx.dep_graph;
251
  ctx.policy
252

    
253
(* Reuse policy:
254
   - could reuse variables with the same type exactly only (simple).
255
   - reusing variables with different types would involve:
256
     - either dirty castings
257
     - or complex inclusion expression (for instance: array <-> array cell, struct <-> struct field) to be able to reuse only some parts of structured data.
258
     ... it seems too complex and potentially unsafe
259
   - for node instance calls: output variables could NOT reuse aliasable input variables, 
260
     even if inputs become dead, because the correctness would depend on the scheduling
261
     of the callee (so, the compiling strategy could NOT be modular anymore).
262
   - once a policy is set, we need to:
263
     - replace each variable by its reuse alias.
264
     - simplify resulting equations, as we may now have:
265
        x = x;                     --> ;           for scalar vars
266
       or:
267
        x = &{ f1 = x->f1; f2 = t; } --> x->f2 = t;   for struct vars
268
 *)
269

    
270

    
271
(* the reuse policy seeks to use less local variables
272
   by replacing local variables, applying the rules
273
   in the following order:
274
    1) use another clock disjoint still live variable,
275
       with the greatest possible disjoint clock
276
    2) reuse a dead variable
277
   For the sake of safety, we replace variables by others:
278
    - with the same type
279
    - not aliasable (i.e. address type)
280
*)
281

    
282
(* Local Variables: *)
283
(* compile-command:"make -C .." *)
284
(* End: *)
(4-4/5)