Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / liveness.ml @ 45c13277

History | View | Annotate | Download (11.6 KB)

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
(* computes the in-degree for each local variable of node [n], according to dep graph [g].
19
*)
20
let compute_fanin n g =
21
  let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in
22
  let fanin = Hashtbl.create 23 in
23
  begin
24
    IdentDepGraph.iter_vertex (fun v -> if ISet.mem v locals then Hashtbl.add fanin v (IdentDepGraph.in_degree g v)) g;
25
    fanin
26
  end
27
 
28
let pp_fanin fmt fanin =
29
  begin
30
    Format.fprintf fmt "{ /* locals fanin: */@.";
31
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %d@." s t) fanin;
32
    Format.fprintf fmt "}@."
33
  end
34

    
35
(* computes the cone of influence of a given [var] wrt a dependency graph [g].
36
*)
37
let cone_of_influence g var =
38
 (*Format.printf "coi: %s@." var;*)
39
 let frontier = ref (ISet.add var ISet.empty) in
40
 let coi = ref ISet.empty in
41
 while not (ISet.is_empty !frontier)
42
 do
43
   let head = ISet.min_elt !frontier in
44
   (*Format.printf "head: %s@." head;*)
45
   frontier := ISet.remove head !frontier;
46
   if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi;
47
   List.iter (fun s -> frontier := ISet.add s !frontier) (IdentDepGraph.succ g head);
48
 done;
49
 !coi
50

    
51
let compute_unused_variables n g =
52
  let inputs = ExprDep.node_input_variables n in
53
  let mems = ExprDep.node_memory_variables n in
54
  let outputs = ExprDep.node_output_variables n in
55
  ISet.fold
56
    (fun var unused -> ISet.diff unused (cone_of_influence g var))
57
    (ISet.union outputs mems)
58
    (ISet.union inputs mems)
59

    
60
(* checks whether a variable is aliasable,
61
   depending on its (address) type *)
62
let is_aliasable var =
63
 Types.is_address_type var.var_type
