From 6ee3ecb0edc17d61a515054952827c495cc03979 Mon Sep 17 00:00:00 2001
From: Cyril SIX <cyril.six@kalray.eu>
Date: Fri, 2 Apr 2021 11:41:41 +0200
Subject: Simple backedge detection (modified code from get_loop_headers)

---
 backend/Duplicateaux.ml |  3 +++
 backend/LICMaux.ml      | 40 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+)

(limited to 'backend')

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
-- 
cgit