Moving code

1 files changed, 72 insertions, 71 deletions

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index f70666e4..311db840 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -648,28 +648,6 @@ type innerLoop = {
 
 let print_pset = LICMaux.pp_pset
 
-let print_option_pint oc o =
-  if !debug_flag then
-    match o with
-    | None -> Printf.fprintf oc "None"
-    | Some n -> Printf.fprintf oc "Some %d" (P.to_int n)
-
-let print_inner_loop iloop =
-  debug "{preds: %a, body: %a, head: %d, finals: %a, sb_final: %a}\n"
-    print_intlist iloop.preds
-    print_intlist iloop.body
-    (P.to_int iloop.head)
-    print_intlist iloop.finals
-    print_option_pint iloop.sb_final
-
-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
@@ -680,55 +658,6 @@ let print_ptree printer pt =
     debug "]\n"
   end
 
-let print_pint oc i = if !debug_flag then Printf.fprintf oc "%d" (P.to_int i) else ()
-
-let cb_exit_node = function
-  | Icond (_,_,n1,n2,p) -> begin match p with
-      | Some true -> Some n2
-      | Some false -> Some n1
-      | None -> None
-    end
-  | _ -> None
-
-      (*
-(* Alternative code to get inner_loops - use it if we suspect the other function to be bugged *)
-let get_natural_loop code predmap n =
-  let is_final_node m =
-    let successors = rtl_successors @@ get_some @@ PTree.get m code in
-    List.exists (fun s -> (P.to_int s) == (P.to_int n)) successors
-  in 
-  let excluded_node = cb_exit_node @@ get_some @@ PTree.get n code in
-  let is_excluded m = match excluded_node with
-    | None -> false
-    | Some ex -> P.to_int ex == P.to_int m
-  in
-  debug "get_natural_loop for %d\n" (P.to_int n);
-  let body = bfs_until code n is_final_node is_excluded in
-  debug "BODY: %a\n" print_intlist body;
-  let final = List.find is_final_node body in
-  debug "FINAL: %d\n" (P.to_int final);
-  let preds = List.filter (fun pred -> List.mem pred body) @@ get_some @@ PTree.get n predmap in
-  debug "PREDS: %a\n" print_intlist preds;
-  { preds = preds; body = body; head = n; final = final }
-
-let rec count_loop_headers is_loop_header = function
-  | [] -> 0
-  | n :: ln ->
-      let rem = count_loop_headers is_loop_header ln in
-      if (get_some @@ PTree.get n is_loop_header) then rem + 1 else rem
-
-let get_inner_loops f code is_loop_header =
-  let predmap = get_predecessors_rtl code in
-  let iloops = ref [] in
-  List.iter (fun (n, ilh) -> if ilh then begin
-    let iloop = get_natural_loop code predmap n in
-    let nb_headers = count_loop_headers is_loop_header iloop.body in
-    if nb_headers == 1 then (* innermost loop *)
-      iloops := iloop :: !iloops end
-  ) (PTree.elements is_loop_header);
-  !iloops
-  *)
-
 let rtl_successors_pref = function
 | Itailcall _ | Ireturn _ -> []
 | Icall(_,_,_,_,n) | Ibuiltin(_,_,_,n) | Inop n | Iop (_,_,_,n)
@@ -799,6 +728,78 @@ let get_inner_loops f code is_loop_header =
     ) (PTree.elements loopmap)
   end
 
+
+let print_option_pint oc o =
+  if !debug_flag then
+    match o with
+    | None -> Printf.fprintf oc "None"
+    | Some n -> Printf.fprintf oc "Some %d" (P.to_int n)
+
+let print_inner_loop iloop =
+  debug "{preds: %a, body: %a, head: %d, finals: %a, sb_final: %a}\n"
+    print_intlist iloop.preds
+    print_intlist iloop.body
+    (P.to_int iloop.head)
+    print_intlist iloop.finals
+    print_option_pint iloop.sb_final
+
+let rec print_inner_loops = function
+| [] -> ()
+| iloop :: iloops -> begin
+    print_inner_loop iloop;
+    debug "\n";
+    print_inner_loops iloops
+  end
+
+let print_pint oc i = if !debug_flag then Printf.fprintf oc "%d" (P.to_int i) else ()
+
+let cb_exit_node = function
+  | Icond (_,_,n1,n2,p) -> begin match p with
+      | Some true -> Some n2
+      | Some false -> Some n1
+      | None -> None
+    end
+  | _ -> None
+
+      (*
+(* Alternative code to get inner_loops - use it if we suspect the other function to be bugged *)
+let get_natural_loop code predmap n =
+  let is_final_node m =
+    let successors = rtl_successors @@ get_some @@ PTree.get m code in
+    List.exists (fun s -> (P.to_int s) == (P.to_int n)) successors
+  in 
+  let excluded_node = cb_exit_node @@ get_some @@ PTree.get n code in
+  let is_excluded m = match excluded_node with
+    | None -> false
+    | Some ex -> P.to_int ex == P.to_int m
+  in
+  debug "get_natural_loop for %d\n" (P.to_int n);
+  let body = bfs_until code n is_final_node is_excluded in
+  debug "BODY: %a\n" print_intlist body;
+  let final = List.find is_final_node body in
+  debug "FINAL: %d\n" (P.to_int final);
+  let preds = List.filter (fun pred -> List.mem pred body) @@ get_some @@ PTree.get n predmap in
+  debug "PREDS: %a\n" print_intlist preds;
+  { preds = preds; body = body; head = n; final = final }
+
+let rec count_loop_headers is_loop_header = function
+  | [] -> 0
+  | n :: ln ->
+      let rem = count_loop_headers is_loop_header ln in
+      if (get_some @@ PTree.get n is_loop_header) then rem + 1 else rem
+
+let get_inner_loops f code is_loop_header =
+  let predmap = get_predecessors_rtl code in
+  let iloops = ref [] in
+  List.iter (fun (n, ilh) -> if ilh then begin
+    let iloop = get_natural_loop code predmap n in
+    let nb_headers = count_loop_headers is_loop_header iloop.body in
+    if nb_headers == 1 then (* innermost loop *)
+      iloops := iloop :: !iloops end
+  ) (PTree.elements is_loop_header);
+  !iloops
+  *)
+
 let rec generate_fwmap ln ln' fwmap =
   match ln with
   | [] -> begin