lustrec / src / liveness.ml @ b38ffff3
History  View  Annotate  Download (9.46 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 last dependency 
19 
*) 
20  
21 
(* Computes the death table of [node] wrt dep graph [g] and topological [sort]. 
22 
The death table is a mapping: ident > Set(ident) such that: 
23 
death x is the set of local variables which get dead (i.e. unused) 
24 
after x is evaluated, but were until live. 
25 
let death_table node g sort = 
26 
let death = Hashtbl.create 23 in 
27 
let sort = ref (List.rev sort) in 
28 
let buried = ref ISet.empty in 
29 
begin 
30 
buried := ExprDep.node_memory_variables node; 
31 
buried := List.fold_left (fun dead (v : var_decl) > ISet.add v.var_id dead) !buried node.node_outputs; 
32 
(* We could also try to reuse input variables, due to C parameter copying semantics *) 
33 
buried := List.fold_left (fun dead (v : var_decl) > ISet.add v.var_id dead) !buried node.node_inputs; 
34 
while (!sort <> []) 
35 
do 
36 
let head = List.hd !sort in 
37 
let dead = IdentDepGraph.fold_succ 
38 
(fun tgt dead > if not (ExprDep.is_instance_var tgt  ISet.mem tgt !buried) then ISet.add tgt dead else dead) 
39 
g head ISet.empty in 
40 
buried := ISet.union !buried dead; 
41 
Hashtbl.add death head dead; 
42 
sort := List.tl !sort 
43 
done; 
44 
IdentDepGraph.clear g; 
45 
death 
46 
end 
47 
*) 
48  
49 
(* computes the indegree for each local variable of node [n], according to dep graph [g]. 
50 
*) 
51 
let compute_fanin n g = 
52 
let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in 
53 
let fanin = Hashtbl.create 23 in 
54 
begin 
55 
IdentDepGraph.iter_vertex (fun v > if ISet.mem v locals then Hashtbl.add fanin v (IdentDepGraph.in_degree g v)) g; 
56 
fanin 
57 
end 
58 

