Project

General

Profile

Download (11.3 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 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 inputs = ExprDep.node_input_variables n in
31
  let fanin = Hashtbl.create 23 in
32
  begin
33
    IdentDepGraph.iter_vertex
34
      (fun v ->
35
	if ISet.mem v locals
36
	then Hashtbl.add fanin v (IdentDepGraph.in_degree g v) else
37
	if ExprDep.is_read_var v && not (ISet.mem v inputs)
38
	then Hashtbl.add fanin (ExprDep.undo_read_var v) (IdentDepGraph.in_degree g v)) g;
39
    fanin
40
  end
41
 
42
let pp_fanin fmt fanin =
43
  begin
44
    Format.fprintf fmt "{ /* locals fanin: */@.";
45
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %d@." s t) fanin;
46
    Format.fprintf fmt "}@."
47
  end
48

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

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

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

    
84
let kill_root ctx head =
85
  IdentDepGraph.iter_succ (IdentDepGraph.remove_edge ctx.dep_graph head.var_id) ctx.dep_graph head.var_id
86

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

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

    
136
let pp_reuse_policy fmt policy =
137
  begin
138
    Format.fprintf fmt "{ /* reuse policy */@.";
139
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %s@." s t.var_id) policy;
140
    Format.fprintf fmt "}@."
141
  end
142

    
143
let pp_context fmt ctx =
144
  begin
145
    Format.fprintf fmt "{ /*BEGIN context */@.";
146
    Format.fprintf fmt "eval=%a;@." Disjunction.pp_ciset ctx.evaluated;
147
    Format.fprintf fmt "graph=%a;@." pp_dep_graph ctx.dep_graph;
148
    Format.fprintf fmt "disjoint=%a;@." Disjunction.pp_disjoint_map ctx.disjoint;
149
    Format.fprintf fmt "policy=%a;@." pp_reuse_policy ctx.policy;
150
    Format.fprintf fmt "/* END context */ }@.";
151
  end
152

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

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

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

    
186
let compute_reuse node ctx heads var =
187
  let disjoint = Hashtbl.find ctx.disjoint var.var_id in
188
  let locally_reusable v =
189
    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
190
  let eligibles = Disjunction.CISet.filter (eligible node ctx heads var) ctx.evaluated in
191
  let quasi_dead, live = Disjunction.CISet.partition locally_reusable eligibles in
192
  try
193
    let disjoint_live = Disjunction.CISet.inter disjoint live in
194
    let reuse = Disjunction.CISet.max_elt disjoint_live in
195
    begin
196
      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;
197
      Hashtbl.add ctx.policy var.var_id (Hashtbl.find ctx.policy reuse.var_id);
198
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
199
      (*Format.eprintf "%s reused by live@." var.var_id;*)
200
    end
201
  with Not_found ->
202
  try
203
    let dead = Disjunction.CISet.filter (fun v -> is_graph_root v.var_id ctx.dep_graph) quasi_dead in
204
    let reuse = Disjunction.CISet.choose dead in
205
    begin
206
      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;
207
      Hashtbl.add ctx.policy var.var_id (Hashtbl.find ctx.policy reuse.var_id);
208
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
209
      (*Format.eprintf "%s reused by dead %a@." var.var_id Disjunction.pp_ciset dead;*)
210
    end
211
      with Not_found ->
212
    begin
213
      Hashtbl.add ctx.policy var.var_id var;
214
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
215
    end
216

    
217
let compute_reuse_policy node schedule disjoint g =
218
  let sort = ref schedule in
219
  let ctx = { evaluated = Disjunction.CISet.empty;
220
	      dep_graph = g;
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
    let heads = List.map (fun v -> get_node_var v node) (List.hd !sort) in
227
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "NEW HEADS:");
228
    List.iter (fun head -> Log.report ~level:6 (fun fmt -> Format.fprintf fmt "%s " head.var_id)) heads;
229
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "@.");
230
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_DEPENDENCIES@.");
231
    compute_dependencies heads ctx;
232
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);
233
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_REUSE@.");
234
    List.iter (compute_reuse node ctx heads) heads;
235
    (*compute_evaluated heads ctx;*)
236
    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;
237
    sort := List.tl !sort;
238
  done;
239
  IdentDepGraph.clear ctx.dep_graph;
240
  ctx.policy
241

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

    
259

    
260
(* the reuse policy seeks to use less local variables
261
   by replacing local variables, applying the rules
262
   in the following order:
263
    1) use another clock disjoint still live variable,
264
       with the greatest possible disjoint clock
265
    2) reuse a dead variable
266
   For the sake of safety, we replace variables by others:
267
    - with the same type
268
    - not aliasable (i.e. address type)
269
*)
270

    
271
(* Local Variables: *)
272
(* compile-command:"make -C .." *)
273
(* End: *)
(22-22/45)