From 1fab69c3f4a87fb7a2480aa6c353492f69dcacee Mon Sep 17 00:00:00 2001 From: Cyril SIX Date: Tue, 8 Dec 2020 13:43:32 +0100 Subject: Moving code --- backend/Duplicateaux.ml | 143 ++++++++++++++++++++++++------------------------ 1 file changed, 72 insertions(+), 71 deletions(-) (limited to 'backend/Duplicateaux.ml') 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 -- cgit