Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / liveness.ml @ 7dedc5f0

History | View | Annotate | Download (10 KB)

1 b38ffff3 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 d4101ea0 xthirioux
12
open Utils
13
open LustreSpec
14
open Corelang
15 9aaee7f9 xthirioux
open Graph
16 d4101ea0 xthirioux
open Causality
17
18 084c1ce4 xthirioux
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 d96d54ac xthirioux
(* 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 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 9aaee7f9 xthirioux
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 34a5a072 xthirioux
let compute_unused_variables n g =
60 9aaee7f9 xthirioux
  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 2cf39a8e xthirioux
    (ISet.union inputs mems)
67 9aaee7f9 xthirioux
68 01f1a1f4 xthirioux
(* checks whether a variable is aliasable,
69
   depending on its (address) type *)
70
let is_aliasable var =
71
 Types.is_address_type var.var_type
72
73 34a5a072 xthirioux
(* 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 084c1ce4 xthirioux
let kill_root ctx head =
84
  IdentDepGraph.iter_succ (IdentDepGraph.remove_edge ctx.dep_graph head.var_id) ctx.dep_graph head.var_id
85
86 34a5a072 xthirioux
(* Recursively removes useless variables,
87 084c1ce4 xthirioux
   i.e. [ctx.evaluated] variables that are current roots of the dep graph [ctx.dep_graph]
88 01f1a1f4 xthirioux
   - [evaluated] is the set of already evaluated variables,
89
     wrt the scheduling
90 084c1ce4 xthirioux
   - does only remove edges, not variables themselves
91 01f1a1f4 xthirioux
*)
92 084c1ce4 xthirioux
let remove_roots ctx =
93 d4101ea0 xthirioux
  let rem = ref true in
94 084c1ce4 xthirioux
  let remaining = ref ctx.evaluated in
95 d4101ea0 xthirioux
  while !rem
96
  do
97
    rem := false;
98 084c1ce4 xthirioux
    let all_roots = graph_roots ctx.dep_graph in
99
    let frontier_roots = Disjunction.CISet.filter (fun v -> List.mem v.var_id all_roots) !remaining in
100
    if not (Disjunction.CISet.is_empty frontier_roots) then
101 d4101ea0 xthirioux
      begin
102
	rem := true;
103 084c1ce4 xthirioux
	Disjunction.CISet.iter (kill_root ctx) frontier_roots;
104
	remaining := Disjunction.CISet.diff !remaining frontier_roots
105 d4101ea0 xthirioux
      end
106 084c1ce4 xthirioux
  done
107 2cf39a8e xthirioux
 
108 7dedc5f0 xthirioux
(* checks whether a variable is aliasable,
109
   depending on its (address) type *)
110
let is_aliasable var =
111
 Types.is_address_type var.var_type
112
 
113 34a5a072 xthirioux
(* checks whether a variable [v] is an input of the [var] equation, with an address type.
114
   if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node,
115
   because [v] may not be dead in the callee node when [var] is assigned *)
116
let is_aliasable_input node var =
117
  let eq_var = get_node_eq var node in
118
  let inputs_var =
119
    match NodeDep.get_callee eq_var.eq_rhs with
120
    | None           -> []
121
    | Some (_, args) -> List.fold_right (fun e r -> match e.expr_desc with Expr_ident id -> id::r | _ -> r) args [] in
122 01f1a1f4 xthirioux
  fun v -> is_aliasable v && List.mem v.var_id inputs_var
123 34a5a072 xthirioux
124 01f1a1f4 xthirioux
(* replace variable [v] by [v'] in graph [g].
125
   [v'] is a dead variable
126 d4101ea0 xthirioux
*)
127 01f1a1f4 xthirioux
let replace_in_dep_graph v v' g =
128 d4101ea0 xthirioux
  begin
129 34a5a072 xthirioux
    IdentDepGraph.add_vertex g v';
130
    IdentDepGraph.iter_succ (fun s -> IdentDepGraph.add_edge g v' s) g v;
131
    IdentDepGraph.iter_pred (fun p -> IdentDepGraph.add_edge g p v') g v;
132
    IdentDepGraph.remove_vertex g v
133 d4101ea0 xthirioux
  end
134
135 01f1a1f4 xthirioux
let pp_reuse_policy fmt policy =
136
  begin
137
    Format.fprintf fmt "{ /* reuse policy */@.";
138
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %s@." s t.var_id) policy;
139
    Format.fprintf fmt "}@."
140
  end
141
142
let pp_context fmt ctx =
143
  begin
144
    Format.fprintf fmt "{ /*BEGIN context */@.";
145
    Format.fprintf fmt "eval=%a;@." Disjunction.pp_ciset ctx.evaluated;
146 084c1ce4 xthirioux
    Format.fprintf fmt "graph=%a;@." pp_dep_graph ctx.dep_graph;
147 01f1a1f4 xthirioux
    Format.fprintf fmt "disjoint=%a;@." Disjunction.pp_disjoint_map ctx.disjoint;
148
    Format.fprintf fmt "policy=%a;@." pp_reuse_policy ctx.policy;
149
    Format.fprintf fmt "/* END context */ }@.";
150
  end
151
152 2cf39a8e xthirioux
(* computes the reusable dependencies of variable [var] in graph [g],
153
   once [var] has been evaluated
154 01f1a1f4 xthirioux
   - [locals] is the set of potentially reusable variables
155
   - [evaluated] is the set of evaluated variables
156
   - [quasi] is the set of quasi-reusable variables
157
   - [reusable] is the set of dead/reusable dependencies of [var] in graph [g]
158
   - [policy] is the reuse map (which domain is [evaluated])
159 2cf39a8e xthirioux
*)
160 084c1ce4 xthirioux
let compute_dependencies heads ctx =
161 01f1a1f4 xthirioux
  begin
162 084c1ce4 xthirioux
    (*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);*)
163
    List.iter (kill_root ctx) heads;
164
    remove_roots ctx;
165 01f1a1f4 xthirioux
  end
166
167
let compute_evaluated heads ctx =
168 d4101ea0 xthirioux
  begin
169 01f1a1f4 xthirioux
    List.iter (fun head -> ctx.evaluated <- Disjunction.CISet.add head ctx.evaluated) heads;
170 d4101ea0 xthirioux
  end
171
172 084c1ce4 xthirioux
let compute_reuse node ctx var =
173 01f1a1f4 xthirioux
  let aliasable = is_aliasable_input node var.var_id in
174 084c1ce4 xthirioux
  let disjoint = Hashtbl.find ctx.disjoint var.var_id in
175
  let eligible v =
176
       Typing.eq_ground var.var_type v.var_type
177
    && not (aliasable v) in
178
  let locally_reusable v =
179
    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
180
  let eligibles = Disjunction.CISet.filter eligible ctx.evaluated in
181
  let dead, live = Disjunction.CISet.partition locally_reusable eligibles in
182 01f1a1f4 xthirioux
  try
183 084c1ce4 xthirioux
    let disjoint_live = Disjunction.CISet.inter disjoint live in
184
    let reuse = Disjunction.CISet.max_elt disjoint_live in
185 01f1a1f4 xthirioux
    begin
186 084c1ce4 xthirioux
      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;
187
      Hashtbl.add ctx.policy var.var_id (Hashtbl.find ctx.policy reuse.var_id);
188 01f1a1f4 xthirioux
    end
189
  with Not_found ->
190
  try
191 084c1ce4 xthirioux
    let reuse = Disjunction.CISet.choose dead in
192 01f1a1f4 xthirioux
    begin
193 084c1ce4 xthirioux
      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;
194
      Hashtbl.add ctx.policy var.var_id (Hashtbl.find ctx.policy reuse.var_id);
195 01f1a1f4 xthirioux
    end
196
      with Not_found ->
197
    begin
198
      Hashtbl.add ctx.policy var.var_id var;
199
    end
200
201 34a5a072 xthirioux
let compute_reuse_policy node schedule disjoint g =
202
  let sort = ref schedule in
203 01f1a1f4 xthirioux
  let ctx = { evaluated = Disjunction.CISet.empty;
204 084c1ce4 xthirioux
	      dep_graph = g;
205 01f1a1f4 xthirioux
	      disjoint  = disjoint;
206
	      policy    = Hashtbl.create 23; } in
207 2cf39a8e xthirioux
  while !sort <> []
208 34a5a072 xthirioux
  do
209 01f1a1f4 xthirioux
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);
210
    let heads = List.map (fun v -> get_node_var v node) (List.hd !sort) in
211
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "NEW HEADS:");
212
    List.iter (fun head -> Log.report ~level:2 (fun fmt -> Format.fprintf fmt "%s " head.var_id)) heads;
213
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "@.");
214
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_DEPENDENCIES@.");
215 084c1ce4 xthirioux
    compute_dependencies heads ctx;
216 01f1a1f4 xthirioux
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);
217
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_REUSE@.");
218 084c1ce4 xthirioux
    List.iter (compute_reuse node ctx) heads;
219
    compute_evaluated heads ctx;
220 01f1a1f4 xthirioux
    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;
221 34a5a072 xthirioux
    sort := List.tl !sort;
222
  done;
223 084c1ce4 xthirioux
  IdentDepGraph.clear ctx.dep_graph;
224 01f1a1f4 xthirioux
  ctx.policy
225 e8c0f452 xthirioux
226
(* Reuse policy:
227
   - could reuse variables with the same type exactly only (simple).
228
   - reusing variables with different types would involve:
229
     - either dirty castings
230
     - or complex inclusion expression (for instance: array <-> array cell, struct <-> struct field) to be able to reuse only some parts of structured data.
231
     ... it seems too complex and potentially unsafe
232 7cd31331 xthirioux
   - for node instance calls: output variables could NOT reuse aliasable input variables, 
233 e8c0f452 xthirioux
     even if inputs become dead, because the correctness would depend on the scheduling
234
     of the callee (so, the compiling strategy could NOT be modular anymore).
235
   - once a policy is set, we need to:
236
     - replace each variable by its reuse alias.
237
     - simplify resulting equations, as we may now have:
238
        x = x;                     --> ;           for scalar vars
239
       or:
240
        x = &{ f1 = x->f1; f2 = t; } --> x->f2 = t;   for struct vars
241
 *)
242
243 d4101ea0 xthirioux
244 1837ce98 xthirioux
(* the reuse policy seeks to use less local variables
245
   by replacing local variables, applying the rules
246
   in the following order:
247
    1) use another clock disjoint still live variable,
248
       with the greatest possible disjoint clock
249
    2) reuse a dead variable
250
   For the sake of safety, we replace variables by others:
251
    - with the same type
252
    - not aliasable (i.e. address type)
253
*)
254 34a5a072 xthirioux
255 d4101ea0 xthirioux
(* Local Variables: *)
256
(* compile-command:"make -C .." *)
257
(* End: *)