59 
let pp_fanin fmt fanin = 
60 
begin 
61 
Format.fprintf fmt "{ /* locals fanin: */@."; 
62 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %d@." s t) fanin; 
63 
Format.fprintf fmt "}@." 
64 
end 
65  
66 
(* computes the cone of influence of a given [var] wrt a dependency graph [g]. 
67 
*) 
68 
let cone_of_influence g var = 
69 
(*Format.printf "coi: %s@." var;*) 
70 
let frontier = ref (ISet.add var ISet.empty) in 
71 
let coi = ref ISet.empty in 
72 
while not (ISet.is_empty !frontier) 
73 
do 
74 
let head = ISet.min_elt !frontier in 
75 
(*Format.printf "head: %s@." head;*) 
76 
frontier := ISet.remove head !frontier; 
77 
if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi; 
78 
List.iter (fun s > frontier := ISet.add s !frontier) (IdentDepGraph.succ g head); 
79 
done; 
80 
!coi 
81  
82 
let compute_unused_variables n g = 
83 
let inputs = ExprDep.node_input_variables n in 
84 
let mems = ExprDep.node_memory_variables n in 
85 
let outputs = ExprDep.node_output_variables n in 
86 
ISet.fold 
87 
(fun var unused > ISet.diff unused (cone_of_influence g var)) 
88 
(ISet.union outputs mems) 
89 
(ISet.union inputs mems) 
90  
91 
(* computes the set of potentially reusable variables. 
92 
We don't reuse input variables, due to possible aliasing *) 
93 
let node_reusable_variables node = 
94 
let mems = ExprDep.node_memory_variables node in 
95 
List.fold_left 
96 
(fun acc l > 
97 
if ISet.mem l.var_id mems then acc else Disjunction.CISet.add l acc) 
98 
Disjunction.CISet.empty 
99 
node.node_locals 
100  
101 
(* Recursively removes useless variables, 
102 
i.e. variables that are current roots of the dep graph [g] 
103 
and returns [locals] and [evaluated] such roots *) 
104 
let remove_local_roots locals evaluated g = 
105 
let rem = ref true in 
106 
let roots = ref Disjunction.CISet.empty in 
107 
while !rem 
108 
do 
109 
rem := false; 
110 
let new_roots = graph_roots g in 
111 
let reusable_roots = Disjunction.CISet.filter (fun v > (List.mem v.var_id new_roots) && (Disjunction.CISet.mem v locals)) evaluated in 
112 
if not (Disjunction.CISet.is_empty reusable_roots) then 
113 
begin 
114 
rem := true; 
115 
Disjunction.CISet.iter (fun v > IdentDepGraph.remove_vertex g v.var_id) reusable_roots; 
116 
roots := Disjunction.CISet.union reusable_roots !roots 
117 
end 
118 
done; 
119 
!roots 
120  
121 
(* checks whether a variable is aliasable, 
122 
depending on its (address) type *) 
123 
let is_aliasable var = 
124 
Types.is_address_type var.var_type 
125 

126 
(* checks whether a variable [v] is an input of the [var] equation, with an address type. 
127 
if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node, 
128 
because [v] may not be dead in the callee node when [var] is assigned *) 
129 
let is_aliasable_input node var = 
130 
let eq_var = get_node_eq var node in 
131 
let inputs_var = 
132 
match NodeDep.get_callee eq_var.eq_rhs with 
133 
 None > [] 
134 
 Some (_, args) > List.fold_right (fun e r > match e.expr_desc with Expr_ident id > id::r  _ > r) args [] in 
135 
fun v > Types.is_address_type v.var_type && List.mem v.var_id inputs_var 
136  
137 
(* merges two variables [v] and [v'] of graph [g]. 
138 
[v] is replaced by [v'] 
139 
*) 
140 
let merge_in_dep_graph v v' g = 
141 
begin 
142 
IdentDepGraph.add_vertex g v'; 
143 
IdentDepGraph.iter_succ (fun s > IdentDepGraph.add_edge g v' s) g v; 
144 
IdentDepGraph.iter_pred (fun p > IdentDepGraph.add_edge g p v') g v; 
145 
IdentDepGraph.remove_vertex g v 
146 
end 
147  
148 
(* computes the reusable dependencies of variable [var] in graph [g], 
149 
once [var] has been evaluated 
150 
[dead] is the set of evaluated and dead variables 
151 
[eval] is the set of evaluated variables 
152 
*) 
153 
let compute_reusable_dependencies locals evaluated reusable var g = 
154 
begin 
155 
Log.report ~level:2 (fun fmt > Format.fprintf fmt "compute_reusable_dependencies %a %a %a %a %a@." Disjunction.pp_ciset locals Disjunction.pp_ciset !evaluated Disjunction.pp_ciset !reusable Printers.pp_var_name var pp_dep_graph g); 
156 
evaluated := Disjunction.CISet.add var !evaluated; 
157 
IdentDepGraph.iter_succ (IdentDepGraph.remove_edge g var.var_id) g var.var_id; 
158 
reusable := Disjunction.CISet.union (remove_local_roots locals !evaluated g) !reusable; 
159 
end 
160  
161 
let compute_reuse_policy node schedule disjoint g = 
162 
let locals = node_reusable_variables node in 
163 
let sort = ref schedule in 
164 
let evaluated = ref Disjunction.CISet.empty in 
165 
let reusable = ref Disjunction.CISet.empty in 
166 
let policy = Hashtbl.create 23 in 
167 
while !sort <> [] 
168 
do 
169 
let head = get_node_var (List.hd !sort) node in 
170 
compute_reusable_dependencies locals evaluated reusable head g; 
171 
let aliasable = is_aliasable_input node head.var_id in 
172 
let eligible v = Typing.eq_ground head.var_type v.var_type && not (aliasable v) in 
173 
let reuse = 
174 
try 
175 
let disj = Hashtbl.find disjoint head.var_id in 
176 
Disjunction.CISet.max_elt (Disjunction.CISet.filter (fun v > (eligible v) && (Disjunction.CISet.mem v !evaluated) && not (Disjunction.CISet.mem v !reusable)) disj) 
177 
with Not_found > 
178 
try 
179 
Disjunction.CISet.choose (Disjunction.CISet.filter (fun v > eligible v) !reusable) 
180 
with Not_found > head in 
181 
reusable := Disjunction.CISet.remove reuse !reusable; 
182 
Disjunction.replace_in_disjoint_map disjoint head reuse; 
183 
merge_in_dep_graph head.var_id reuse.var_id g; 
184 
Hashtbl.add policy head.var_id reuse; 
185 
Log.report ~level:2 (fun fmt > Format.fprintf fmt "reuse %s instead of %s@." reuse.var_id head.var_id); 
186 
Log.report ~level:1 (fun fmt > Format.fprintf fmt "new disjoint:%a@." Disjunction.pp_disjoint_map disjoint); 
187 
Log.report ~level:2 
188 
(fun fmt > Format.fprintf fmt "new dependency graph:%a@." pp_dep_graph g); 
189 
sort := List.tl !sort; 
190 
done; 
191 
IdentDepGraph.clear g; 
192 
policy 
193  
194 
(* Reuse policy: 
195 
 could reuse variables with the same type exactly only (simple). 
196 
 reusing variables with different types would involve: 
197 
 either dirty castings 
198 
 or complex inclusion expression (for instance: array <> array cell, struct <> struct field) to be able to reuse only some parts of structured data. 
199 
... it seems too complex and potentially unsafe 
200 
 for node instance calls: output variables could NOT reuse aliasable input variables, 
201 
even if inputs become dead, because the correctness would depend on the scheduling 
202 
of the callee (so, the compiling strategy could NOT be modular anymore). 
203 
 once a policy is set, we need to: 
204 
 replace each variable by its reuse alias. 
205 
 simplify resulting equations, as we may now have: 
206 
x = x; > ; for scalar vars 
207 
or: 
208 
x = &{ f1 = x>f1; f2 = t; } > x>f2 = t; for struct vars 
209 
 such simplifications are, until now, only expressible at the C source level... 
210 
*) 
211  
212  
213 
(* the reuse policy seeks to use less local variables 
214 
by replacing local variables, applying the rules 
215 
in the following order: 
216 
1) use another clock disjoint still live variable, 
217 
with the greatest possible disjoint clock 
218 
2) reuse a dead variable 
219 
For the sake of safety, we replace variables by others: 
220 
 with the same type 
221 
 not aliasable (i.e. address type) 
222 
*) 
223  
224 
let pp_reuse_policy fmt policy = 
225 
begin 
226 
Format.fprintf fmt "{ /* reuse policy */@."; 
227 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %s@." s t.var_id) policy; 
228 
Format.fprintf fmt "}@." 
229 
end 
230 
(* Local Variables: *) 
231 
(* compilecommand:"make C .." *) 
232 
(* End: *) 