Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / liveness.ml @ ed81df06

History | View | Annotate | Download (10 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
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 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

    
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
let compute_unused_variables n g =
60
  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
    (ISet.union inputs mems)
67

    
68
(* 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
(* 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_root ctx head =
84
  IdentDepGraph.iter_succ (IdentDepGraph.remove_edge ctx.dep_graph head.var_id) ctx.dep_graph head.var_id
85

    
86
(* Recursively removes useless variables,
87
   i.e. [ctx.evaluated] variables that are current roots of the dep graph [ctx.dep_graph]
88
   - [evaluated] is the set of already evaluated variables,
89
     wrt the scheduling
90
   - does only remove edges, not variables themselves
91
*)
92
let remove_roots ctx =
93
  let rem = ref true in
94
  let remaining = ref ctx.evaluated in
95
  while !rem
96
  do
97
    rem := false;
98
    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
      begin
102
	rem := true;
103
	Disjunction.CISet.iter (kill_root ctx) frontier_roots;
104
	remaining := Disjunction.CISet.diff !remaining frontier_roots
105
      end
106
  done
107
 
108
(* 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
(* 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
  fun v -> is_aliasable v && List.mem v.var_id inputs_var
123

    
124
(* replace variable [v] by [v'] in graph [g].
125
   [v'] is a dead variable
126
*)
127
let replace_in_dep_graph v v' g =
128
  begin
129
    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
  end
134

    
135
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
    Format.fprintf fmt "graph=%a;@." pp_dep_graph ctx.dep_graph;
147
    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
(* computes the reusable dependencies of variable [var] in graph [g],
153
   once [var] has been evaluated
154
   - [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
*)
160
let compute_dependencies heads ctx =
161
  begin
162
    (*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
  end
166

    
167
let compute_evaluated heads ctx =
168
  begin
169
    List.iter (fun head -> ctx.evaluated <- Disjunction.CISet.add head ctx.evaluated) heads;
170
  end
171

    
172
let compute_reuse node ctx var =
173
  let aliasable = is_aliasable_input node var.var_id in
174
  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
  try
183
    let disjoint_live = Disjunction.CISet.inter disjoint live in
184
    let reuse = Disjunction.CISet.max_elt disjoint_live in
185
    begin
186
      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
    end
189
  with Not_found ->
190
  try
191
    let reuse = Disjunction.CISet.choose dead in
192
    begin
193
      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
    end
196
      with Not_found ->
197
    begin
198
      Hashtbl.add ctx.policy var.var_id var;
199
    end
200

    
201
let compute_reuse_policy node schedule disjoint g =
202
  let sort = ref schedule in
203
  let ctx = { evaluated = Disjunction.CISet.empty;
204
	      dep_graph = g;
205
	      disjoint  = disjoint;
206
	      policy    = Hashtbl.create 23; } in
207
  while !sort <> []
208
  do
209
    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
    compute_dependencies heads ctx;
216
    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
    List.iter (compute_reuse node ctx) heads;
219
    compute_evaluated heads ctx;
220
    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
    sort := List.tl !sort;
222
  done;
223
  IdentDepGraph.clear ctx.dep_graph;
224
  ctx.policy
225

    
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
   - for node instance calls: output variables could NOT reuse aliasable input variables, 
233
     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

    
244
(* 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

    
255
(* Local Variables: *)
256
(* compile-command:"make -C .." *)
257
(* End: *)