Project

General

Profile

Download (12.1 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 Lustre_types
14
open Corelang
15
open Causality
16

    
17
type context =
18
{
19
  mutable evaluated : Disjunction.CISet.t;
20
  dep_graph : IdentDepGraph.t;
21
  disjoint : (ident, Disjunction.CISet.t) Hashtbl.t;
22
  policy : (ident, var_decl) Hashtbl.t;
23
}
24

    
25
(* computes the in-degree for each local variable of node [n], according to dep graph [g].
26
*)
27
let compute_fanin n g =
28
  let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in
29
  let inputs = ExprDep.node_input_variables n in
30
  let fanin = Hashtbl.create 23 in
31
  begin
32
    IdentDepGraph.iter_vertex
33
      (fun v ->
34
	if ISet.mem v locals
35
	then Hashtbl.add fanin v (IdentDepGraph.in_degree g v) else
36
	if ExprDep.is_read_var v && not (ISet.mem v inputs)
37
	then Hashtbl.add fanin (ExprDep.undo_read_var v) (IdentDepGraph.in_degree g v)) g;
38
    fanin
39
  end
40
 
41
let pp_fanin fmt fanin =
42
  begin
43
    Format.fprintf fmt "{ /* locals fanin: */@.";
44
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %d@." s t) fanin;
45
    Format.fprintf fmt "}@."
46
  end
47

    
48
(* computes the cone of influence of a given [var] wrt a dependency graph [g].
49
*)
50
let cone_of_influence g var =
51
  (*Format.printf "DEBUG coi: %s@." var;*)
52
 let frontier = ref (ISet.add var ISet.empty) in
53
 let explored = ref 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 "DEBUG head: %s@." head;*)
59
   frontier := ISet.remove head !frontier;
60
   explored := ISet.add head !explored;
61
   if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi;
62
   List.iter (fun s -> if not (ISet.mem s !explored) then frontier := ISet.add s !frontier) (IdentDepGraph.succ g head);
63
 done;
64
 !coi
65

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

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

    
85
let kill_instance_variables ctx inst =
86
  IdentDepGraph.remove_vertex ctx.dep_graph inst
87

    
88
let kill_root ctx head =
89
  IdentDepGraph.iter_succ (IdentDepGraph.remove_edge ctx.dep_graph head.var_id) ctx.dep_graph head.var_id
