diff options
author | Cyril SIX <cyril.six@kalray.eu> | 2020-12-08 13:43:48 +0100 |
---|---|---|
committer | Cyril SIX <cyril.six@kalray.eu> | 2020-12-08 13:44:17 +0100 |
commit | 714b2b0aacdd7d9348173c08c96c673f1b33be15 (patch) | |
tree | c1d6b7ff83161a8babe7f35ed4c030b92ae4a3b0 | |
parent | 1fab69c3f4a87fb7a2480aa6c353492f69dcacee (diff) | |
download | compcert-kvx-714b2b0aacdd7d9348173c08c96c673f1b33be15.tar.gz compcert-kvx-714b2b0aacdd7d9348173c08c96c673f1b33be15.zip |
Fixing loop detection in get_loop_info - part 1
Various typos made the code fail silently for certain loops
-rw-r--r-- | backend/Duplicateaux.ml | 24 |
1 files changed, 8 insertions, 16 deletions
diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml index 311db840..65d9547f 100644 --- a/backend/Duplicateaux.ml +++ b/backend/Duplicateaux.ml @@ -205,13 +205,13 @@ let get_loop_info is_loop_header bfs_order code = debug "GET LOOP INFO\n"; debug "==================================\n"; let loop_info = ref (PTree.map (fun n i -> None) code) in - let mark_path s n = + let mark_path n = let visited = ref (PTree.map (fun n i -> false) code) in (* Returns true if there is a path from src to dest (not involving jumptables) *) (* Mark nodes as visited along the way *) let rec explore src dest = - if (get_some @@ PTree.get src !visited) then false - else if src == dest then true + if src == dest then true + else if (get_some @@ PTree.get src !visited) then false else begin visited := PTree.set src true !visited; match rtl_successors @@ get_some @@ PTree.get src code with @@ -234,10 +234,10 @@ let get_loop_info is_loop_header bfs_order code = | Ijumptable _ | Itailcall _ | Ireturn _ -> None end in begin - debug "Marking path from %d to %d\n" (P.to_int n) (P.to_int s); - match advance_to_cb s with - | None -> (debug "Nothing found\n") - | Some s -> ( debug "Advancing to %d\n" (P.to_int s); + debug "Attempting to find natural loop from HEAD %d..\n" (P.to_int n); + match advance_to_cb n with + | None -> (debug "\tNo CB found\n") + | Some s -> ( debug "\tFound a CB! %d\n" (P.to_int s); match get_some @@ PTree.get s !loop_info with | None | Some _ -> begin match get_some @@ PTree.get s code with @@ -261,15 +261,7 @@ let get_loop_info is_loop_header bfs_order code = ) end in begin - List.iter (fun n -> - match get_some @@ PTree.get n code with - | Inop s | Iop (_,_,_,s) | Iload (_,_,_,_,_,s) | Istore (_,_,_,_,s) | Icall (_,_,_,_,s) - | Ibuiltin (_, _, _, s) -> - if get_some @@ PTree.get s is_loop_header then mark_path s n - | Icond _ -> () (* loop backedges are never Icond in CompCert RTL.3 *) - | Ijumptable _ -> () - | Itailcall _ | Ireturn _ -> () - ) bfs_order; + List.iter mark_path @@ List.filter (fun n -> get_some @@ PTree.get n is_loop_header) bfs_order; debug "==================================\n"; !loop_info end |