lustrec / src / liveness.ml @ 01c7d5e1
History  View  Annotate  Download (8.61 KB)
1 
(*  

2 
* SchedMCore  A MultiCore Scheduling Framework 
3 
* Copyright (C) 20092013, ONERA, Toulouse, FRANCE  LIFL, Lille, FRANCE 
4 
* Copyright (C) 20122013, INPT, Toulouse, FRANCE 
5 
* 
6 
* This file is part of Prelude 
7 
* 
8 
* Prelude is free software; you can redistribute it and/or 
9 
* modify it under the terms of the GNU Lesser General Public License 
10 
* as published by the Free Software Foundation ; either version 2 of 
11 
* the License, or (at your option) any later version. 
12 
* 
13 
* Prelude is distributed in the hope that it will be useful, but 
14 
* WITHOUT ANY WARRANTY ; without even the implied warranty of 
15 
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 
16 
* Lesser General Public License for more details. 
17 
* 
18 
* You should have received a copy of the GNU Lesser General Public 
19 
* License along with this program ; if not, write to the Free Software 
20 
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 021111307 
21 
* USA 
22 
* *) 
23  
24 
open Utils 
25 
open LustreSpec 
26 
open Corelang 
27 
open Graph 
28 
open Causality 
29  
30 
(* Computes the last dependency 
31 
*) 
32  
33 
(* Computes the death table of [node] wrt dep graph [g] and topological [sort]. 
34 
The death table is a mapping: ident > Set(ident) such that: 
35 
death x is the set of local variables which get dead (i.e. unused) 
36 
after x is evaluated, but were until live. 
37 
let death_table node g sort = 
38 
let death = Hashtbl.create 23 in 
39 
let sort = ref (List.rev sort) in 
40 
let buried = ref ISet.empty in 
41 
begin 
42 
buried := ExprDep.node_memory_variables node; 
43 
buried := List.fold_left (fun dead (v : var_decl) > ISet.add v.var_id dead) !buried node.node_outputs; 
44 
(* We could also try to reuse input variables, due to C parameter copying semantics *) 
45 
buried := List.fold_left (fun dead (v : var_decl) > ISet.add v.var_id dead) !buried node.node_inputs; 
46 
while (!sort <> []) 
47 
do 
48 
let head = List.hd !sort in 
49 
let dead = IdentDepGraph.fold_succ 
50 
(fun tgt dead > if not (ExprDep.is_instance_var tgt  ISet.mem tgt !buried) then ISet.add tgt dead else dead) 
51 
g head ISet.empty in 
52 
buried := ISet.union !buried dead; 
53 
Hashtbl.add death head dead; 
54 
sort := List.tl !sort 
55 
done; 
56 
IdentDepGraph.clear g; 
57 
death 
58 
end 
59 
*) 
60  
61 
(* computes the indegree for each local variable of node [n], according to dep graph [g]. 
62 
*) 
63 
let compute_fanin n g = 
64 
let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in 
65 
let fanin = Hashtbl.create 23 in 
66 
begin 
67 
IdentDepGraph.iter_vertex (fun v > if ISet.mem v locals then Hashtbl.add fanin v (IdentDepGraph.in_degree g v)) g; 
68 
fanin 
69 
end 
70 

