Revision 01f1a1f4 src/liveness.ml
src/liveness.ml  

15  15 
open Graph 
16  16 
open Causality 
17  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  18 
(* computes the indegree for each local variable of node [n], according to dep graph [g]. 
50  19 
*) 
51  20 
let compute_fanin n g = 
...  ...  
88  57 
(ISet.union outputs mems) 
89  58 
(ISet.union inputs mems) 
90  59  
60 
(* checks whether a variable is aliasable, 

61 
depending on its (address) type *) 

62 
let is_aliasable var = 

63 
Types.is_address_type var.var_type 

64  
91  65 
(* computes the set of potentially reusable variables. 
92  66 
We don't reuse input variables, due to possible aliasing *) 
93  67 
let node_reusable_variables node = 
...  ...  
100  74  
101  75 
(* Recursively removes useless variables, 
102  76 
i.e. variables that are current roots of the dep graph [g] 
103 
and returns [locals] and [evaluated] such roots *) 

77 
and returns [locals] and [evaluated] such roots 

78 
 [locals] is the set of potentially reusable variables 

79 
 [evaluated] is the set of already evaluated variables, 

80 
wrt the scheduling 

81 
*) 

104  82 
let remove_local_roots locals evaluated g = 
105  83 
let rem = ref true in 
106  84 
let roots = ref Disjunction.CISet.empty in 
...  ...  
117  95 
end 
118  96 
done; 
119  97 
!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  98 

126  99 
(* checks whether a variable [v] is an input of the [var] equation, with an address type. 
127  100 
if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node, 
...  ...  
132  105 
match NodeDep.get_callee eq_var.eq_rhs with 
133  106 
 None > [] 
134  107 
 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


108 
fun v > is_aliasable v && List.mem v.var_id inputs_var


136  109  
137 
(* merges two variables [v] and [v'] of graph [g].


138 
[v] is replaced by [v']


110 
(* replace variable [v] by [v'] in graph [g].


111 
[v'] is a dead variable


139  112 
*) 
140 
let merge_in_dep_graph v v' g =


113 
let replace_in_dep_graph v v' g =


141  114 
begin 
142  115 
IdentDepGraph.add_vertex g v'; 
143  116 
IdentDepGraph.iter_succ (fun s > IdentDepGraph.add_edge g v' s) g v; 
...  ...  
145  118 
IdentDepGraph.remove_vertex g v 
146  119 
end 
147  120  
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 
let pp_reuse_policy fmt policy = 

131 
begin 

132 
Format.fprintf fmt "{ /* reuse policy */@."; 

133 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %s@." s t.var_id) policy; 

134 
Format.fprintf fmt "}@." 

135 
end 

136  
137 
let pp_context fmt ctx = 

138 
begin 

139 
Format.fprintf fmt "{ /*BEGIN context */@."; 

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; 

143 
Format.fprintf fmt "disjoint=%a;@." Disjunction.pp_disjoint_map ctx.disjoint; 

144 
Format.fprintf fmt "policy=%a;@." pp_reuse_policy ctx.policy; 

145 
Format.fprintf fmt "/* END context */ }@."; 

146 
end 

147  
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  
148  166 
(* computes the reusable dependencies of variable [var] in graph [g], 
149  167 
once [var] has been evaluated 
150 
[dead] is the set of evaluated and dead variables 

151 
[eval] is the set of evaluated variables 

168 
 [locals] is the set of potentially reusable variables 

169 
 [evaluated] is the set of evaluated variables 

170 
 [quasi] is the set of quasireusable variables 

171 
 [reusable] is the set of dead/reusable dependencies of [var] in graph [g] 

172 
 [policy] is the reuse map (which domain is [evaluated]) 

152  173 
*) 
153 
let compute_reusable_dependencies locals evaluated reusable var g = 

174 
let compute_dependencies locals heads ctx g = 

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

180 
end 

181  
182 
let compute_evaluated heads ctx = 

154  183 
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; 

184 
List.iter (fun head > ctx.evaluated < Disjunction.CISet.add head ctx.evaluated) heads; 

159  185 
end 
160  186  
187 
let compute_reuse node var ctx g = 

188 
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 

190 
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 

195 
begin 

196 
ctx.evaluated < Disjunction.CISet.add var ctx.evaluated; 

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

198 
end 

199 
with Not_found > 

200 
try 

201 
let reuse = Hashtbl.find ctx.policy (Disjunction.CISet.choose (Disjunction.CISet.filter (fun v > eligible v) ctx.reusable)).var_id in 

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

208 
end 

209 
with Not_found > 

210 
begin 

211 
ctx.evaluated < Disjunction.CISet.add var ctx.evaluated; 

212 
Hashtbl.add ctx.policy var.var_id var; 

213 
end 

214  
161  215 
let compute_reuse_policy node schedule disjoint g = 
162  216 
let locals = node_reusable_variables node in 
163  217 
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 

218 
let ctx = { evaluated = Disjunction.CISet.empty; 

219 
quasi = Disjunction.CISet.empty; 

220 
reusable = Disjunction.CISet.empty; 

221 
disjoint = disjoint; 

222 
policy = Hashtbl.create 23; } in 

167  223 
while !sort <> [] 
168  224 
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 

225 
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 
let heads = List.map (fun v > get_node_var v node) (List.hd !sort) in 

229 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "NEW HEADS:"); 

230 
List.iter (fun head > Log.report ~level:2 (fun fmt > Format.fprintf fmt "%s " head.var_id)) heads; 

231 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "@."); 

232 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "COMPUTE_DEPENDENCIES@."); 

233 
compute_dependencies locals heads ctx g; 

234 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "new context:%a@." pp_context ctx); 

235 
Log.report ~level:6 

188  236 
(fun fmt > Format.fprintf fmt "new dependency graph:%a@." pp_dep_graph g); 
237 
Log.report ~level:6 (fun fmt > Format.fprintf fmt "COMPUTE_REUSE@."); 

238 
List.iter (fun head > compute_reuse node head ctx g) heads; 

239 
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; 

189  240 
sort := List.tl !sort; 
190  241 
done; 
191  242 
IdentDepGraph.clear g; 
192 
policy 

243 
ctx.policy


193  244  
194  245 
(* Reuse policy: 
195  246 
 could reuse variables with the same type exactly only (simple). 
...  ...  
221  272 
 not aliasable (i.e. address type) 
222  273 
*) 
223  274  
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  275 
(* Local Variables: *) 
231  276 
(* compilecommand:"make C .." *) 
232  277 
(* End: *) 
Also available in: Unified diff