Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / liveness.ml @ 7cd31331

History | View | Annotate | Download (10.6 KB)

1
(* ----------------------------------------------------------------------------
2
 * SchedMCore - A MultiCore Scheduling Framework
3
 * Copyright (C) 2009-2013, ONERA, Toulouse, FRANCE - LIFL, Lille, FRANCE
4
 * Copyright (C) 2012-2013, INPT, Toulouse, FRANCE
5
 *
6
 * This file is part of Prelude
7
 *
8
 * Prelude is free software; you can redistribute it and/or
9
 * modify it under the terms of the GNU Lesser General Public License
10
 * as published by the Free Software Foundation ; either version 2 of
11
 * the License, or (at your option) any later version.
12
 *
13
 * Prelude is distributed in the hope that it will be useful, but
14
 * WITHOUT ANY WARRANTY ; without even the implied warranty of
15
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16
 * Lesser General Public License for more details.
17
 *
18
 * You should have received a copy of the GNU Lesser General Public
19
 * License along with this program ; if not, write to the Free Software
20
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
21
 * USA
22
 *---------------------------------------------------------------------------- *)
23

    
24
open Utils
25
open LustreSpec
26
open Corelang
27
open Graph
28
open Causality
29

    
30
(* Computes the last dependency
31
*)
32

    
33
(* Computes the death table of [node] wrt dep graph [g] and topological [sort].
34
   The death table is a mapping: ident -> Set(ident) such that:
35
   death x is the set of local variables which get dead (i.e. unused) 
36
   after x is evaluated, but were until live.
37
let death_table node g sort =
38
  let death = Hashtbl.create 23 in
39
  let sort  = ref (List.rev sort) in
40
  let buried  = ref ISet.empty in
41
  begin
42
    buried := ExprDep.node_memory_variables node;
43
    buried := List.fold_left (fun dead (v : var_decl) -> ISet.add v.var_id dead) !buried node.node_outputs;
44
    (* We could also try to reuse input variables, due to C parameter copying semantics *)
45
    buried := List.fold_left (fun dead (v : var_decl) -> ISet.add v.var_id dead) !buried node.node_inputs;
46
    while (!sort <> [])
47
    do
48
      let head = List.hd !sort in
49
      let dead = IdentDepGraph.fold_succ
50
	(fun tgt dead -> if not (ExprDep.is_instance_var tgt || ISet.mem tgt !buried) then ISet.add tgt dead else dead)
51
	g head ISet.empty in
52
      buried := ISet.union !buried dead;
53
      Hashtbl.add death head dead;
54
      sort := List.tl !sort
55
    done;
56
    IdentDepGraph.clear g;
57
    death
58
  end
59
*)
60

    
61
(* computes the in-degree for each local variable of node [n], according to dep graph [g].
62
*)
63
let compute_fanin n g =
64
  let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in
65
  let fanin = Hashtbl.create 23 in
66
  begin
67
    IdentDepGraph.iter_vertex (fun v -> if ISet.mem v locals then Hashtbl.add fanin v (IdentDepGraph.in_degree g v)) g;
68
    fanin
69
  end
70
 
71
let pp_fanin fmt fanin =
72
  begin
73
    Format.fprintf fmt "{ /* locals fanin: */@.";
74
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %d@." s t) fanin;
75
    Format.fprintf fmt "}@."
76
  end
77

    
78
(* computes the cone of influence of a given [var] wrt a dependency graph [g].
79
*)
80
let cone_of_influence g var =
81
 (*Format.printf "coi: %s@." var;*)
82
 let frontier = ref (ISet.add var ISet.empty) in
83
 let coi = ref ISet.empty in
84
 while not (ISet.is_empty !frontier)
85
 do
86
   let head = ISet.min_elt !frontier in
87
   (*Format.printf "head: %s@." head;*)
88
   frontier := ISet.remove head !frontier;
89
   if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi;
90
   List.iter (fun s -> frontier := ISet.add s !frontier) (IdentDepGraph.succ g head);
91
 done;
92
 !coi
93

    
94
let compute_unused n g =
95
  let inputs = ExprDep.node_input_variables n in