64

    
65
(* computes the set of potentially reusable variables.
66
   We don't reuse input variables, due to possible aliasing *)
67
let node_reusable_variables node =
68
  let mems = ExprDep.node_memory_variables node in
69
  List.fold_left
70
    (fun acc l ->
71
      if ISet.mem l.var_id mems then acc else Disjunction.CISet.add l acc)
72
    Disjunction.CISet.empty
73
    node.node_locals
74

    
75
(* Recursively removes useless variables,
76
   i.e. variables that are current roots of the dep graph [g]
77
   and returns [locals] and [evaluated] such roots
78
   - [locals] is the set of potentially reusable variables
79
   - [evaluated] is the set of already evaluated variables,
80
     wrt the scheduling
81
*)
82
let remove_local_roots locals evaluated g =
83
  let rem = ref true in
84
  let roots = ref Disjunction.CISet.empty in
85
  while !rem
86
  do
87
    rem := false;
88
    let new_roots = graph_roots g in
89
    let reusable_roots = Disjunction.CISet.filter (fun v -> (List.mem v.var_id new_roots) && (Disjunction.CISet.mem v locals)) evaluated in
90
    if not (Disjunction.CISet.is_empty reusable_roots) then
91
      begin
92
	rem := true;
93
	Disjunction.CISet.iter (fun v -> IdentDepGraph.remove_vertex g v.var_id) reusable_roots;
94
	roots := Disjunction.CISet.union reusable_roots !roots
95
      end
96
  done;
97
  !roots
98
 
99
(* checks whether a variable [v] is an input of the [var] equation, with an address type.
100
   if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node,
101
   because [v] may not be dead in the callee node when [var] is assigned *)
102
let is_aliasable_input node var =
103
  let eq_var = get_node_eq var node in
104
  let inputs_var =
105
    match NodeDep.get_callee eq_var.eq_rhs with
106
    | None           -> []
107
    | Some (_, args) -> List.fold_right (fun e r -> match e.expr_desc with Expr_ident id -> id::r | _ -> r) args [] in
108
  fun v -> is_aliasable v && List.mem v.var_id inputs_var
109

    
110
(* replace variable [v] by [v'] in graph [g].
111
   [v'] is a dead variable
112
*)
113
let replace_in_dep_graph v v' g =
114
  begin
115
    IdentDepGraph.add_vertex g v';
116
    IdentDepGraph.iter_succ (fun s -> IdentDepGraph.add_edge g v' s) g v;
117
    IdentDepGraph.iter_pred (fun p -> IdentDepGraph.add_edge g p v') g v;
118
    IdentDepGraph.remove_vertex g v
119
  end
120

    
121
type context =
122
{
123
  mutable evaluated : Disjunction.CISet.t;
124
  mutable quasi : Disjunction.CISet.t;
125
  mutable reusable : Disjunction.CISet.t;
126
  disjoint : (ident, Disjunction.CISet.t) Hashtbl.t;
127
  policy : (ident, var_decl) Hashtbl.t;
128
}
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 "quasi=%a;@." Disjunction.pp_ciset ctx.quasi;
142
    Format.fprintf fmt "reusable=%a;@." Disjunction.pp_ciset ctx.reusable;
143
    Format.fprintf fmt "disjoint=%a;@." Disjunction.pp_disjoint_map ctx.disjoint;
144
    Format.fprintf fmt "policy=%a;@." pp_reuse_policy ctx.policy;
145
    Format.fprintf fmt "/* END context */ }@.";
146
  end
147

    
148
let is_reusable_quasi var ctx q =
149
  (*Log.report ~level:6 (fun fmt -> Format.fprintf fmt "is_reusable_quasi@ var=%s %a q=%s@." var.var_id pp_context ctx q.var_id);*)
150
  let disjoint = Hashtbl.find ctx.disjoint var.var_id in
151
  let q = Hashtbl.find ctx.policy q.var_id in
152
  Disjunction.CISet.for_all
153
    (fun v -> (Hashtbl.find ctx.policy v.var_id = q) <= (Disjunction.CISet.mem v disjoint || Disjunction.CISet.mem v ctx.quasi))
154
    ctx.evaluated
155

    
156
let compute_reusable heads var ctx =
157
  let (reusable', quasi') = Disjunction.CISet.partition (fun q -> (not (List.mem q heads)) && is_reusable_quasi var ctx q) ctx.quasi
158
  in
159
  begin
160
    ctx.quasi <- quasi';
161
    ctx.reusable <- Disjunction.CISet.fold (fun r' -> Disjunction.CISet.add (Hashtbl.find ctx.policy r'.var_id)) reusable' ctx.reusable;
162
    ctx.quasi <- Disjunction.CISet.diff ctx.quasi reusable';
163
    ctx.evaluated <- Disjunction.CISet.diff ctx.evaluated reusable';
164
  end
165

    
166
(* computes the reusable dependencies of variable [var] in graph [g],
167
   once [var] has been evaluated
168
   - [locals] is the set of potentially reusable variables
169
   - [evaluated] is the set of evaluated variables
170
   - [quasi] is the set of quasi-reusable variables
171
   - [reusable] is the set of dead/reusable dependencies of [var] in graph [g]
172
   - [policy] is the reuse map (which domain is [evaluated])
173
*)
174
let compute_dependencies locals heads ctx g =
175
  begin
176
    (*Log.report ~level:6 (fun fmt -> Format.fprintf fmt "compute_reusable_dependencies %a %a %a %a@." Disjunction.pp_ciset locals Printers.pp_var_name var pp_context ctx pp_dep_graph g);*)
177
    List.iter (fun head -> IdentDepGraph.iter_succ (IdentDepGraph.remove_edge g head.var_id) g head.var_id) heads;
178
    ctx.quasi <- Disjunction.CISet.union (remove_local_roots locals ctx.evaluated g) ctx.quasi;
179
    List.iter (fun head -> compute_reusable heads head ctx) heads;
180
  end
181

    
182
let compute_evaluated heads ctx =
183
  begin
184
    List.iter (fun head -> ctx.evaluated <- Disjunction.CISet.add head ctx.evaluated) heads;
185
  end
186

    
187
let compute_reuse node var ctx g =
188
  let aliasable = is_aliasable_input node var.var_id in
189
  let eligible v = Typing.eq_ground var.var_type v.var_type && not (aliasable v) in
190
  try
191
    let disj = Hashtbl.find ctx.disjoint var.var_id in
192
    let reuse =
193
      Hashtbl.find ctx.policy
194
	(Disjunction.CISet.max_elt (Disjunction.CISet.filter (fun v -> (eligible v) && (Disjunction.CISet.mem v ctx.evaluated) && not (Disjunction.CISet.mem v ctx.reusable)) disj)).var_id in
195
    begin
196
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
197
      Hashtbl.add ctx.policy var.var_id reuse;
198
    end
199
  with Not_found ->
200
  try
201
    let reuse = Hashtbl.find ctx.policy (Disjunction.CISet.choose (Disjunction.CISet.filter (fun v -> eligible v) ctx.reusable)).var_id in
202
    begin
203
      replace_in_dep_graph var.var_id reuse.var_id g;
204
      Disjunction.replace_in_disjoint_map ctx.disjoint var reuse;
205
      ctx.evaluated <- Disjunction.CISet.add reuse ctx.evaluated;
206
      ctx.reusable <- Disjunction.CISet.remove reuse ctx.reusable;
207
      Hashtbl.add ctx.policy var.var_id reuse;
208
    end
209
      with Not_found ->
210
    begin
211
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
212
      Hashtbl.add ctx.policy var.var_id var;
213
    end
214

    
215
let compute_reuse_policy node schedule disjoint g =
216
  let locals = node_reusable_variables node in
217
  let sort = ref schedule in
218
  let ctx = { evaluated = Disjunction.CISet.empty;
219
	      quasi     = Disjunction.CISet.empty;
220
	      reusable  = Disjunction.CISet.empty;
221
	      disjoint  = disjoint;
222
	      policy    = Hashtbl.create 23; } in
223
  while !sort <> []
224
  do
225
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);
226
    Log.report ~level:6 
227
      (fun fmt -> Format.fprintf fmt "new dependency graph:%a@." pp_dep_graph g);
228
    let heads = List.map (fun v -> get_node_var v node) (List.hd !sort) in
229
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "NEW HEADS:");
230
    List.iter (fun head -> Log.report ~level:2 (fun fmt -> Format.fprintf fmt "%s " head.var_id)) heads;
231
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "@.");
232
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_DEPENDENCIES@.");
233
    compute_dependencies locals heads ctx g;
234
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);
235
    Log.report ~level:6 
