Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / liveness.ml @ 45c13277

History | View | Annotate | Download (11.6 KB)

1 a2d97a3e ploc
(********************************************************************)
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 695d6f2f xthirioux
12
open Utils
13
open LustreSpec
14
open Corelang
15 3bfed7f9 xthirioux
open Graph
16 695d6f2f xthirioux
open Causality
17
18 8a183477 xthirioux
(* 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 3bfed7f9 xthirioux
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 b6a94a4e xthirioux
let compute_unused_variables n g =
52 3bfed7f9 xthirioux
  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 a38c681e xthirioux
    (ISet.union inputs mems)
59 3bfed7f9 xthirioux
60 45c13277 xthirioux
(* 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 b6a94a4e xthirioux
(* 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 45c13277 xthirioux
   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 a38c681e xthirioux
let remove_local_roots locals evaluated g =
83 695d6f2f xthirioux
  let rem = ref true in
84 b6a94a4e xthirioux
  let roots = ref Disjunction.CISet.empty in
85 695d6f2f xthirioux
  while !rem
86
  do
87
    rem := false;
88 b6a94a4e xthirioux
    let new_roots = graph_roots g in
89 a38c681e xthirioux
    let reusable_roots = Disjunction.CISet.filter (fun v -> (List.mem v.var_id new_roots) && (Disjunction.CISet.mem v locals)) evaluated in
90 b6a94a4e xthirioux
    if not (Disjunction.CISet.is_empty reusable_roots) then
91 695d6f2f xthirioux
      begin
92
	rem := true;
93 b6a94a4e xthirioux
	Disjunction.CISet.iter (fun v -> IdentDepGraph.remove_vertex g v.var_id) reusable_roots;
94
	roots := Disjunction.CISet.union reusable_roots !roots
95 695d6f2f xthirioux
      end
96
  done;
97
  !roots
98 a38c681e xthirioux
 
99 b6a94a4e xthirioux
(* 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 45c13277 xthirioux
  fun v -> is_aliasable v && List.mem v.var_id inputs_var
109 b6a94a4e xthirioux
110 45c13277 xthirioux
(* replace variable [v] by [v'] in graph [g].
111
   [v'] is a dead variable
112 695d6f2f xthirioux
*)
113 45c13277 xthirioux
let replace_in_dep_graph v v' g =
114 695d6f2f xthirioux
  begin
115 b6a94a4e xthirioux
    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 695d6f2f xthirioux
  end
120
121 45c13277 xthirioux
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 a38c681e xthirioux
(* computes the reusable dependencies of variable [var] in graph [g],
167
   once [var] has been evaluated
168 45c13277 xthirioux
   - [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 a38c681e xthirioux
*)
174 45c13277 xthirioux
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 695d6f2f xthirioux
  begin
184 45c13277 xthirioux
    List.iter (fun head -> ctx.evaluated <- Disjunction.CISet.add head ctx.evaluated) heads;
185 695d6f2f xthirioux
  end
186
187 45c13277 xthirioux
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 b6a94a4e xthirioux
let compute_reuse_policy node schedule disjoint g =
216 a38c681e xthirioux
  let locals = node_reusable_variables node in
217 b6a94a4e xthirioux
  let sort = ref schedule in
218 45c13277 xthirioux
  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 a38c681e xthirioux
  while !sort <> []
224 b6a94a4e xthirioux
  do
225 45c13277 xthirioux
    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 b6a94a4e xthirioux
      (fun fmt -> Format.fprintf fmt "new dependency graph:%a@." pp_dep_graph g);
237 45c13277 xthirioux
    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 b6a94a4e xthirioux
    sort := List.tl !sort;
241
  done;
242
  IdentDepGraph.clear g;
243 45c13277 xthirioux
  ctx.policy
244 7afcba5a xthirioux
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 44bea83a xthirioux
   - for node instance calls: output variables could NOT reuse aliasable input variables, 
252 7afcba5a xthirioux
     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 695d6f2f xthirioux
264 bb2ca5f4 xthirioux
(* 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 b6a94a4e xthirioux
275 695d6f2f xthirioux
(* Local Variables: *)
276
(* compile-command:"make -C .." *)
277
(* End: *)