Revision ca7ff3f7
Added by Lélio Brun over 1 year ago
src/checks/liveness.ml | ||
---|---|---|
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 Lustre_types |
|
14 |
open Corelang |
|
15 |
open Causality |
|
16 |
|
|
17 |
type context = |
|
18 |
{ |
|
19 |
mutable evaluated : Disjunction.CISet.t; |
|
20 |
dep_graph : IdentDepGraph.t; |
|
21 |
disjoint : (ident, Disjunction.CISet.t) Hashtbl.t; |
|
22 |
policy : (ident, var_decl) Hashtbl.t; |
|
23 |
} |
|
24 |
|
|
25 |
(* computes the in-degree for each local variable of node [n], according to dep graph [g]. |
|
26 |
*) |
|
27 |
let compute_fanin n g = |
|
28 |
let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in |
|
29 |
let inputs = ExprDep.node_input_variables n in |
|
30 |
let fanin = Hashtbl.create 23 in |
|
31 |
begin |
|
32 |
IdentDepGraph.iter_vertex |
|
33 |
(fun v -> |
|
34 |
if ISet.mem v locals |
|
35 |
then Hashtbl.add fanin v (IdentDepGraph.in_degree g v) else |
|
36 |
if ExprDep.is_read_var v && not (ISet.mem v inputs) |
|
37 |
then Hashtbl.add fanin (ExprDep.undo_read_var v) (IdentDepGraph.in_degree g v)) g; |
|
38 |
fanin |
|
39 |
end |
|
40 |
|
|
41 |
let pp_fanin fmt fanin = |
|
42 |
Format.fprintf fmt "@[<v 0>@[<v 2>{ /* locals fanin: */"; |
|
43 |
Hashtbl.iter (fun s t -> Format.fprintf fmt "@ %s -> %d" s t) fanin; |
|
44 |
Format.fprintf fmt "@]@ }@]" |
|
45 |
|
|
46 |
(* computes the cone of influence of a given [var] wrt a dependency graph [g]. |
|
47 |
*) |
|
48 |
let cone_of_influence g var = |
|
49 |
(*Format.printf "DEBUG coi: %s@." var;*) |
|
50 |
let frontier = ref (ISet.add var ISet.empty) in |
|
51 |
let explored = ref ISet.empty in |
|
52 |
let coi = ref ISet.empty in |
|
53 |
while not (ISet.is_empty !frontier) |
|
54 |
do |
|
55 |
let head = ISet.min_elt !frontier in |
|
56 |
(*Format.printf "DEBUG head: %s@." head;*) |
|
57 |
frontier := ISet.remove head !frontier; |
|
58 |
explored := ISet.add head !explored; |
|
59 |
if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi; |
|
60 |
List.iter (fun s -> if not (ISet.mem s !explored) then frontier := ISet.add s !frontier) (IdentDepGraph.succ g head); |
|
61 |
done; |
|
62 |
!coi |
|
63 |
|
|
64 |
let compute_unused_variables n g = |
|
65 |
let inputs = ExprDep.node_input_variables n in |
|
66 |
let mems = ExprDep.node_memory_variables n in |
|
67 |
let outputs = ExprDep.node_output_variables n in |
|
68 |
ISet.fold |
|
69 |
(fun var unused -> ISet.diff unused (cone_of_influence g var)) |
|
70 |
(ISet.union outputs mems) |
|
71 |
(ISet.union inputs mems) |
|
72 |
|
|
73 |
(* computes the set of potentially reusable variables. |
|
74 |
We don't reuse input variables, due to possible aliasing *) |
|
75 |
let node_reusable_variables node = |
|
76 |
let mems = ExprDep.node_memory_variables node in |
|
77 |
List.fold_left |
|
78 |
(fun acc l -> |
|
79 |
if ISet.mem l.var_id mems then acc else Disjunction.CISet.add l acc) |
|
80 |
Disjunction.CISet.empty |
|
81 |
node.node_locals |
|
82 |
|
|
83 |
let kill_instance_variables ctx inst = |
|
84 |
IdentDepGraph.remove_vertex ctx.dep_graph inst |
|
85 |
|
|
86 |
let kill_root ctx head = |
|
87 |
IdentDepGraph.iter_succ (IdentDepGraph.remove_edge ctx.dep_graph head.var_id) ctx.dep_graph head.var_id |
|
88 |
|
|
89 |
(* Recursively removes useless variables, |
|
90 |
i.e. [ctx.evaluated] variables that are current roots of the dep graph [ctx.dep_graph] |
|
91 |
- [evaluated] is the set of already evaluated variables, |
|
92 |
wrt the scheduling |
|
93 |
- does only remove edges, not variables themselves |
|
94 |
- yet, instance variables are removed |
|
95 |
*) |
|
96 |
let remove_roots ctx = |
|
97 |
let rem = ref true in |
|
98 |
let remaining = ref ctx.evaluated in |
|
99 |
while !rem |
|
100 |
do |
|
101 |
rem := false; |
|
102 |
let all_roots = graph_roots ctx.dep_graph in |
|
103 |
let inst_roots, var_roots = List.partition (fun v -> ExprDep.is_instance_var v && v <> Causality.world) all_roots in |
|
104 |
let frontier_roots = Disjunction.CISet.filter (fun v -> List.mem v.var_id var_roots) !remaining in |
|
105 |
if not (Disjunction.CISet.is_empty frontier_roots && inst_roots = []) then |
|
106 |
begin |
|
107 |
rem := true; |
|
108 |
List.iter (kill_instance_variables ctx) inst_roots; |
|
109 |
Disjunction.CISet.iter (kill_root ctx) frontier_roots; |
|
110 |
remaining := Disjunction.CISet.diff !remaining frontier_roots |
|
111 |
end |
|
112 |
done |
|
113 |
|
|
114 |
(* checks whether a variable is aliasable, |
|
115 |
depending on its (address) type *) |
|
116 |
let is_aliasable var = |
|
117 |
(not (!Options.mpfr && Types.is_real_type var.var_type)) && Types.is_address_type var.var_type |
|
118 |
|
|
119 |
(* checks whether a variable [v] is an input of the [var] equation, with an address type. |
|
120 |
if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node, |
|
121 |
because [v] may not be dead in the callee node when [var] is assigned *) |
|
122 |
let is_aliasable_input node var = |
|
123 |
let eq_var = get_node_eq var node in |
|
124 |
let inputs_var = |
|
125 |
match NodeDep.get_callee eq_var.eq_rhs with |
|
126 |
| None -> [] |
|
127 |
| Some (_, args) -> List.fold_right (fun e r -> match e.expr_desc with Expr_ident id -> id::r | _ -> r) args [] in |
|
128 |
fun v -> is_aliasable v && List.mem v.var_id inputs_var |
|
129 |
|
|
130 |
(* replace variable [v] by [v'] in graph [g]. |
|
131 |
[v'] is a dead variable |
|
132 |
*) |
|
133 |
let replace_in_dep_graph v v' g = |
|
134 |
begin |
|
135 |
IdentDepGraph.add_vertex g v'; |
|
136 |
IdentDepGraph.iter_succ (fun s -> IdentDepGraph.add_edge g v' s) g v; |
|
137 |
IdentDepGraph.iter_pred (fun p -> IdentDepGraph.add_edge g p v') g v; |
|
138 |
IdentDepGraph.remove_vertex g v |
|
139 |
end |
|
140 |
|
|
141 |
let pp_reuse_policy fmt policy = |
|
142 |
Format.(fprintf fmt "@[<v 2>{ /* reuse policy */%t@] }" |
|
143 |
(fun fmt -> Hashtbl.iter (fun s t -> fprintf fmt "@,%s -> %s" s t.var_id) policy)) |
|
144 |
|
|
145 |
let pp_context fmt ctx = |
|
146 |
Format.fprintf fmt |
|
147 |
"@[<v 2>{ /*BEGIN context */@,\ |
|
148 |
eval = %a;@,\ |
|
149 |
graph = %a;@,\ |
|
150 |
disjoint = %a;@,\ |
|
151 |
policy = %a;@,\ |
|
152 |
/* END context */ }@]" |
|
153 |
Disjunction.pp_ciset ctx.evaluated |
|
154 |
pp_dep_graph ctx.dep_graph |
|
155 |
Disjunction.pp_disjoint_map ctx.disjoint |
|
156 |
pp_reuse_policy ctx.policy |
|
157 |
|
|
158 |
(* computes the reusable dependencies of variable [var] in graph [g], |
|
159 |
once [var] has been evaluated |
|
160 |
- [locals] is the set of potentially reusable variables |
|
161 |
- [evaluated] is the set of evaluated variables |
|
162 |
- [quasi] is the set of quasi-reusable variables |
|
163 |
- [reusable] is the set of dead/reusable dependencies of [var] in graph [g] |
|
164 |
- [policy] is the reuse map (which domain is [evaluated]) |
|
165 |
*) |
|
166 |
let compute_dependencies heads ctx = |
|
167 |
begin |
|
168 |
(*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);*) |
|
169 |
List.iter (kill_root ctx) heads; |
|
170 |
remove_roots ctx; |
|
171 |
end |
|
172 |
|
|
173 |
let compute_evaluated heads ctx = |
|
174 |
begin |
|
175 |
List.iter (fun head -> ctx.evaluated <- Disjunction.CISet.add head ctx.evaluated) heads; |
|
176 |
end |
|
177 |
|
|
178 |
(* tests whether a variable [v] may be (re)used instead of [var]. The conditions are: |
|
179 |
- [v] has been really used ([v] is its own representative) |
|
180 |
- same type |
|
181 |
- [v] is not an aliasable input of the equation defining [var] |
|
182 |
- [v] is not one of the current heads (which contain [var]) |
|
183 |
- [v] is not currently in use |
|
184 |
*) |
|
185 |
let eligible node ctx heads var v = |
|
186 |
Hashtbl.find ctx.policy v.var_id == v |
|
187 |
&& Typing.eq_ground (Types.unclock_type var.var_type) (Types.unclock_type v.var_type) |
|
188 |
&& not (is_aliasable_input node var.var_id v) |
|
189 |
&& not (List.exists (fun h -> h.var_id = v.var_id) heads) |
|
190 |
&& (*let repr_v = Hashtbl.find ctx.policy v.var_id*) |
|
191 |
not (Disjunction.CISet.exists (fun p -> IdentDepGraph.mem_edge ctx.dep_graph p.var_id v.var_id) ctx.evaluated) |
|
192 |
|
|
193 |
let compute_reuse node ctx heads var = |
|
194 |
let disjoint = Hashtbl.find ctx.disjoint var.var_id in |
|
195 |
let locally_reusable v = |
|
196 |
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 |
|
197 |
let eligibles = |
|
198 |
if ISet.mem var.var_id (ExprDep.node_memory_variables node) |
|
199 |
then Disjunction.CISet.empty |
|
200 |
else Disjunction.CISet.filter (eligible node ctx heads var) ctx.evaluated in |
|
201 |
let quasi_dead, live = Disjunction.CISet.partition locally_reusable eligibles in |
|
202 |
let disjoint_live = Disjunction.CISet.inter disjoint live in |
|
203 |
let dead = Disjunction.CISet.filter (fun v -> is_graph_root v.var_id ctx.dep_graph) quasi_dead in |
|
204 |
Log.report ~level:7 (fun fmt -> |
|
205 |
Format.fprintf fmt |
|
206 |
"@[<v>\ |
|
207 |
eligibles : %a@,\ |
|
208 |
live : %a@,\ |
|
209 |
disjoint live: %a@,\ |
|
210 |
dead : %a@,@]" |
|
211 |
Disjunction.pp_ciset eligibles |
|
212 |
Disjunction.pp_ciset live |
|
213 |
Disjunction.pp_ciset disjoint_live |
|
214 |
Disjunction.pp_ciset dead); |
|
215 |
begin try |
|
216 |
let reuse = match Disjunction.CISet.max_elt_opt disjoint_live with |
|
217 |
| Some reuse -> reuse |
|
218 |
| None -> Disjunction.CISet.choose dead in |
|
219 |
IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id; |
|
220 |
Hashtbl.add ctx.policy var.var_id reuse |
|
221 |
with Not_found -> Hashtbl.add ctx.policy var.var_id var |
|
222 |
end; |
|
223 |
ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated |
|
224 |
|
|
225 |
let compute_reuse_policy node schedule disjoint g = |
|
226 |
let ctx = { evaluated = Disjunction.CISet.empty; |
|
227 |
dep_graph = g; |
|
228 |
disjoint = disjoint; |
|
229 |
policy = Hashtbl.create 23; } in |
|
230 |
List.iter (fun heads -> |
|
231 |
let heads = List.map (fun v -> get_node_var v node) heads in |
|
232 |
Log.report ~level:6 (fun fmt -> |
|
233 |
Format.(fprintf fmt |
|
234 |
"@[<v>@[<v 2>new context:@,%a@]@,NEW HEADS:%a@,COMPUTE_DEPENDENCIES@,@]" |
|
235 |
pp_context ctx |
|
236 |
(pp_print_list |
|
237 |
~pp_open_box:pp_open_hbox |
|
238 |
~pp_sep:pp_print_space |
|
239 |
(fun fmt head -> |
|
240 |
fprintf fmt "%s (%a)" |
|
241 |
head.var_id Printers.pp_node_eq |
|
242 |
(get_node_eq head.var_id node))) |
|
243 |
heads)); |
|
244 |
compute_dependencies heads ctx; |
|
245 |
Log.report ~level:6 (fun fmt -> |
|
246 |
Format.fprintf fmt "@[<v>@[<v 2>new context:@,%a@]@,COMPUTE_REUSE@,@]" pp_context ctx); |
|
247 |
List.iter (compute_reuse node ctx heads) heads; |
|
248 |
(*compute_evaluated heads ctx;*) |
|
249 |
Log.report ~level:6 (fun fmt -> |
|
250 |
Format.(fprintf fmt "@[<v>%a@,@]" |
|
251 |
(pp_print_list |
|
252 |
~pp_open_box:pp_open_vbox0 |
|
253 |
(fun fmt head -> fprintf fmt "reuse %s instead of %s" |
|
254 |
(Hashtbl.find ctx.policy head.var_id).var_id head.var_id)) |
|
255 |
heads))) |
|
256 |
schedule; |
|
257 |
IdentDepGraph.clear ctx.dep_graph; |
|
258 |
ctx.policy |
|
259 |
|
|
260 |
(* Reuse policy: |
|
261 |
- could reuse variables with the same type exactly only (simple). |
|
262 |
- reusing variables with different types would involve: |
|
263 |
- either dirty castings |
|
264 |
- or complex inclusion expression (for instance: array <-> array cell, struct <-> struct field) to be able to reuse only some parts of structured data. |
|
265 |
... it seems too complex and potentially unsafe |
|
266 |
- for node instance calls: output variables could NOT reuse aliasable input variables, |
|
267 |
even if inputs become dead, because the correctness would depend on the scheduling |
|
268 |
of the callee (so, the compiling strategy could NOT be modular anymore). |
|
269 |
- once a policy is set, we need to: |
|
270 |
- replace each variable by its reuse alias. |
|
271 |
- simplify resulting equations, as we may now have: |
|
272 |
x = x; --> ; for scalar vars |
|
273 |
or: |
|
274 |
x = &{ f1 = x->f1; f2 = t; } --> x->f2 = t; for struct vars |
|
275 |
*) |
|
276 |
|
|
277 |
|
|
278 |
(* the reuse policy seeks to use less local variables |
|
279 |
by replacing local variables, applying the rules |
|
280 |
in the following order: |
|
281 |
1) use another clock disjoint still live variable, |
|
282 |
with the greatest possible disjoint clock |
|
283 |
2) reuse a dead variable |
|
284 |
For the sake of safety, we replace variables by others: |
|
285 |
- with the same type |
|
286 |
- not aliasable (i.e. address type) |
|
287 |
*) |
|
288 |
|
|
289 |
(* Local Variables: *) |
|
290 |
(* compile-command:"make -C .." *) |
|
291 |
(* End: *) |
|
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 Lustre_types |
|
14 |
open Corelang |
|
15 |
open Causality |
|
16 |
|
|
17 |
type context = { |
|
18 |
mutable evaluated : Disjunction.CISet.t; |
|
19 |
dep_graph : IdentDepGraph.t; |
|
20 |
disjoint : (ident, Disjunction.CISet.t) Hashtbl.t; |
|
21 |
policy : (ident, var_decl) Hashtbl.t; |
|
22 |
} |
|
23 |
|
|
24 |
(* computes the in-degree for each local variable of node [n], according to dep |
|
25 |
graph [g]. *) |
|
26 |
let compute_fanin n g = |
|
27 |
let locals = |
|
28 |
ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) |
|
29 |
in |
|
30 |
let inputs = ExprDep.node_input_variables n in |
|
31 |
let fanin = Hashtbl.create 23 in |
|
32 |
IdentDepGraph.iter_vertex |
|
33 |
(fun v -> |
|
34 |
if ISet.mem v locals then |
|
35 |
Hashtbl.add fanin v (IdentDepGraph.in_degree g v) |
|
36 |
else if ExprDep.is_read_var v && not (ISet.mem v inputs) then |
|
37 |
Hashtbl.add fanin (ExprDep.undo_read_var v) |
|
38 |
(IdentDepGraph.in_degree g v)) |
|
39 |
g; |
|
40 |
fanin |
|
41 |
|
|
42 |
let pp_fanin fmt fanin = |
|
43 |
Format.fprintf fmt "@[<v 0>@[<v 2>{ /* locals fanin: */"; |
|
44 |
Hashtbl.iter (fun s t -> Format.fprintf fmt "@ %s -> %d" s t) fanin; |
|
45 |
Format.fprintf fmt "@]@ }@]" |
|
46 |
|
|
47 |
(* computes the cone of influence of a given [var] wrt a dependency graph [g]. *) |
|
48 |
let cone_of_influence g var = |
|
49 |
(*Format.printf "DEBUG coi: %s@." var;*) |
|
50 |
let frontier = ref (ISet.add var ISet.empty) in |
|
51 |
let explored = ref ISet.empty in |
|
52 |
let coi = ref ISet.empty in |
|
53 |
while not (ISet.is_empty !frontier) do |
|
54 |
let head = ISet.min_elt !frontier in |
|
55 |
(*Format.printf "DEBUG head: %s@." head;*) |
|
56 |
frontier := ISet.remove head !frontier; |
|
57 |
explored := ISet.add head !explored; |
|
58 |
if ExprDep.is_read_var head then |
|
59 |
coi := ISet.add (ExprDep.undo_read_var head) !coi; |
|
60 |
List.iter |
|
61 |
(fun s -> |
|
62 |
if not (ISet.mem s !explored) then frontier := ISet.add s !frontier) |
|
63 |
(IdentDepGraph.succ g head) |
|
64 |
done; |
|
65 |
!coi |
|
66 |
|
|
67 |
let compute_unused_variables n g = |
|
68 |
let inputs = ExprDep.node_input_variables n in |
|
69 |
let mems = ExprDep.node_memory_variables n in |
|
70 |
let outputs = ExprDep.node_output_variables n in |
|
71 |
ISet.fold |
|
72 |
(fun var unused -> ISet.diff unused (cone_of_influence g var)) |
|
73 |
(ISet.union outputs mems) (ISet.union inputs mems) |
|
74 |
|
|
75 |
(* computes the set of potentially reusable variables. We don't reuse input |
|
76 |
variables, due to possible aliasing *) |
|
77 |
let node_reusable_variables node = |
|
78 |
let mems = ExprDep.node_memory_variables node in |
|
79 |
List.fold_left |
|
80 |
(fun acc l -> |
|
81 |
if ISet.mem l.var_id mems then acc else Disjunction.CISet.add l acc) |
|
82 |
Disjunction.CISet.empty node.node_locals |
|
83 |
|
|
84 |
let kill_instance_variables ctx inst = |
|
85 |
IdentDepGraph.remove_vertex ctx.dep_graph inst |
|
86 |
|
|
87 |
let kill_root ctx head = |
|
88 |
IdentDepGraph.iter_succ |
|
89 |
(IdentDepGraph.remove_edge ctx.dep_graph head.var_id) |
|
90 |
ctx.dep_graph head.var_id |
|
91 |
|
|
92 |
(* Recursively removes useless variables, i.e. [ctx.evaluated] variables that |
|
93 |
are current roots of the dep graph [ctx.dep_graph] - [evaluated] is the set |
|
94 |
of already evaluated variables, wrt the scheduling - does only remove edges, |
|
95 |
not variables themselves - yet, instance variables are removed *) |
|
96 |
let remove_roots ctx = |
|
97 |
let rem = ref true in |
|
98 |
let remaining = ref ctx.evaluated in |
|
99 |
while !rem do |
|
100 |
rem := false; |
|
101 |
let all_roots = graph_roots ctx.dep_graph in |
|
102 |
let inst_roots, var_roots = |
|
103 |
List.partition |
|
104 |
(fun v -> ExprDep.is_instance_var v && v <> Causality.world) |
|
105 |
all_roots |
|
106 |
in |
|
107 |
let frontier_roots = |
|
108 |
Disjunction.CISet.filter (fun v -> List.mem v.var_id var_roots) !remaining |
|
109 |
in |
|
110 |
if not (Disjunction.CISet.is_empty frontier_roots && inst_roots = []) then ( |
|
111 |
rem := true; |
|
112 |
List.iter (kill_instance_variables ctx) inst_roots; |
|
113 |
Disjunction.CISet.iter (kill_root ctx) frontier_roots; |
|
114 |
remaining := Disjunction.CISet.diff !remaining frontier_roots) |
|
115 |
done |
|
116 |
|
|
117 |
(* checks whether a variable is aliasable, depending on its (address) type *) |
|
118 |
let is_aliasable var = |
|
119 |
(not (!Options.mpfr && Types.is_real_type var.var_type)) |
|
120 |
&& Types.is_address_type var.var_type |
|
121 |
|
|
122 |
(* checks whether a variable [v] is an input of the [var] equation, with an |
|
123 |
address type. if so, [var] could not safely reuse/alias [v], should [v] be |
|
124 |
dead in the caller node, because [v] may not be dead in the callee node when |
|
125 |
[var] is assigned *) |
|
126 |
let is_aliasable_input node var = |
|
127 |
let eq_var = get_node_eq var node in |
|
128 |
let inputs_var = |
|
129 |
match NodeDep.get_callee eq_var.eq_rhs with |
|
130 |
| None -> |
|
131 |
[] |
|
132 |
| Some (_, args) -> |
|
133 |
List.fold_right |
|
134 |
(fun e r -> match e.expr_desc with Expr_ident id -> id :: r | _ -> r) |
|
135 |
args [] |
|
136 |
in |
|
137 |
fun v -> is_aliasable v && List.mem v.var_id inputs_var |
|
138 |
|
|
139 |
(* replace variable [v] by [v'] in graph [g]. [v'] is a dead variable *) |
|
140 |
let replace_in_dep_graph v v' g = |
|
141 |
IdentDepGraph.add_vertex g v'; |
|
142 |
IdentDepGraph.iter_succ (fun s -> IdentDepGraph.add_edge g v' s) g v; |
|
143 |
IdentDepGraph.iter_pred (fun p -> IdentDepGraph.add_edge g p v') g v; |
|
144 |
IdentDepGraph.remove_vertex g v |
|
145 |
|
|
146 |
let pp_reuse_policy fmt policy = |
|
147 |
Format.( |
|
148 |
fprintf fmt "@[<v 2>{ /* reuse policy */%t@] }" (fun fmt -> |
|
149 |
Hashtbl.iter (fun s t -> fprintf fmt "@,%s -> %s" s t.var_id) policy)) |
|
150 |
|
|
151 |
let pp_context fmt ctx = |
|
152 |
Format.fprintf fmt |
|
153 |
"@[<v 2>{ /*BEGIN context */@,\ |
|
154 |
eval = %a;@,\ |
|
155 |
graph = %a;@,\ |
|
156 |
disjoint = %a;@,\ |
|
157 |
policy = %a;@,\ |
|
158 |
/* END context */ }@]" Disjunction.pp_ciset ctx.evaluated pp_dep_graph |
|
159 |
ctx.dep_graph Disjunction.pp_disjoint_map ctx.disjoint pp_reuse_policy |
|
160 |
ctx.policy |
|
161 |
|
|
162 |
(* computes the reusable dependencies of variable [var] in graph [g], once [var] |
|
163 |
has been evaluated - [locals] is the set of potentially reusable variables - |
|
164 |
[evaluated] is the set of evaluated variables - [quasi] is the set of |
|
165 |
quasi-reusable variables - [reusable] is the set of dead/reusable |
|
166 |
dependencies of [var] in graph [g] - [policy] is the reuse map (which domain |
|
167 |
is [evaluated]) *) |
|
168 |
let compute_dependencies heads ctx = |
|
169 |
(*Log.report ~level:6 (fun fmt -> Format.fprintf fmt |
|
170 |
"compute_reusable_dependencies %a %a %a@." Disjunction.pp_ciset locals |
|
171 |
Printers.pp_var_name var pp_context ctx);*) |
|
172 |
List.iter (kill_root ctx) heads; |
|
173 |
remove_roots ctx |
|
174 |
|
|
175 |
let compute_evaluated heads ctx = |
|
176 |
List.iter |
|
177 |
(fun head -> ctx.evaluated <- Disjunction.CISet.add head ctx.evaluated) |
|
178 |
heads |
|
179 |
|
|
180 |
(* tests whether a variable [v] may be (re)used instead of [var]. The conditions |
|
181 |
are: - [v] has been really used ([v] is its own representative) - same type - |
|
182 |
[v] is not an aliasable input of the equation defining [var] - [v] is not one |
|
183 |
of the current heads (which contain [var]) - [v] is not currently in use *) |
|
184 |
let eligible node ctx heads var v = |
|
185 |
Hashtbl.find ctx.policy v.var_id == v |
|
186 |
&& Typing.eq_ground |
|
187 |
(Types.unclock_type var.var_type) |
|
188 |
(Types.unclock_type v.var_type) |
|
189 |
&& (not (is_aliasable_input node var.var_id v)) |
|
190 |
&& (not (List.exists (fun h -> h.var_id = v.var_id) heads)) |
|
191 |
&& (*let repr_v = Hashtbl.find ctx.policy v.var_id*) |
|
192 |
not |
|
193 |
(Disjunction.CISet.exists |
|
194 |
(fun p -> IdentDepGraph.mem_edge ctx.dep_graph p.var_id v.var_id) |
|
195 |
ctx.evaluated) |
|
196 |
|
|
197 |
let compute_reuse node ctx heads var = |
|
198 |
let disjoint = Hashtbl.find ctx.disjoint var.var_id in |
|
199 |
let locally_reusable v = |
|
200 |
IdentDepGraph.fold_pred |
|
201 |
(fun p r -> |
|
202 |
r && Disjunction.CISet.exists (fun d -> p = d.var_id) disjoint) |
|
203 |
ctx.dep_graph v.var_id true |
|
204 |
in |
|
205 |
let eligibles = |
|
206 |
if ISet.mem var.var_id (ExprDep.node_memory_variables node) then |
|
207 |
Disjunction.CISet.empty |
|
208 |
else Disjunction.CISet.filter (eligible node ctx heads var) ctx.evaluated |
|
209 |
in |
|
210 |
let quasi_dead, live = |
|
211 |
Disjunction.CISet.partition locally_reusable eligibles |
|
212 |
in |
|
213 |
let disjoint_live = Disjunction.CISet.inter disjoint live in |
|
214 |
let dead = |
|
215 |
Disjunction.CISet.filter |
|
216 |
(fun v -> is_graph_root v.var_id ctx.dep_graph) |
|
217 |
quasi_dead |
|
218 |
in |
|
219 |
Log.report ~level:7 (fun fmt -> |
|
220 |
Format.fprintf fmt |
|
221 |
"@[<v>eligibles : %a@,\ |
|
222 |
live : %a@,\ |
|
223 |
disjoint live: %a@,\ |
|
224 |
dead : %a@,\ |
|
225 |
@]" |
|
226 |
Disjunction.pp_ciset eligibles Disjunction.pp_ciset live |
|
227 |
Disjunction.pp_ciset disjoint_live Disjunction.pp_ciset dead); |
|
228 |
(try |
|
229 |
let reuse = |
|
230 |
match Disjunction.CISet.max_elt_opt disjoint_live with |
|
231 |
| Some reuse -> |
|
232 |
reuse |
|
233 |
| None -> |
|
234 |
Disjunction.CISet.choose dead |
|
235 |
in |
|
236 |
IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id; |
|
237 |
Hashtbl.add ctx.policy var.var_id reuse |
|
238 |
with Not_found -> Hashtbl.add ctx.policy var.var_id var); |
|
239 |
ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated |
|
240 |
|
|
241 |
let compute_reuse_policy node schedule disjoint g = |
|
242 |
let ctx = |
|
243 |
{ |
|
244 |
evaluated = Disjunction.CISet.empty; |
|
245 |
dep_graph = g; |
|
246 |
disjoint; |
|
247 |
policy = Hashtbl.create 23; |
|
248 |
} |
|
249 |
in |
|
250 |
List.iter |
|
251 |
(fun heads -> |
|
252 |
let heads = List.map (fun v -> get_node_var v node) heads in |
|
253 |
Log.report ~level:6 (fun fmt -> |
|
254 |
Format.( |
|
255 |
fprintf fmt |
|
256 |
"@[<v>@[<v 2>new context:@,\ |
|
257 |
%a@]@,\ |
|
258 |
NEW HEADS:%a@,\ |
|
259 |
COMPUTE_DEPENDENCIES@,\ |
|
260 |
@]" |
|
261 |
pp_context ctx |
|
262 |
(pp_print_list ~pp_open_box:pp_open_hbox ~pp_sep:pp_print_space |
|
263 |
(fun fmt head -> |
|
264 |
fprintf fmt "%s (%a)" head.var_id Printers.pp_node_eq |
|
265 |
(get_node_eq head.var_id node))) |
|
266 |
heads)); |
|
267 |
compute_dependencies heads ctx; |
|
268 |
Log.report ~level:6 (fun fmt -> |
|
269 |
Format.fprintf fmt "@[<v>@[<v 2>new context:@,%a@]@,COMPUTE_REUSE@,@]" |
|
270 |
pp_context ctx); |
|
271 |
List.iter (compute_reuse node ctx heads) heads; |
|
272 |
(*compute_evaluated heads ctx;*) |
|
273 |
Log.report ~level:6 (fun fmt -> |
|
274 |
Format.( |
|
275 |
fprintf fmt "@[<v>%a@,@]" |
|
276 |
(pp_print_list ~pp_open_box:pp_open_vbox0 (fun fmt head -> |
|
277 |
fprintf fmt "reuse %s instead of %s" |
|
278 |
(Hashtbl.find ctx.policy head.var_id).var_id head.var_id)) |
|
279 |
heads))) |
|
280 |
schedule; |
|
281 |
IdentDepGraph.clear ctx.dep_graph; |
|
282 |
ctx.policy |
|
283 |
|
|
284 |
(* Reuse policy: - could reuse variables with the same type exactly only |
|
285 |
(simple). - reusing variables with different types would involve: - either |
|
286 |
dirty castings - or complex inclusion expression (for instance: array <-> |
|
287 |
array cell, struct <-> struct field) to be able to reuse only some parts of |
|
288 |
structured data. ... it seems too complex and potentially unsafe - for node |
|
289 |
instance calls: output variables could NOT reuse aliasable input variables, |
|
290 |
even if inputs become dead, because the correctness would depend on the |
|
291 |
scheduling of the callee (so, the compiling strategy could NOT be modular |
|
292 |
anymore). - once a policy is set, we need to: - replace each variable by its |
|
293 |
reuse alias. - simplify resulting equations, as we may now have: x = x; --> ; |
|
294 |
for scalar vars or: x = &{ f1 = x->f1; f2 = t; } --> x->f2 = t; for struct |
|
295 |
vars *) |
|
296 |
|
|
297 |
(* the reuse policy seeks to use less local variables by replacing local |
|
298 |
variables, applying the rules in the following order: 1) use another clock |
|
299 |
disjoint still live variable, with the greatest possible disjoint clock 2) |
|
300 |
reuse a dead variable For the sake of safety, we replace variables by others: |
|
301 |
- with the same type - not aliasable (i.e. address type) *) |
|
302 |
|
|
303 |
(* Local Variables: *) |
|
304 |
(* compile-command:"make -C .." *) |
|
305 |
(* End: *) |
Also available in: Unified diff
reformatting