Fixing get_loop_headers + alternative get_inner_loops (commented, not active)

1 files changed, 37 insertions, 4 deletions

diff --git a/backend/LICMaux.ml b/backend/LICMaux.ml
index 42b8eeb7..bf6418e8 100644
--- a/backend/LICMaux.ml
+++ b/backend/LICMaux.ml
@@ -39,6 +39,28 @@ let rtl_successors = function
 | Icond (_,_,n1,n2,_) -> [n1; n2]
 | Ijumptable (_,ln) -> ln
 
+let print_ptree_bool oc pt =
+  if !debug_flag then
+    let elements = PTree.elements pt in
+    begin
+      Printf.fprintf oc "[";
+      List.iter (fun (n, b) ->
+        if b then Printf.fprintf oc "%d, " (P.to_int n)
+      ) elements;
+      Printf.fprintf oc "]\n"
+    end
+  else ()
+
+let print_intlist oc l =
+  let rec f oc = function
+  | [] -> ()
+  | n::ln -> (Printf.fprintf oc "%d %a" (P.to_int n) f ln)
+  in begin
+    if !debug_flag then begin
+      Printf.fprintf oc "[%a]" f l
+    end
+  end
+
 (** Getting loop branches with a DFS visit :
   * Each node is either Unvisited, Visited, or Processed
   * pre-order: node becomes Processed
@@ -53,23 +75,34 @@ let get_loop_headers code entrypoint = begin
   in let rec dfs_visit code = 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 -> ()
+      | Visited -> begin
+          debug "\tNode %d is already Visited, skipping\n" (P.to_int node);
+          dfs_visit code ln
+        end
       | Processed -> begin
           debug "Node %d is a loop header\n" (P.to_int node);
           is_loop_header := PTree.set node true !is_loop_header;
-          visited := PTree.set node Visited !visited
+          visited := PTree.set node Visited !visited;
+          dfs_visit code ln
         end
       | Unvisited -> begin
           visited := PTree.set node Processed !visited;
-          match PTree.get node code with
+          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 dfs_visit code next_visits;
+          | Some i -> let next_visits = rtl_successors i in begin
+              debug "About to visit: %a\n" print_intlist next_visits;
+              dfs_visit code next_visits
+            end);
+          debug "Node %d is Visited!\n" (P.to_int node);
           visited := PTree.set node Visited !visited;
           dfs_visit code ln
         end
   in begin
     dfs_visit code [entrypoint];
+    debug "LOOP HEADERS: %a\n" print_ptree_bool !is_loop_header;
     !is_loop_header
   end
 end