Fixing loop detection in get_loop_info - part 1

Various typos made the code fail silently for certain loops

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