96
  let mems = ExprDep.node_memory_variables n in
97
  let outputs = ExprDep.node_output_variables n in
98
  ISet.fold
99
    (fun var unused -> ISet.diff unused (cone_of_influence g var))
100
    (ISet.union outputs mems)
101
    (ISet.union inputs mems) 
102

    
103
(* Computes the set of (input and) output and mem variables of [node].
104
   We try to reuse input variables, due to C parameter copying semantics. *)
105
let node_non_locals node =
106
 List.fold_left (fun non_loc v -> ISet.add v.var_id non_loc) (ExprDep.node_memory_variables node) node.node_outputs
107

    
108
(* Recursively removes useless local variables,
109
   i.e. variables in [non_locals] that are current roots of the dep graph [g] *)
110
let remove_local_roots non_locals g =
111
  let rem = ref true in
112
  let roots = ref ISet.empty in
113
  while !rem
114
  do
115
    rem := false;
116
    let local_roots = List.filter (fun v -> not (ISet.mem v non_locals)) (graph_roots g) in
117
    if local_roots <> [] then
118
      begin
119
	rem := true;
120
	List.iter (IdentDepGraph.remove_vertex g) local_roots;
121
	roots := List.fold_left (fun roots v -> if ExprDep.is_instance_var v then roots else ISet.add v roots) !roots local_roots 
122
      end
123
  done;
124
  !roots
125

    
126
(* Computes the death table of [node] wrt dep graph [g] and topological [sort].
127
   The death table is a mapping: ident -> Set(ident) such that:
128
   death x is the set of local variables which get dead (i.e. unused) 
129
   before x is evaluated, but were until live.
130
   If death x is not defined, then x is useless.
131
*)
132
let death_table node g sort =
133
  let non_locals = node_non_locals node in
134
  let death = Hashtbl.create 23 in
135
  let sort  = ref sort in
136
  begin
137
    while (!sort <> [])
138
    do
139
      let head = List.hd !sort in
140
      (* If current var is not already dead, i.e. useless *)
141
      if IdentDepGraph.mem_vertex g head then
142
	begin
143
	  IdentDepGraph.iter_succ (IdentDepGraph.remove_edge g head) g head;
144
	  let dead = remove_local_roots non_locals g in
145
	  Hashtbl.add death head dead
146
	end;
147
      sort := List.tl !sort
148
    done;
149
    IdentDepGraph.clear g;
150
    death
151
  end
152

    
153
let pp_death_table fmt death =
154
  begin
155
    Format.fprintf fmt "{ /* death table */@.";
156
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> { %a }@." s (Utils.fprintf_list ~sep:", " Format.pp_print_string) (ISet.elements t)) death;
157
    Format.fprintf fmt "}@."
158
  end
159

    
160

    
161
(* Reuse policy:
162
   - could reuse variables with the same type exactly only (simple).
163
   - reusing variables with different types would involve:
164
     - either dirty castings
165
     - or complex inclusion expression (for instance: array <-> array cell, struct <-> struct field) to be able to reuse only some parts of structured data.
166
     ... it seems too complex and potentially unsafe
167
   - for node instance calls: output variables could NOT reuse aliasable input variables, 
168
     even if inputs become dead, because the correctness would depend on the scheduling
169
     of the callee (so, the compiling strategy could NOT be modular anymore).
170
   - once a policy is set, we need to:
171
     - replace each variable by its reuse alias.
172
     - simplify resulting equations, as we may now have:
173
        x = x;                     --> ;           for scalar vars
174
       or:
175
        x = &{ f1 = x->f1; f2 = t; } --> x->f2 = t;   for struct vars
176
     - such simplifications are, until now, only expressible at the C source level...
177
 *)
