diff options
-rw-r--r-- | backend/Duplicateaux.ml | 3 | ||||
-rw-r--r-- | backend/LICMaux.ml | 40 | ||||
-rw-r--r-- | common/DebugPrint.ml | 14 |
3 files changed, 57 insertions, 0 deletions
diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml index 7504f724..625cbdd9 100644 --- a/backend/Duplicateaux.ml +++ b/backend/Duplicateaux.ml @@ -928,6 +928,9 @@ let loop_rotate f = ((code, entrypoint), revmap) let static_predict f = + debug_flag := true; + let _ = LICMaux.get_loop_backedges f.fn_code f.fn_entrypoint in + debug_flag := false; let entrypoint = f.fn_entrypoint in let code = f.fn_code in let revmap = make_identity_ptree code in 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 diff --git a/common/DebugPrint.ml b/common/DebugPrint.ml index 64efe727..931dfdf4 100644 --- a/common/DebugPrint.ml +++ b/common/DebugPrint.ml @@ -20,6 +20,20 @@ let print_ptree_bool oc pt = end else () +let print_ptree_opint oc pt = + if !debug_flag then + let elements = PTree.elements pt in + begin + Printf.fprintf oc "["; + List.iter (fun (n, op) -> + match op with + | None -> () + | Some p -> Printf.fprintf oc "%d -> %d, " (P.to_int n) (P.to_int p) + ) elements; + Printf.fprintf oc "]\n" + end + else () + let print_intlist oc l = let rec f oc = function | [] -> () |