Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / liveness.ml @ bb2ca5f4

History | View | Annotate | Download (9.65 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 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
 Hashtbl.iter (fun k dead -> Hashtbl.replace death k (replace_in_set dead v v')) death
186

    
187
let find_compatible_local node var dead death disjoint policy =
188
 (*Format.eprintf "find_compatible_local %s %s %a@." node.node_id var pp_iset dead;*)
189
  let typ = (get_node_var var node).var_type in
190
  let eq_var = get_node_eq var node in
191
  let locals = node.node_locals in
192
  let aliasable_inputs =
193
    match NodeDep.get_callee eq_var.eq_rhs with
194
    | None           -> []
195
    | Some (_, args) -> List.fold_right (fun e r -> match e.expr_desc with Expr_ident id -> id::r | _ -> r) args [] in
196
  let filter base (v : var_decl) =
197
    let res =
198
       base v
199
    && Typing.eq_ground typ v.var_type
200
    && not (Types.is_address_type v.var_type && List.mem v.var_id aliasable_inputs) in
201
    begin
202
      (*Format.eprintf "filter %a = %s@." Printers.pp_var_name v (if res then "true" else "false");*)
203
      res
204
    end in
205
(*Format.eprintf "reuse %s@." var;*)
206
  try
207
    let disj = Hashtbl.find disjoint var in
208
    let reuse = List.find (filter (fun v -> ISet.mem v.var_id disj && not (ISet.mem v.var_id dead))) locals in
209
(*Format.eprintf "reuse %s by %s@." var reuse.var_id;*)
210
    Disjunction.replace_in_disjoint_map disjoint var reuse.var_id;
211
(*Format.eprintf "new disjoint:%a@." Disjunction.pp_disjoint_map disjoint;*)
212
    Hashtbl.add policy var reuse.var_id
213
  with Not_found ->
214
  try
215
    let reuse = List.find (filter (fun v -> ISet.mem v.var_id dead)) locals in
216
(*Format.eprintf "reuse %s by %s@." var reuse.var_id;*)
217
    replace_in_death_table death var reuse.var_id;
218
(*Format.eprintf "new death:%a@." pp_death_table death;*)
219
    Hashtbl.add policy var reuse.var_id
220
  with Not_found -> ()
221

    
222
(* the reuse policy seeks to use less local variables
223
   by replacing local variables, applying the rules
224
   in the following order:
225
    1) use another clock disjoint still live variable,
226
       with the greatest possible disjoint clock
227
    2) reuse a dead variable
228
   For the sake of safety, we replace variables by others:
229
    - with the same type
230
    - not aliasable (i.e. address type)
231
*)
232
let reuse_policy node sort death disjoint =
233
  let dead = ref ISet.empty in
234
  let policy = Hashtbl.create 23 in
235
  let sort = ref sort in
236
  while !sort <> []
237
  do
238
    let head = List.hd !sort in
239
    if Hashtbl.mem death head then
240
      begin
241
	dead := ISet.union (Hashtbl.find death head) !dead;
242
      end;
243
    find_compatible_local node head !dead death disjoint policy;
244
    sort := List.tl !sort;
245
  done;
246
  policy
247
 
248
let pp_reuse_policy fmt policy =
249
  begin
250
    Format.fprintf fmt "{ /* reuse policy */@.";
251
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %s@." s t) policy;
252
    Format.fprintf fmt "}@."
253
  end
254
(* Local Variables: *)
255
(* compile-command:"make -C .." *)
256
(* End: *)