1 files changed, 53 insertions, 5 deletions

diff --git a/backend/LICMaux.ml b/backend/LICMaux.ml
index 0ca4418b..6283e129 100644
--- a/backend/LICMaux.ml
+++ b/backend/LICMaux.ml
@@ -39,6 +39,42 @@ 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
+
+(* Adapted from backend/PrintRTL.ml: print_function *)
+let print_code code = let open PrintRTL in let open Printf in
+  if (!debug_flag) then begin
+    fprintf stdout "{\n";
+    let instrs =
+      List.sort
+        (fun (pc1, _) (pc2, _) -> compare pc2 pc1)
+        (List.rev_map
+          (fun (pc, i) -> (P.to_int pc, i))
+          (PTree.elements code)) in
+    List.iter (print_instruction stdout) instrs;
+    fprintf stdout "}"
+  end
+
 (** Getting loop branches with a DFS visit :
   * Each node is either Unvisited, Visited, or Processed
   * pre-order: node becomes Processed
@@ -53,23 +89,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
@@ -208,7 +255,8 @@ let rewrite_loop_body (last_alloc : reg ref)
                                (List.map (map_reg mapper) args),
                                new_res));
                 PTree.set res new_res mapper
-             | Iload(trap, chunk, addr, args, res, pc')
+             | Iload(_, chunk, addr, args, res, pc')
+             | Istore(chunk, addr, args, res, pc')
                   when Archi.has_notrap_loads &&
                        !Clflags.option_fnontrap_loads ->
                 let new_res = P.succ !last_alloc in