lustrec / src / liveness.ml @ e9350b02
History  View  Annotate  Download (11.3 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 
type context = 
19 
{ 
20 
mutable evaluated : Disjunction.CISet.t; 
21 
dep_graph : IdentDepGraph.t; 
22 
disjoint : (ident, Disjunction.CISet.t) Hashtbl.t; 
23 
policy : (ident, var_decl) Hashtbl.t; 
24 
} 
25  
26 
(* computes the indegree for each local variable of node [n], according to dep graph [g]. 
27 
*) 
28 
let compute_fanin n g = 
29 
let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in 
30 
let inputs = ExprDep.node_input_variables n in 
31 
let fanin = Hashtbl.create 23 in 
32 
begin 
33 
IdentDepGraph.iter_vertex 
34 
(fun v > 
35 
if ISet.mem v locals 
36 
then Hashtbl.add fanin v (IdentDepGraph.in_degree g v) else 
37 
if ExprDep.is_read_var v && not (ISet.mem v inputs) 
38 
then Hashtbl.add fanin (ExprDep.undo_read_var v) (IdentDepGraph.in_degree g v)) g; 
39 
fanin 
40 
end 
41 

42 
let pp_fanin fmt fanin = 
43 
begin 
44 
Format.fprintf fmt "{ /* locals fanin: */@."; 
45 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %d@." s t) fanin; 
46 
Format.fprintf fmt "}@." 
47 
end 
48  
49 
(* computes the cone of influence of a given [var] wrt a dependency graph [g]. 
50 
*) 
51 
let cone_of_influence g var = 
52 
(*Format.printf "coi: %s@." var;*) 
53 
let frontier = ref (ISet.add var 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 "head: %s@." head;*) 
59 
frontier := ISet.remove head !frontier; 
60 
if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi; 
61 
List.iter (fun s > frontier := ISet.add s !frontier) (IdentDepGraph.succ g head); 
62 
done; 
63 
!coi 
64  
65 
let compute_unused_variables n g = 
66 
let inputs = ExprDep.node_input_variables n in 
67 
let mems = ExprDep.node_memory_variables n in 
68 
let outputs = ExprDep.node_output_variables n in 
69 
ISet.fold 
70 
(fun var unused > ISet.diff unused (cone_of_influence g var)) 
71 
(ISet.union outputs mems) 
72 
(ISet.union inputs mems) 
73  
74 
(* computes the set of potentially reusable variables. 
75 
We don't reuse input variables, due to possible aliasing *) 
76 
let node_reusable_variables node = 
77 
let mems = ExprDep.node_memory_variables node in 
78 
List.fold_left 
79 
(fun acc l > 
80 
if ISet.mem l.var_id mems then acc else Disjunction.CISet.add l acc) 
81 
Disjunction.CISet.empty 
82 
node.node_locals 
83  
84 
let kill_root ctx head = 
85 
IdentDepGraph.iter_succ (IdentDepGraph.remove_edge ctx.dep_graph head.var_id) ctx.dep_graph head.var_id 
86  
87 
(* Recursively removes useless variables, 
88 
i.e. [ctx.evaluated] variables that are current roots of the dep graph [ctx.dep_graph] 
89 
 [evaluated] is the set of already evaluated variables, 
90 
wrt the scheduling 
91 
 does only remove edges, not variables themselves 
92 
*) 
93 
let remove_roots ctx = 
94 
let rem = ref true in 
95 
let remaining = ref ctx.evaluated in 
96 
while !rem 
97 
do 
98 
rem := false; 
99 
let all_roots = graph_roots ctx.dep_graph in 
100 
let frontier_roots = Disjunction.CISet.filter (fun v > List.mem v.var_id all_roots) !remaining in 
101 
if not (Disjunction.CISet.is_empty frontier_roots) then 
102 
begin 
103 
rem := true; 
104 
Disjunction.CISet.iter (kill_root ctx) frontier_roots; 
105 
remaining := Disjunction.CISet.diff !remaining frontier_roots 
106 
end 
107 
done 
108 

109 
(* checks whether a variable is aliasable, 
110 
depending on its (address) type *) 
111 
let is_aliasable var = 
112 
Types.is_address_type var.var_type 
113 

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