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