71 
let pp_fanin fmt fanin = 
72 
begin 
73 
Format.fprintf fmt "{ /* locals fanin: */@."; 
74 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %d@." s t) fanin; 
75 
Format.fprintf fmt "}@." 
76 
end 
77  
78 
(* computes the cone of influence of a given [var] wrt a dependency graph [g]. 
79 
*) 
80 
let cone_of_influence g var = 
81 
(*Format.printf "coi: %s@." var;*) 
82 
let frontier = ref (ISet.add var ISet.empty) in 
83 
let coi = ref ISet.empty in 
84 
while not (ISet.is_empty !frontier) 
85 
do 
86 
let head = ISet.min_elt !frontier in 
87 
(*Format.printf "head: %s@." head;*) 
88 
frontier := ISet.remove head !frontier; 
89 
if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi; 
90 
List.iter (fun s > frontier := ISet.add s !frontier) (IdentDepGraph.succ g head); 
91 
done; 
92 
!coi 
93  
94 
let compute_unused n g = 
95 
let inputs = ExprDep.node_input_variables n in 
96 
let mems = ExprDep.node_memory_variables n in 
97 
let outputs = ExprDep.node_output_variables n in 
98 
ISet.fold 
99 
(fun var unused > ISet.diff unused (cone_of_influence g var)) 
100 
(ISet.union outputs mems) 
101 
(ISet.union inputs mems) 
102  
103 
(* Computes the set of (input and) output and mem variables of [node]. 
104 
We try to reuse input variables, due to C parameter copying semantics. *) 
105 
let node_non_locals node = 
106 
List.fold_left (fun non_loc v > ISet.add v.var_id non_loc) (ExprDep.node_memory_variables node) node.node_outputs 
107  
108 
(* Recursively removes useless local variables, 
109 
i.e. variables in [non_locals] that are current roots of the dep graph [g] *) 
110 
let remove_local_roots non_locals g = 
111 
let rem = ref true in 
112 
let roots = ref ISet.empty in 
113 
while !rem 
114 
do 
115 
rem := false; 
116 
let local_roots = List.filter (fun v > not (ISet.mem v non_locals)) (graph_roots g) in 
117 
if local_roots <> [] then 
118 
begin 
119 
rem := true; 
120 
List.iter (IdentDepGraph.remove_vertex g) local_roots; 
121 
roots := List.fold_left (fun roots v > if ExprDep.is_instance_var v then roots else ISet.add v roots) !roots local_roots 
122 
end 
123 
done; 
124 
!roots 
125  
126 
(* Computes the death table of [node] wrt dep graph [g] and topological [sort]. 
127 
The death table is a mapping: ident > Set(ident) such that: 
128 
death x is the set of local variables which get dead (i.e. unused) 
129 
before x is evaluated, but were until live. 
130 
If death x is not defined, then x is useless. 
131 
*) 
132 
let death_table node g sort = 
133 
let non_locals = node_non_locals node in 
134 
let death = Hashtbl.create 23 in 
135 
let sort = ref sort in 
136 
begin 
137 
while (!sort <> []) 
138 
do 
139 
let head = List.hd !sort in 
140 
(* If current var is not already dead, i.e. useless *) 
141 
if IdentDepGraph.mem_vertex g head then 
142 
begin 
143 
IdentDepGraph.iter_succ (IdentDepGraph.remove_edge g head) g head; 
144 
let dead = remove_local_roots non_locals g in 
145 
Hashtbl.add death head dead 
146 
end; 
147 
sort := List.tl !sort 
148 
done; 
149 
IdentDepGraph.clear g; 
150 
death 
151 
end 
152  
153 
let pp_death_table fmt death = 
154 
begin 
155 
Format.fprintf fmt "{ /* death table */@."; 
156 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > { %a }@." s (Utils.fprintf_list ~sep:", " Format.pp_print_string) (ISet.elements t)) death; 
157 
Format.fprintf fmt "}@." 
158 
end 
159  
160  
161 
(* Reuse policy: 
162 
 could reuse variables with the same type exactly only (simple). 
163 
 reusing variables with different types would involve: 
164 
 either dirty castings 
165 
 or complex inclusion expression (for instance: array <> array cell, struct <> struct field) to be able to reuse only some parts of structured data. 
166 
... it seems too complex and potentially unsafe 
167 
 for node instance calls: output variables could NOT reuse input variables, 
168 
even if inputs become dead, because the correctness would depend on the scheduling 
169 
of the callee (so, the compiling strategy could NOT be modular anymore). 
170 
 once a policy is set, we need to: 
171 
 replace each variable by its reuse alias. 
172 
 simplify resulting equations, as we may now have: 
173 
x = x; > ; for scalar vars 
174 
or: 
175 
x = &{ f1 = x>f1; f2 = t; } > x>f2 = t; for struct vars 
176 
 such simplifications are, until now, only expressible at the C source level... 
177 
*) 
178  
179 
(* Replaces [v] by [v'] in set [s] *) 
180 
let replace_in_set s v v' = 
181 
if ISet.mem v s then ISet.add v' (ISet.remove v s) else s 
182  
183 
(* Replaces [v] by [v'] in death table [death] *) 
184 
let replace_in_death_table death v v' = 
185 
Hashtbl.iter (fun k dead > Hashtbl.replace death k (replace_in_set dead v v')) death 
186  
187 
let find_compatible_local node var dead = 
188 
(*Format.eprintf "find_compatible_local %s %s %a@." node.node_id var pp_iset dead;*) 
189 
let typ = (get_node_var var node).var_type in 
190 
let eq_var = get_node_eq var node in 
191 
let aliasable_inputs = 
192 
match NodeDep.get_callee eq_var.eq_rhs with 
193 
 None > [] 
194 
 Some (_, args) > List.fold_right (fun e r > match e.expr_desc with Expr_ident id > id::r  _ > r) args [] in 
195 
let filter v = 
196 
let res = 
197 
ISet.mem v.var_id dead 
198 
&& Typing.eq_ground typ v.var_type 
199 
&& not (Types.is_address_type v.var_type && List.mem v.var_id aliasable_inputs) in 
200 
begin 
201 
(*Format.eprintf "filter %a = %s@." Printers.pp_var_name v (if res then "true" else "false");*) 
202 
res 
203 
end in 
204 
try 
205 
Some ((List.find filter node.node_locals).var_id) 
206 
with Not_found > None 
207  
208 
let reuse_policy node sort death = 
209 
let dead = ref ISet.empty in 
210 
let policy = Hashtbl.create 23 in 
211 
let sort = ref sort in 
212 
while !sort <> [] 
213 
do 
214 
let head = List.hd !sort in 
215 
if Hashtbl.mem death head then 
216 
begin 
217 
dead := ISet.union (Hashtbl.find death head) !dead; 
218 
end; 
219 
(match find_compatible_local node head !dead with 
220 
 None > () 
221 
 Some l > replace_in_death_table death head l; Hashtbl.add policy head l); 
222 
sort := List.tl !sort; 
223 
done; 
224 
policy 
225 

226 
let pp_reuse_policy fmt policy = 
227 
begin 
228 
Format.fprintf fmt "{ /* reuse policy */@."; 
229 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %s@." s t) policy; 
230 
Format.fprintf fmt "}@." 
231 
end 
232 
(* Local Variables: *) 
233 
(* compilecommand:"make C .." *) 
234 
(* End: *) 