90

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

    
132
(* replace variable [v] by [v'] in graph [g].
133
   [v'] is a dead variable
134
*)
135
let replace_in_dep_graph v v' g =
136
  begin
137
    IdentDepGraph.add_vertex g v';
138
    IdentDepGraph.iter_succ (fun s -> IdentDepGraph.add_edge g v' s) g v;
139
    IdentDepGraph.iter_pred (fun p -> IdentDepGraph.add_edge g p v') g v;
140
    IdentDepGraph.remove_vertex g v
141
  end
142

    
143
let pp_reuse_policy fmt policy =
144
  Format.(fprintf fmt "@[<v 2>{ /* reuse policy */%t@] }"
145
    (fun fmt -> Hashtbl.iter (fun s t -> fprintf fmt "@,%s -> %s" s t.var_id) policy))
146

    
147
let pp_context fmt ctx =
148
  Format.fprintf fmt
149
    "@[<v 2>{ /*BEGIN context */@,\
150
     eval     = %a;@,\
151
     graph    = %a;@,\
152
     disjoint = %a;@,\
153
     policy   = %a;@,\
154
     /* END context */ }@]"
155
    Disjunction.pp_ciset ctx.evaluated
156
    pp_dep_graph ctx.dep_graph
157
    Disjunction.pp_disjoint_map ctx.disjoint
158
    pp_reuse_policy ctx.policy
159

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

    
175
let compute_evaluated heads ctx =
176
  begin
177
    List.iter (fun head -> ctx.evaluated <- Disjunction.CISet.add head ctx.evaluated) heads;
178
  end
179

    
180
(* tests whether a variable [v] may be (re)used instead of [var]. The conditions are:
181
   - [v] has been really used ([v] is its own representative)
182
   - same type
183
   - [v] is not an aliasable input of the equation defining [var]
184
   - [v] is not one of the current heads (which contain [var])
185
   - [v] is not currently in use
186
 *)
187
let eligible node ctx heads var v =
188
     Hashtbl.find ctx.policy v.var_id == v
189
  && Typing.eq_ground (Types.unclock_type var.var_type) (Types.unclock_type v.var_type)
190
  && not (is_aliasable_input node var.var_id v)
191
  && not (List.exists (fun h -> h.var_id = v.var_id) heads)
192
  && (*let repr_v = Hashtbl.find ctx.policy v.var_id*)
193
     not (Disjunction.CISet.exists (fun p -> IdentDepGraph.mem_edge ctx.dep_graph p.var_id v.var_id) ctx.evaluated)
194

    
195
let compute_reuse node ctx heads var =
196
  let disjoint = Hashtbl.find ctx.disjoint var.var_id in
197
  let locally_reusable v =
198
    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
199
  let eligibles =
200
    if ISet.mem var.var_id (ExprDep.node_memory_variables node)
201
    then Disjunction.CISet.empty
202
    else Disjunction.CISet.filter (eligible node ctx heads var) ctx.evaluated in
203
  let quasi_dead, live = Disjunction.CISet.partition locally_reusable eligibles in
204
  let disjoint_live = Disjunction.CISet.inter disjoint live in
205
  let dead = Disjunction.CISet.filter (fun v -> is_graph_root v.var_id ctx.dep_graph) quasi_dead in
206
  Log.report ~level:7 (fun fmt ->
207
      Format.fprintf fmt
208
        "@[<v>\
209
         eligibles    : %a@,\
210
         live         : %a@,\
211
         disjoint live: %a@,\
212
         dead         : %a@,@]"
213
        Disjunction.pp_ciset eligibles
214
        Disjunction.pp_ciset live
215
        Disjunction.pp_ciset disjoint_live
216
        Disjunction.pp_ciset dead);
217
  begin try
218
      let reuse = match Disjunction.CISet.max_elt_opt disjoint_live with
219
        | Some reuse -> reuse
220
        | None -> Disjunction.CISet.choose dead in
221
      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;
222
      Hashtbl.add ctx.policy var.var_id reuse
223
    with Not_found -> Hashtbl.add ctx.policy var.var_id var
224
  end;
225
  ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated
226

    
227
let compute_reuse_policy node schedule disjoint g =
228
  let ctx = { evaluated = Disjunction.CISet.empty;
229
              dep_graph = g;
230
              disjoint  = disjoint;
231
              policy    = Hashtbl.create 23; } in
232
  List.iter (fun heads ->
233
      let heads = List.map (fun v -> get_node_var v node) heads in
234
      Log.report ~level:6 (fun fmt ->
235
          Format.(fprintf fmt
236
                    "@[<v>@[<v 2>new context:@,%a@]@,NEW HEADS:%a@,COMPUTE_DEPENDENCIES@,@]"
237
                    pp_context ctx
238
                    (pp_print_list
239
                       ~pp_open_box:pp_open_hbox
240
                       ~pp_sep:pp_print_space
241
                       (fun fmt head ->
242
                          fprintf fmt "%s (%a)"
243
                            head.var_id Printers.pp_node_eq
244
                            (get_node_eq head.var_id node)))
245
                    heads));
246
      compute_dependencies heads ctx;
247
      Log.report ~level:6 (fun fmt ->
248
          Format.fprintf fmt "@[<v>@[<v 2>new context:@,%a@]@,COMPUTE_REUSE@,@]" pp_context ctx);
249
      List.iter (compute_reuse node ctx heads) heads;
250
      (*compute_evaluated heads ctx;*)
251
      Log.report ~level:6 (fun fmt ->
252
          Format.(fprintf fmt "@[<v>%a@,@]"
253
                    (pp_print_list
254
                       ~pp_open_box:pp_open_vbox0
255
                       (fun fmt head -> fprintf fmt "reuse %s instead of %s"
256
                           (Hashtbl.find ctx.policy head.var_id).var_id head.var_id))
257
                    heads)))
258
    schedule;
259
  IdentDepGraph.clear ctx.dep_graph;
260
  ctx.policy
261

    
262
(* Reuse policy:
263
   - could reuse variables with the same type exactly only (simple).
264
   - reusing variables with different types would involve:
265
     - either dirty castings
266
     - or complex inclusion expression (for instance: array <-> array cell, struct <-> struct field) to be able to reuse only some parts of structured data.
267
     ... it seems too complex and potentially unsafe
268
   - for node instance calls: output variables could NOT reuse aliasable input variables, 
269
     even if inputs become dead, because the correctness would depend on the scheduling
270
     of the callee (so, the compiling strategy could NOT be modular anymore).
271
   - once a policy is set, we need to:
272
     - replace each variable by its reuse alias.
273
     - simplify resulting equations, as we may now have:
274
        x = x;                     --> ;           for scalar vars
275
       or:
276
        x = &{ f1 = x->f1; f2 = t; } --> x->f2 = t;   for struct vars
277
 *)
278

    
279

    
280
(* the reuse policy seeks to use less local variables
281
   by replacing local variables, applying the rules
282
   in the following order:
283
    1) use another clock disjoint still live variable,
284
       with the greatest possible disjoint clock
285
    2) reuse a dead variable
286
   For the sake of safety, we replace variables by others:
287
    - with the same type
288
    - not aliasable (i.e. address type)
289
*)
290

    
291
(* Local Variables: *)
292
(* compile-command:"make -C .." *)
293
(* End: *)
(4-4/5)