lustrec / src / liveness.ml @ 45c13277
History  View  Annotate  Download (11.6 KB)
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 
(* computes the indegree for each local variable of node [n], according to dep graph [g]. 
19 
*) 
20 
let compute_fanin n g = 
21 
let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in 
22 
let fanin = Hashtbl.create 23 in 
23 
begin 
24 
IdentDepGraph.iter_vertex (fun v > if ISet.mem v locals then Hashtbl.add fanin v (IdentDepGraph.in_degree g v)) g; 
25 
fanin 
26 
end 
27 

28 
let pp_fanin fmt fanin = 
29 
begin 
30 
Format.fprintf fmt "{ /* locals fanin: */@."; 
31 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %d@." s t) fanin; 
32 
Format.fprintf fmt "}@." 
33 
end 
34  
35 
(* computes the cone of influence of a given [var] wrt a dependency graph [g]. 
36 
*) 
37 
let cone_of_influence g var = 
38 
(*Format.printf "coi: %s@." var;*) 
39 
let frontier = ref (ISet.add var ISet.empty) in 
40 
let coi = ref ISet.empty in 
41 
while not (ISet.is_empty !frontier) 
42 
do 
43 
let head = ISet.min_elt !frontier in 
44 
(*Format.printf "head: %s@." head;*) 
45 
frontier := ISet.remove head !frontier; 
46 
if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi; 
47 
List.iter (fun s > frontier := ISet.add s !frontier) (IdentDepGraph.succ g head); 
48 
done; 
49 
!coi 
50  
51 
let compute_unused_variables n g = 
52 
let inputs = ExprDep.node_input_variables n in 
53 
let mems = ExprDep.node_memory_variables n in 
54 
let outputs = ExprDep.node_output_variables n in 
55 
ISet.fold 
56 
(fun var unused > ISet.diff unused (cone_of_influence g var)) 
57 
(ISet.union outputs mems) 
58 
(ISet.union inputs mems) 
59  
60 
(* checks whether a variable is aliasable, 
61 
depending on its (address) type *) 
62 
let is_aliasable var = 
63 
Types.is_address_type var.var_type 
64  
65 
(* computes the set of potentially reusable variables. 
66 
We don't reuse input variables, due to possible aliasing *) 
67 
let node_reusable_variables node = 
68 
let mems = ExprDep.node_memory_variables node in 
69 
List.fold_left 
70 
(fun acc l > 
71 
if ISet.mem l.var_id mems then acc else Disjunction.CISet.add l acc) 
72 
Disjunction.CISet.empty 
73 
node.node_locals 
74  
75 
(* Recursively removes useless variables, 
76 
i.e. variables that are current roots of the dep graph [g] 
77 
and returns [locals] and [evaluated] such roots 
78 
 [locals] is the set of potentially reusable variables 
79 
 [evaluated] is the set of already evaluated variables, 
80 
wrt the scheduling 
81 
*) 
82 
let remove_local_roots locals evaluated g = 
83 
let rem = ref true in 
84 
let roots = ref Disjunction.CISet.empty in 
85 
while !rem 
86 
do 
87 
rem := false; 
88 
let new_roots = graph_roots g in 
89 
let reusable_roots = Disjunction.CISet.filter (fun v > (List.mem v.var_id new_roots) && (Disjunction.CISet.mem v locals)) evaluated in 
90 
if not (Disjunction.CISet.is_empty reusable_roots) then 
91 
begin 
92 
rem := true; 
93 
Disjunction.CISet.iter (fun v > IdentDepGraph.remove_vertex g v.var_id) reusable_roots; 
94 
roots := Disjunction.CISet.union reusable_roots !roots 
95 
end 
96 
done; 
97 
!roots 
98 

99 
(* checks whether a variable [v] is an input of the [var] equation, with an address type. 
100 
if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node, 
101 
because [v] may not be dead in the callee node when [var] is assigned *) 
102 
let is_aliasable_input node var = 
103 
let eq_var = get_node_eq var node in 
104 
let inputs_var = 
105 
match NodeDep.get_callee eq_var.eq_rhs with 
106 
 None > [] 
107 
 Some (_, args) > List.fold_right (fun e r > match e.expr_desc with Expr_ident id > id::r  _ > r) args [] in 
108 
fun v > is_aliasable v && List.mem v.var_id inputs_var 
109  
110 
(* replace variable [v] by [v'] in graph [g]. 
111 
[v'] is a dead variable 
112 
*) 
113 
let replace_in_dep_graph v v' g = 
114 
begin 
115 
IdentDepGraph.add_vertex g v'; 
116 
IdentDepGraph.iter_succ (fun s > IdentDepGraph.add_edge g v' s) g v; 
117 
IdentDepGraph.iter_pred (fun p > IdentDepGraph.add_edge g p v') g v; 
118 
IdentDepGraph.remove_vertex g v 
119 
end 
120  
121 
type context = 
122 
{ 
123 
mutable evaluated : Disjunction.CISet.t; 
124 
mutable quasi : Disjunction.CISet.t; 
125 
mutable reusable : Disjunction.CISet.t; 
126 
disjoint : (ident, Disjunction.CISet.t) Hashtbl.t; 
127 
policy : (ident, var_decl) Hashtbl.t; 
128 
} 
129  
130 
let pp_reuse_policy fmt policy = 
131 
begin 
132 
Format.fprintf fmt "{ /* reuse policy */@."; 
133 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %s@." s t.var_id) policy; 
134 
Format.fprintf fmt "}@." 
135 
end 
136  
137 
let pp_context fmt ctx = 
138 
begin 
139 
Format.fprintf fmt "{ /*BEGIN context */@."; 
140 
Format.fprintf fmt "eval=%a;@." Disjunction.pp_ciset ctx.evaluated; 
141 
Format.fprintf fmt "quasi=%a;@." Disjunction.pp_ciset ctx.quasi; 
142 
Format.fprintf fmt "reusable=%a;@." Disjunction.pp_ciset ctx.reusable; 
143 
Format.fprintf fmt "disjoint=%a;@." Disjunction.pp_disjoint_map ctx.disjoint; 
144 
Format.fprintf fmt "policy=%a;@." pp_reuse_policy ctx.policy; 
145 
Format.fprintf fmt "/* END context */ }@."; 
146 
end 
147  
148 
let is_reusable_quasi var ctx q = 
149 
(*Log.report ~level:6 (fun fmt > Format.fprintf fmt "is_reusable_quasi@ var=%s %a q=%s@." var.var_id pp_context ctx q.var_id);*) 
150 
let disjoint = Hashtbl.find ctx.disjoint var.var_id in 
151 
let q = Hashtbl.find ctx.policy q.var_id in 
152 
Disjunction.CISet.for_all 
153 
(fun v > (Hashtbl.find ctx.policy v.var_id = q) <= (Disjunction.CISet.mem v disjoint  Disjunction.CISet.mem v ctx.quasi)) 
154 
ctx.evaluated 
155  
156 
let compute_reusable heads var ctx = 
157 
let (reusable', quasi') = Disjunction.CISet.partition (fun q > (not (List.mem q heads)) && is_reusable_quasi var ctx q) ctx.quasi 
158 
in 
159 
begin 
160 
ctx.quasi < quasi'; 
161 
ctx.reusable < Disjunction.CISet.fold (fun r' > Disjunction.CISet.add (Hashtbl.find ctx.policy r'.var_id)) reusable' ctx.reusable; 
162 
ctx.quasi < Disjunction.CISet.diff ctx.quasi reusable'; 
163 
ctx.evaluated < Disjunction.CISet.diff ctx.evaluated reusable'; 
164 
end 
165  
166 
(* computes the reusable dependencies of variable [var] in graph [g], 
167 
once [var] has been evaluated 
168 
 [locals] is the set of potentially reusable variables 
169 
 [evaluated] is the set of evaluated variables 
170 
 [quasi] is the set of quasireusable variables 
171 
 [reusable] is the set of dead/reusable dependencies of [var] in graph [g] 
172 
 [policy] is the reuse map (which domain is [evaluated]) 
173 
*) 
174 
let compute_dependencies locals heads ctx g = 
175 
begin 
176 
(*Log.report ~level:6 (fun fmt > Format.fprintf fmt "compute_reusable_dependencies %a %a %a %a@." Disjunction.pp_ciset locals Printers.pp_var_name var pp_context ctx pp_dep_graph g);*) 
177 
List.iter (fun head > IdentDepGraph.iter_succ (IdentDepGraph.remove_edge g head.var_id) g head.var_id) heads; 
178 
ctx.quasi < Disjunction.CISet.union (remove_local_roots locals ctx.evaluated g) ctx.quasi; 
179 
List.iter (fun head > compute_reusable heads head ctx) heads; 
180 
end 
181  
182 
let compute_evaluated heads ctx = 
183 
begin 
184 
List.iter (fun head > ctx.evaluated < Disjunction.CISet.add head ctx.evaluated) heads; 
185 
end 
186  
187 
let compute_reuse node var ctx g = 
188 
let aliasable = is_aliasable_input node var.var_id in 
189 
let eligible v = Typing.eq_ground var.var_type v.var_type && not (aliasable v) in 
190 
try 
191 
let disj = Hashtbl.find ctx.disjoint var.var_id in 
192 
let reuse = 
193 
Hashtbl.find ctx.policy 
194 
(Disjunction.CISet.max_elt (Disjunction.CISet.filter (fun v > (eligible v) && (Disjunction.CISet.mem v ctx.evaluated) && not (Disjunction.CISet.mem v ctx.reusable)) disj)).var_id in 
195 
begin 
196 
ctx.evaluated < Disjunction.CISet.add var ctx.evaluated; 
197 
Hashtbl.add ctx.policy var.var_id reuse; 
198 
end 
199 
with Not_found > 
200 
try 
201 
let reuse = Hashtbl.find ctx.policy (Disjunction.CISet.choose (Disjunction.CISet.filter (fun v > eligible v) ctx.reusable)).var_id in 
202 
begin 
203 
replace_in_dep_graph var.var_id reuse.var_id g; 
204 
Disjunction.replace_in_disjoint_map ctx.disjoint var reuse; 
205 
ctx.evaluated < Disjunction.CISet.add reuse ctx.evaluated; 
206 
ctx.reusable < Disjunction.CISet.remove reuse ctx.reusable; 
207 
Hashtbl.add ctx.policy var.var_id reuse; 
208 
end 
209 
with Not_found > 
210 
begin 
211 
ctx.evaluated < Disjunction.CISet.add var ctx.evaluated; 
212 
Hashtbl.add ctx.policy var.var_id var; 
213 
end 
214  
215 
let compute_reuse_policy node schedule disjoint g = 
216 
let locals = node_reusable_variables node in 
217 
let sort = ref schedule in 
218 
let ctx = { evaluated = Disjunction.CISet.empty; 
219 
quasi = Disjunction.CISet.empty; 
220 
reusable = Disjunction.CISet.empty; 
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 
Log.report ~level:6 
227 
(fun fmt > Format.fprintf fmt "new dependency graph:%a@." pp_dep_graph g); 
228 
let heads = List.map (fun v > get_node_var v node) (List.hd !sort) in 
229 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "NEW HEADS:"); 
230 
List.iter (fun head > Log.report ~level:2 (fun fmt > Format.fprintf fmt "%s " head.var_id)) heads; 
231 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "@."); 
232 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "COMPUTE_DEPENDENCIES@."); 
233 
compute_dependencies locals heads ctx g; 
234 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "new context:%a@." pp_context ctx); 
235 
Log.report ~level:6 
236 
(fun fmt > Format.fprintf fmt "new dependency graph:%a@." pp_dep_graph g); 
237 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "COMPUTE_REUSE@."); 
238 
List.iter (fun head > compute_reuse node head ctx g) heads; 
239 
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; 
240 
sort := List.tl !sort; 
241 
done; 
242 
IdentDepGraph.clear g; 
243 
ctx.policy 
244  
245 
(* Reuse policy: 
246 
 could reuse variables with the same type exactly only (simple). 
247 
 reusing variables with different types would involve: 
248 
 either dirty castings 
249 
 or complex inclusion expression (for instance: array <> array cell, struct <> struct field) to be able to reuse only some parts of structured data. 
250 
... it seems too complex and potentially unsafe 
251 
 for node instance calls: output variables could NOT reuse aliasable input variables, 
252 
even if inputs become dead, because the correctness would depend on the scheduling 
253 
of the callee (so, the compiling strategy could NOT be modular anymore). 
254 
 once a policy is set, we need to: 
255 
 replace each variable by its reuse alias. 
256 
 simplify resulting equations, as we may now have: 
257 
x = x; > ; for scalar vars 
258 
or: 
259 
x = &{ f1 = x>f1; f2 = t; } > x>f2 = t; for struct vars 
260 
 such simplifications are, until now, only expressible at the C source level... 
261 
*) 
262  
263  
264 
(* the reuse policy seeks to use less local variables 
265 
by replacing local variables, applying the rules 
266 
in the following order: 
267 
1) use another clock disjoint still live variable, 
268 
with the greatest possible disjoint clock 
269 
2) reuse a dead variable 
270 
For the sake of safety, we replace variables by others: 
271 
 with the same type 
272 
 not aliasable (i.e. address type) 
273 
*) 
274  
275 
(* Local Variables: *) 
276 
(* compilecommand:"make C .." *) 
277 
(* End: *) 