Revision b13a7d5f src/liveness.ml
src/liveness.ml  

15  15 
open Graph 
16  16 
open Causality 
17  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  
18  26 
(* computes the indegree for each local variable of node [n], according to dep graph [g]. 
19  27 
*) 
20  28 
let compute_fanin n g = 
...  ...  
72  80 
Disjunction.CISet.empty 
73  81 
node.node_locals 
74  82  
83 
let kill_root ctx head = 

84 
IdentDepGraph.iter_succ (IdentDepGraph.remove_edge ctx.dep_graph head.var_id) ctx.dep_graph head.var_id 

85  
75  86 
(* 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 

87 
i.e. [ctx.evaluated] variables that are current roots of the dep graph [ctx.dep_graph] 

79  88 
 [evaluated] is the set of already evaluated variables, 
80  89 
wrt the scheduling 
90 
 does only remove edges, not variables themselves 

81  91 
*) 
82 
let remove_local_roots locals evaluated g =


92 
let remove_roots ctx =


83  93 
let rem = ref true in 
84 
let roots = ref Disjunction.CISet.empty in


94 
let remaining = ref ctx.evaluated in


85  95 
while !rem 
86  96 
do 
87  97 
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


98 
let all_roots = graph_roots ctx.dep_graph in


99 
let frontier_roots = Disjunction.CISet.filter (fun v > List.mem v.var_id all_roots) !remaining in


100 
if not (Disjunction.CISet.is_empty frontier_roots) then


91  101 
begin 
92  102 
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


103 
Disjunction.CISet.iter (kill_root ctx) frontier_roots;


104 
remaining := Disjunction.CISet.diff !remaining frontier_roots


95  105 
end 
96 
done; 

97 
!roots 

106 
done 

98  107 

99  108 
(* checks whether a variable [v] is an input of the [var] equation, with an address type. 
100  109 
if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node, 
...  ...  
118  127 
IdentDepGraph.remove_vertex g v 
119  128 
end 
120  129  
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  130 
let pp_reuse_policy fmt policy = 
131  131 
begin 
132  132 
Format.fprintf fmt "{ /* reuse policy */@."; 
...  ...  
138  138 
begin 
139  139 
Format.fprintf fmt "{ /*BEGIN context */@."; 
140  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; 

141 
Format.fprintf fmt "graph=%a;@." pp_dep_graph ctx.dep_graph; 

143  142 
Format.fprintf fmt "disjoint=%a;@." Disjunction.pp_disjoint_map ctx.disjoint; 
144  143 
Format.fprintf fmt "policy=%a;@." pp_reuse_policy ctx.policy; 
145  144 
Format.fprintf fmt "/* END context */ }@."; 
146  145 
end 
147  146  
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  147 
(* computes the reusable dependencies of variable [var] in graph [g], 
167  148 
once [var] has been evaluated 
168  149 
 [locals] is the set of potentially reusable variables 
...  ...  
171  152 
 [reusable] is the set of dead/reusable dependencies of [var] in graph [g] 
172  153 
 [policy] is the reuse map (which domain is [evaluated]) 
173  154 
*) 
174 
let compute_dependencies locals heads ctx g =


155 
let compute_dependencies heads ctx =


175  156 
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; 

157 
(*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);*) 

158 
List.iter (kill_root ctx) heads; 

159 
remove_roots ctx; 

180  160 
end 
181  161  
182  162 
let compute_evaluated heads ctx = 
...  ...  
184  164 
List.iter (fun head > ctx.evaluated < Disjunction.CISet.add head ctx.evaluated) heads; 
185  165 
end 
186  166  
187 
let compute_reuse node var ctx g =


167 
let compute_reuse node ctx var =


188  168 
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 

169 
let disjoint = Hashtbl.find ctx.disjoint var.var_id in 

170 
let eligible v = 

171 
Typing.eq_ground var.var_type v.var_type 

172 
&& not (aliasable v) in 

173 
let locally_reusable v = 

174 
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 

175 
let eligibles = Disjunction.CISet.filter eligible ctx.evaluated in 

176 
let dead, live = Disjunction.CISet.partition locally_reusable eligibles in 

190  177 
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 

178 
let disjoint_live = Disjunction.CISet.inter disjoint live in 

179 
let reuse = Disjunction.CISet.max_elt disjoint_live in 

195  180 
begin 
196 
ctx.evaluated < Disjunction.CISet.add var ctx.evaluated;


197 
Hashtbl.add ctx.policy var.var_id reuse;


181 
IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;


182 
Hashtbl.add ctx.policy var.var_id (Hashtbl.find ctx.policy reuse.var_id);


198  183 
end 
199  184 
with Not_found > 
200  185 
try 
201 
let reuse = Hashtbl.find ctx.policy (Disjunction.CISet.choose (Disjunction.CISet.filter (fun v > eligible v) ctx.reusable)).var_id in


186 
let reuse = Disjunction.CISet.choose dead in


202  187 
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; 

188 
IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id; 

189 
Hashtbl.add ctx.policy var.var_id (Hashtbl.find ctx.policy reuse.var_id); 

208  190 
end 
209  191 
with Not_found > 
210  192 
begin 
211 
ctx.evaluated < Disjunction.CISet.add var ctx.evaluated; 

212  193 
Hashtbl.add ctx.policy var.var_id var; 
213  194 
end 
214  195  
215  196 
let compute_reuse_policy node schedule disjoint g = 
216 
let locals = node_reusable_variables node in 

217  197 
let sort = ref schedule in 
218  198 
let ctx = { evaluated = Disjunction.CISet.empty; 
219 
quasi = Disjunction.CISet.empty; 

220 
reusable = Disjunction.CISet.empty; 

199 
dep_graph = g; 

221  200 
disjoint = disjoint; 
222  201 
policy = Hashtbl.create 23; } in 
223  202 
while !sort <> [] 
224  203 
do 
225  204 
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  205 
let heads = List.map (fun v > get_node_var v node) (List.hd !sort) in 
229  206 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "NEW HEADS:"); 
230  207 
List.iter (fun head > Log.report ~level:2 (fun fmt > Format.fprintf fmt "%s " head.var_id)) heads; 
231  208 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "@."); 
232  209 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "COMPUTE_DEPENDENCIES@."); 
233 
compute_dependencies locals heads ctx g;


210 
compute_dependencies heads ctx;


234  211 
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  212 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "COMPUTE_REUSE@."); 
238 
List.iter (fun head > compute_reuse node head ctx g) heads; 

213 
List.iter (compute_reuse node ctx) heads; 

214 
compute_evaluated heads ctx; 

239  215 
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  216 
sort := List.tl !sort; 
241  217 
done; 
242 
IdentDepGraph.clear g;


218 
IdentDepGraph.clear ctx.dep_graph;


243  219 
ctx.policy 
244  220  
245  221 
(* Reuse policy: 
...  ...  
257  233 
x = x; > ; for scalar vars 
258  234 
or: 
259  235 
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  236 
*) 
262  237  
263  238 
Also available in: Unified diff