diff options
Diffstat (limited to 'backend/LICMaux.ml')
| -rw-r--r-- | backend/LICMaux.ml | 40 |
1 files changed, 40 insertions, 0 deletions
diff --git a/backend/LICMaux.ml b/backend/LICMaux.ml index 1f6b8817..96e8e8ae 100644 --- a/backend/LICMaux.ml +++ b/backend/LICMaux.ml @@ -80,6 +80,46 @@ let get_loop_headers code entrypoint = begin end end +let get_loop_backedges code entrypoint = begin + debug "get_loop_backedges\n"; + let visited = ref (PTree.map (fun n i -> Unvisited) code) + and loop_backedge = ref (PTree.map (fun n i -> None) code) + in let rec dfs_visit code origin = function + | [] -> () + | node :: ln -> + debug "ENTERING node %d, REM are %a\n" (P.to_int node) print_intlist ln; + match (get_some @@ PTree.get node !visited) with + | Visited -> begin + debug "\tNode %d is already Visited, skipping\n" (P.to_int node); + dfs_visit code origin ln + end + | Processed -> begin + debug "Node %d is a loop header\n" (P.to_int node); + debug "The backedge is from %d\n" (P.to_int @@ get_some origin); + loop_backedge := PTree.set node origin !loop_backedge; + visited := PTree.set node Visited !visited; + dfs_visit code origin ln + end + | Unvisited -> begin + visited := PTree.set node Processed !visited; + debug "Node %d is Processed\n" (P.to_int node); + (match PTree.get node code with + | None -> failwith "No such node" + | Some i -> let next_visits = rtl_successors i in begin + debug "About to visit: %a\n" print_intlist next_visits; + dfs_visit code (Some node) next_visits + end); + debug "Node %d is Visited!\n" (P.to_int node); + visited := PTree.set node Visited !visited; + dfs_visit code origin ln + end + in begin + dfs_visit code None [entrypoint]; + debug "LOOP BACKEDGES: %a\n" print_ptree_opint !loop_backedge; + !loop_backedge + end +end + module Dominator = struct |