178

    
179
(* Replaces [v] by [v'] in set [s] *)
180
let replace_in_set s v v' =
181
  if ISet.mem v s then ISet.add v' (ISet.remove v s) else s
182

    
183
(* Replaces [v] by [v'] in death table [death] *)
184
let replace_in_death_table death v v' =
185
  begin
186
    Hashtbl.remove death v;
187
    Hashtbl.iter (fun k dead -> Hashtbl.replace death k (replace_in_set dead v v')) death
188
  end
189

    
190
let reuse_by_disjoint var reuse death disjoint =
191
  begin
192
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "reuse %s by disjoint %s@." var reuse.var_id);
193
    Disjunction.replace_in_disjoint_map disjoint var reuse.var_id;
194
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new disjoint:%a@." Disjunction.pp_disjoint_map disjoint);
195
  end
196

    
197

    
198
let reuse_by_dead var reuse death disjoint =
199
  begin
200
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "reuse %s by dead %s@." var reuse.var_id);
201
    replace_in_death_table death var reuse.var_id;
202
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new death:%a@." pp_death_table death);
203
  end
204

    
205
(* the set of really dead variables is a subset of dead vars by the death table.
206
   indeed, as variables may be aliased to other variables,
207
   a variable is dead only if all its disjoint-from-evaluated-var aliases are dead *)
208
let dead_aliased_variables var reuse dead =
209
 dead
210

    
211
let find_compatible_local node var dead death disjoint =
212
 (*Format.eprintf "find_compatible_local %s %s %a@." node.node_id var pp_iset dead;*)
213
  let typ = (get_node_var var node).var_type in
214
  let eq_var = get_node_eq var node in
215
  let locals = node.node_locals in
216
  let aliasable_inputs =
217
    match NodeDep.get_callee eq_var.eq_rhs with
218
    | None           -> []
219
    | Some (_, args) -> List.fold_right (fun e r -> match e.expr_desc with Expr_ident id -> id::r | _ -> r) args [] in
220
  let filter base (v : var_decl) =
221
    let res =
222
       base v
223
    && Typing.eq_ground typ v.var_type
224
    && not (Types.is_address_type v.var_type && List.mem v.var_id aliasable_inputs) in
225
    begin
226
      (*Format.eprintf "filter %a = %s@." Printers.pp_var_name v (if res then "true" else "false");*)
227
      res
228
    end in
229
Log.report ~level:6 (fun fmt -> Format.fprintf fmt "reuse %s@." var);
230
  try
231
    let disj = Hashtbl.find disjoint var in
232
    let reuse = List.find (filter (fun v -> ISet.mem v.var_id disj && not (ISet.mem v.var_id dead))) locals in
233
    reuse_by_disjoint var reuse death disjoint;
234
    Some reuse
235
  with Not_found ->
236
  try
237
    let reuse = List.find (filter (fun v -> ISet.mem v.var_id dead)) locals in
238
    reuse_by_dead var reuse death disjoint;
239
    Some reuse
240
  with Not_found -> None
241

    
242
(* the reuse policy seeks to use less local variables
243
   by replacing local variables, applying the rules
244
   in the following order:
245
    1) use another clock disjoint still live variable,
246
       with the greatest possible disjoint clock
247
    2) reuse a dead variable
248
   For the sake of safety, we replace variables by others:
249
    - with the same type
250
    - not aliasable (i.e. address type)
251
*)
252
let reuse_policy node sort death disjoint =
253
  let dead = ref ISet.empty in
254
  let real_dead = ref ISet.empty in
255
  let policy = Hashtbl.create 23 in
256
  let sort = ref [] (*sort*) in
257
  let aux_vars = ExprDep.node_auxiliary_variables node in
258
  while !sort <> []
259
  do
260
    let head = List.hd !sort in
261
    if ISet.mem head aux_vars then
262
      begin
263
	if Hashtbl.mem death head then
264
	  begin
265
	    dead := ISet.union (Hashtbl.find death head) !dead;
266
	  end;
267
	real_dead := ISet.empty;
268
	(match find_compatible_local node head !real_dead death disjoint with
269
	| Some reuse -> Hashtbl.add policy head reuse
270
	| None -> ());
271
	sort := List.tl !sort;
272
      end
273
  done;
274
  policy
275
 
276
let pp_reuse_policy fmt policy =
277
  begin
278
    Format.fprintf fmt "{ /* reuse policy */@.";
279
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %s@." s t.var_id) policy;
280
    Format.fprintf fmt "}@."
281
  end
282
(* Local Variables: *)
283
(* compile-command:"make -C .." *)
284
(* End: *)