|
@@ -847,12 +847,18 @@ module Graph = struct
|
|
bb.bb_closed <- true
|
|
bb.bb_closed <- true
|
|
end
|
|
end
|
|
|
|
|
|
- let iter_dom_tree g f =
|
|
|
|
|
|
+ let iter_dom_tree_from g bb f =
|
|
let rec loop bb =
|
|
let rec loop bb =
|
|
f bb;
|
|
f bb;
|
|
List.iter loop bb.bb_dominated
|
|
List.iter loop bb.bb_dominated
|
|
in
|
|
in
|
|
- loop g.g_root
|
|
|
|
|
|
+ loop bb
|
|
|
|
+
|
|
|
|
+ let iter_dom_tree g f =
|
|
|
|
+ iter_dom_tree_from g g.g_root f
|
|
|
|
+
|
|
|
|
+ let iter_edges_from g bb f =
|
|
|
|
+ iter_dom_tree_from g bb (fun bb -> List.iter f bb.bb_outgoing)
|
|
|
|
|
|
let iter_edges g f =
|
|
let iter_edges g f =
|
|
iter_dom_tree g (fun bb -> List.iter f bb.bb_outgoing)
|
|
iter_dom_tree g (fun bb -> List.iter f bb.bb_outgoing)
|
|
@@ -924,9 +930,14 @@ module Graph = struct
|
|
loop edge.cfg_from
|
|
loop edge.cfg_from
|
|
)
|
|
)
|
|
|
|
|
|
|
|
+ let check_integrity g =
|
|
|
|
+ iter_edges g (fun edge ->
|
|
|
|
+ if not (List.memq edge edge.cfg_to.bb_incoming) then
|
|
|
|
+ prerr_endline (Printf.sprintf "Outgoing edge %i -> %i has no matching incoming edge" edge.cfg_from.bb_id edge.cfg_to.bb_id)
|
|
|
|
+ )
|
|
|
|
+
|
|
let finalize g bb_exit =
|
|
let finalize g bb_exit =
|
|
- g.g_exit <- bb_exit;
|
|
|
|
- calculate_df g;
|
|
|
|
|
|
+ g.g_exit <- bb_exit
|
|
end
|
|
end
|
|
|
|
|
|
type analyzer_context = {
|
|
type analyzer_context = {
|
|
@@ -1803,6 +1814,7 @@ module Ssa = struct
|
|
List.iter (rename_in_block ctx) bb.bb_dominated
|
|
List.iter (rename_in_block ctx) bb.bb_dominated
|
|
|
|
|
|
let apply ctx =
|
|
let apply ctx =
|
|
|
|
+ Graph.calculate_df ctx.graph;
|
|
insert_phi ctx;
|
|
insert_phi ctx;
|
|
rename_in_block ctx ctx.graph.g_root
|
|
rename_in_block ctx ctx.graph.g_root
|
|
end
|
|
end
|
|
@@ -2976,4 +2988,4 @@ module Run = struct
|
|
let cfl = if config.optimize && config.purity_inference then Purity.infer com else [] in
|
|
let cfl = if config.optimize && config.purity_inference then Purity.infer com else [] in
|
|
List.iter (run_on_type ctx config) types;
|
|
List.iter (run_on_type ctx config) types;
|
|
List.iter (fun cf -> cf.cf_meta <- List.filter (fun (m,_,_) -> m <> Meta.Pure) cf.cf_meta) cfl
|
|
List.iter (fun cf -> cf.cf_meta <- List.filter (fun (m,_,_) -> m <> Meta.Pure) cf.cf_meta) cfl
|
|
-end
|
|
|
|
|
|
+end
|