236
      (fun fmt -> Format.fprintf fmt "new dependency graph:%a@." pp_dep_graph g);
237
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_REUSE@.");
238
    List.iter (fun head -> compute_reuse node head ctx g) heads;
239
    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;
240
    sort := List.tl !sort;
241
  done;
242
  IdentDepGraph.clear g;
243
  ctx.policy
244

    
245
(* Reuse policy:
246
   - could reuse variables with the same type exactly only (simple).
247
   - reusing variables with different types would involve:
248
     - either dirty castings
249
     - or complex inclusion expression (for instance: array <-> array cell, struct <-> struct field) to be able to reuse only some parts of structured data.
250
     ... it seems too complex and potentially unsafe
251
   - for node instance calls: output variables could NOT reuse aliasable input variables, 
252
     even if inputs become dead, because the correctness would depend on the scheduling
253
     of the callee (so, the compiling strategy could NOT be modular anymore).
254
   - once a policy is set, we need to:
255
     - replace each variable by its reuse alias.
256
     - simplify resulting equations, as we may now have:
257
        x = x;                     --> ;           for scalar vars
258
       or:
259
        x = &{ f1 = x->f1; f2 = t; } --> x->f2 = t;   for struct vars
260
     - such simplifications are, until now, only expressible at the C source level...
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
(* compile-command:"make -C .." *)
277
(* End: *)