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 in-degree 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 quasi-reusable 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 |
(* compile-command:"make -C .." *) |
277 |
(* End: *) |