Detecting inner loops with LICMaux.inner_loops

1 files changed, 75 insertions, 12 deletions

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index fc16d5ce..fe062e73 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -600,17 +600,80 @@ let rec invert_iconds code = function
                   else code
       in invert_iconds code' ts
 
+(** Partial loop unrolling
+ *
+ * The following code seeks innermost loops, and unfolds the first iteration
+ * Most of the code has been moved from LICMaux.ml to Duplicateaux.ml to solve
+ * cyclic dependencies between LICMaux and Duplicateaux
+ *)
+
+type innerLoop = {
+  preds: P.t list;
+  body: HashedSet.PSet.t;
+}
+
+let print_pset = LICMaux.pp_pset
+
+let print_inner_loop iloop =
+  debug "{preds: %a, body: %a}" print_intlist iloop.preds print_pset iloop.body
+
+let rec print_inner_loops = function
+| [] -> ()
+| iloop :: iloops -> begin
+    print_inner_loop iloop;
+    debug "\n";
+    print_inner_loops iloops
+  end
+
+let print_ptree printer pt =
+  let elements = PTree.elements pt in
+  begin
+    debug "[\n";
+    List.iter (fun (n, elt) ->
+      debug "\t%d: %a\n" (P.to_int n) printer elt
+    ) elements;
+    debug "]\n"
+  end
+
+let get_inner_loops f =
+  let (_, predmap, loopmap) = LICMaux.inner_loops f in
+  begin
+    debug "PREDMAP: "; print_ptree print_intlist predmap;
+    debug "LOOPMAP: "; print_ptree print_pset loopmap;
+    let all_loops = List.map (fun (n, body) ->
+      let preds = List.filter (fun p -> not @@ HashedSet.PSet.contains body p) 
+        @@ get_some @@ PTree.get n predmap in
+      { preds = preds; body = body }
+    ) (PTree.elements loopmap) in
+    (* LICMaux.inner_loops also returns non-inner loops, but with a body of 1 instruction
+     * We remove those to get just the inner loops *)
+    List.filter (fun iloop ->
+      let count = List.length @@ HashedSet.PSet.elements iloop.body in count != 1
+    ) all_loops
+  end
+
+let unroll_inner_loops f =
+  let inner_loops = get_inner_loops f in
+  begin
+    debug_flag := true;
+    print_inner_loops inner_loops;
+    debug_flag := false;
+  end
+
 let duplicate_aux f =
-  let entrypoint = f.fn_entrypoint in
-  if !Clflags.option_fduplicate < 0 then
-    ((f.fn_code, entrypoint), make_identity_ptree f.fn_code)
-  else
-    let code = update_directions (f.fn_code) entrypoint in
-    let traces = select_traces code entrypoint in
-    let icond_code = invert_iconds code traces in
-    let preds = get_predecessors_rtl icond_code in
-    if !Clflags.option_fduplicate >= 1 then
-      let (new_code, pTreeId) = ((* print_traces traces; *) superblockify_traces icond_code preds traces) in
-      ((new_code, f.fn_entrypoint), pTreeId)
+  begin
+    unroll_inner_loops f;
+    let entrypoint = f.fn_entrypoint in
+    if !Clflags.option_fduplicate < 0 then
+      ((f.fn_code, entrypoint), make_identity_ptree f.fn_code)
     else
-      ((icond_code, entrypoint), make_identity_ptree code)
+      let code = update_directions (f.fn_code) entrypoint in
+      let traces = select_traces code entrypoint in
+      let icond_code = invert_iconds code traces in
+      let preds = get_predecessors_rtl icond_code in
+      if !Clflags.option_fduplicate >= 1 then
+        let (new_code, pTreeId) = ((* print_traces traces; *) superblockify_traces icond_code preds traces) in
+        ((new_code, f.fn_entrypoint), pTreeId)
+      else
+        ((icond_code, entrypoint), make_identity_ptree code)
+  end