Big simplification of get_loop_info

Another remnant of trying to devise a complicated algorithm for a
problem that was, in fact, very simple: I just had to check whether the
branch was within the loop body.

I tested it functionally on the benchmarks: only heapsort is changed, in
slightly worst (4-5%), because the old get_loop_info had done a buggy
guess that proved to be lucky for that particular case.

The other benchmarks are unchanged: the predictions stay the exact same.

The get_loop_info could potentially be improved by having a natural loop
detection that extends to outer loops (not just inner loops), though I
expect the performance improvements would be very small.

1 files changed, 16 insertions, 111 deletions

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index b3635527..7504f724 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -270,120 +270,25 @@ let get_inner_loops f code is_loop_header =
     ) (PTree.elements loopmap)
   end
 
-
-(* Returns a PTree of either None or Some b where b determines the node following the loop, for a cb instruction *)
-(* It uses the fact that loops in CompCert are done by a branch (backedge) instruction followed by a cb *)
+(* Returns a PTree of either None or Some b where b determines the node in the loop body, for a cb instruction *)
 let get_loop_info f 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 n lbody =
-    let cb_info = ref PTree.empty in
-    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 explore src dest =
-      debug "Trying to dive a path from %d to %d\n" (P.to_int src) (P.to_int dest);
-      (* Memoizing the results to avoid exponential blow-up *)
-      let memory = ref PTree.empty in
-      let rec explore_rec src =
-        debug "explore_rec %d vs %d... " (P.to_int src) (P.to_int dest);
-        if (P.to_int src) == (P.to_int dest) then (debug "FOUND\n"; true)
-        else if (get_some @@ PTree.get src !visited) then (debug "VISITED... :( \n"; false)
-        (* if we went out of the innermost loop *)
-        else if (not @@ List.mem src lbody) then (debug "Out of innermost...\n"; false)
-        else begin
-          let inst = get_some @@ PTree.get src code in
-          visited := PTree.set src true !visited;
-          match rtl_successors inst with
-          | [] -> false
-          | [s] -> explore_wrap s
-          | [s1; s2] -> let snapshot_visited = ref !visited in begin
-              debug "\t\tSplit at %d: either %d or %d\n" (P.to_int src) (P.to_int s1) (P.to_int s2);
-              (* Remembering that we tried the ifso node *)
-              cb_info := PTree.set src true !cb_info;
-              match explore_wrap s1 with
-              | true -> (
-                  visited := !snapshot_visited;
-                  match explore_wrap s2 with
-                  | true -> begin
-                      (* Both paths lead to a loop: we cannot predict the CB
-                       * (but the explore still succeeds) *)
-                      cb_info := PTree.remove src !cb_info;
-                      true
-                    end
-                  | false -> true (* nothing to do, the explore succeeded *)
-                )
-              | false -> begin
-                  cb_info := PTree.set src false !cb_info;
-                  match explore_wrap s2 with
-                  | true -> true
-                  | false -> (cb_info := PTree.remove src !cb_info; false)
-                end
-            end
-          | _ -> false
-        end
-      and explore_wrap src = begin
-        match PTree.get src !memory with
-        | Some b -> b
-        | None ->
-            let result = explore_rec src in
-            (memory := PTree.set src result !memory; result)
-      end in explore_wrap src
-    (* Goes forward until a CB is encountered
-     * Returns None if no CB was found, or Some the_cb_node
-     * Marks nodes as visited along the way *)
-    in let rec advance_to_cb src =
-      if (get_some @@ PTree.get src !visited) then None
-      else begin
-        visited := PTree.set src true !visited;
-        match get_some @@ PTree.get src code with
-        | Inop s | Iop (_, _, _, s) | Iload (_,_,_,_,_,s) | Istore (_,_,_,_,s) | Icall (_,_,_,_,s)
-        | Ibuiltin (_,_,_,s) -> advance_to_cb s
-        | Icond _ -> Some src
-        | Ijumptable _ | Itailcall _ | Ireturn _ -> None
-      end
-    in begin
-      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
-              | Icond (_, _, n1, n2, _) -> (
-                  let b1 = explore n1 n in
-                  let b2 = explore n2 n in
-                  if (b1 && b2) then 
-                    debug "\tBoth paths lead back to the head: NONE\n"
-                  else if (b1 || b2) then begin
-                    if b1 then begin 
-                      debug "\tTrue path leads to the head: TRUE\n"; 
-                      loop_info := PTree.set s (Some true) !loop_info;
-                    end else if b2 then begin
-                      debug "\tFalse path leads to the head: FALSE\n";
-                      loop_info := PTree.set s (Some false) !loop_info
-                    end;
-                    debug "\tSetting other CBs encountered..\n";
-                    List.iter (fun (cb, dir) ->
-                      debug "\t\t%d is %B\n" (P.to_int cb) dir;
-                      loop_info := PTree.set cb (Some dir) !loop_info
-                    ) (PTree.elements !cb_info)
-                  end else
-                    debug "\tNo path leads back to the head: NONE\n"
-                )
-              | _ -> failwith "\tNot an Icond\n"
-            end
-          (* | Some _ -> ( debug "already loop info there\n" ) FIXME - we don't know yet whether a branch to a loop head is a backedge or not *)
-        )
-    end
+  let mark_iloop iloop =
+    List.iter (fun n ->
+      match get_some @@ PTree.get n code with
+      | Icond (_, _, ifso, ifnot, _) ->
+          let b1 = List.mem ifso iloop.body in
+          let b2 = List.mem ifnot iloop.body in
+          if (b1 && b2) then ()
+          else if (b1 || b2) then begin
+            if b1 then loop_info := PTree.set n (Some true) !loop_info
+            else if b2 then loop_info := PTree.set n (Some false) !loop_info
+          end
+      | _ -> ()
+    ) iloop.body
   in let iloops = get_inner_loops f code is_loop_header in
-  begin
-    List.iter (fun il -> mark_path il.head il.body) iloops;
-    (* List.iter mark_path @@ List.filter (fun n -> get_some @@ PTree.get n is_loop_header) bfs_order; *)
-    debug "==================================\n";
-    !loop_info
-  end
+  List.iter mark_iloop iloops;
+  !loop_info
 
 (* Remark - compared to the original Branch Prediction for Free paper, we don't use the store heuristic *)
 let get_directions f code entrypoint = begin