Simple backedge detection (modified code from get_loop_headers)

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

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

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
   | [] -> ()