lustrec / src / liveness.ml @ 44bea83a
History  View  Annotate  Download (10.6 KB)
1 
(*  

2 
* SchedMCore  A MultiCore Scheduling Framework 
3 
* Copyright (C) 20092013, ONERA, Toulouse, FRANCE  LIFL, Lille, FRANCE 
4 
* Copyright (C) 20122013, 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 021111307 
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 indegree 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 disjointfromevaluatedvar 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 
(* compilecommand:"make C .." *) 
284 
(* End: *) 