diff options
Diffstat (limited to 'backend/Duplicateaux.ml')
| -rw-r--r-- | backend/Duplicateaux.ml | 355 |
1 files changed, 212 insertions, 143 deletions
diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml index b3635527..d55da64a 100644 --- a/backend/Duplicateaux.ml +++ b/backend/Duplicateaux.ml @@ -24,6 +24,76 @@ open Maps open Camlcoq open DebugPrint +let stats_oc = ref None + +let set_stats_oc () = + try + let name = Sys.getenv "COMPCERT_PREDICT_STATS" in + let oc = open_out_gen [Open_append; Open_creat; Open_text] 0o666 name in + stats_oc := Some oc + with Not_found -> () + +(* number of total CBs *) +let stats_nb_total = ref 0 +(* we predicted the same thing as the profiling *) +let stats_nb_correct_predicts = ref 0 +(* we predicted something (say Some true), but the profiling predicted the opposite (say Some false) *) +let stats_nb_mispredicts = ref 0 +(* we did not predict anything (None) even though the profiling did predict something *) +let stats_nb_missed_opportunities = ref 0 +(* we predicted something (say Some true) but the profiling preferred not to predict anything (None) *) +let stats_nb_overpredict = ref 0 + +(* heuristic specific counters *) +let wrong_opcode = ref 0 +let wrong_return = ref 0 +let wrong_loop2 = ref 0 +let wrong_loop = ref 0 +let wrong_call = ref 0 + +let right_opcode = ref 0 +let right_return = ref 0 +let right_loop2 = ref 0 +let right_loop = ref 0 +let right_call = ref 0 + +let reset_stats () = begin + stats_nb_total := 0; + stats_nb_correct_predicts := 0; + stats_nb_mispredicts := 0; + stats_nb_missed_opportunities := 0; + stats_nb_overpredict := 0; + wrong_opcode := 0; + wrong_return := 0; + wrong_loop2 := 0; + wrong_loop := 0; + wrong_call := 0; + right_opcode := 0; + right_return := 0; + right_loop2 := 0; + right_loop := 0; + right_call := 0; +end + +let incr theref = theref := !theref + 1 + +let has_some o = match o with Some _ -> true | None -> false + +let stats_oc_recording () = has_some !stats_oc + +let write_stats_oc () = + match !stats_oc with + | None -> () + | Some oc -> begin + Printf.fprintf oc "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d\n" !stats_nb_total + !stats_nb_correct_predicts !stats_nb_mispredicts !stats_nb_missed_opportunities + !stats_nb_overpredict + !wrong_opcode !wrong_return !wrong_loop2 !wrong_loop !wrong_call + !right_opcode !right_return !right_loop2 !right_loop !right_call + ; + close_out oc + end + let get_loop_headers = LICMaux.get_loop_headers let get_some = LICMaux.get_some let rtl_successors = LICMaux.rtl_successors @@ -270,120 +340,66 @@ let get_inner_loops f code is_loop_header = ) (PTree.elements loopmap) end +let get_loop_bodies code entrypoint = + let predecessors = get_predecessors_rtl code in + (* Algorithm from Muchnik, Compiler Design & Implementation, Figure 7.21 page 192 *) + let natural_loop n m = + debug "Natural Loop from %d to %d\n" (P.to_int n) (P.to_int m); + let in_body = ref (PTree.map (fun n b -> false) code) in + let body = ref [] in + let add_to_body n = begin + in_body := PTree.set n true !in_body; + body := n :: !body + end + in let rec process_node p = + debug " Processing node %d\n" (P.to_int p); + List.iter (fun pred -> + debug " Looking at predecessor of %d: %d\n" (P.to_int p) (P.to_int pred); + let is_in_body = get_some @@ PTree.get pred !in_body in + if (not @@ is_in_body) then begin + debug " --> adding to body\n"; + add_to_body pred; + process_node pred + end + ) (get_some @@ PTree.get p predecessors) + in begin + add_to_body m; + add_to_body n; + (if (m != n) then process_node m); + !body + end + in let option_natural_loop n = function + | None -> None + | Some m -> Some (natural_loop n m) + in PTree.map option_natural_loop (LICMaux.get_loop_backedges code entrypoint) -(* Returns a PTree of either None or Some b where b determines the node following the loop, for a cb instruction *) -(* It uses the fact that loops in CompCert are done by a branch (backedge) instruction followed by a cb *) +(* Returns a PTree of either None or Some b where b determines the node in the loop body, for a cb instruction *) let get_loop_info f is_loop_header bfs_order code = - debug "GET LOOP INFO\n"; - debug "==================================\n"; let loop_info = ref (PTree.map (fun n i -> None) code) in - let mark_path n lbody = - let cb_info = ref PTree.empty in - let visited = ref (PTree.map (fun n i -> false) code) in - (* Returns true if there is a path from src to dest (not involving jumptables) *) - (* Mark nodes as visited along the way *) - let explore src dest = - debug "Trying to dive a path from %d to %d\n" (P.to_int src) (P.to_int dest); - (* Memoizing the results to avoid exponential blow-up *) - let memory = ref PTree.empty in - let rec explore_rec src = - debug "explore_rec %d vs %d... " (P.to_int src) (P.to_int dest); - if (P.to_int src) == (P.to_int dest) then (debug "FOUND\n"; true) - else if (get_some @@ PTree.get src !visited) then (debug "VISITED... :( \n"; false) - (* if we went out of the innermost loop *) - else if (not @@ List.mem src lbody) then (debug "Out of innermost...\n"; false) - else begin - let inst = get_some @@ PTree.get src code in - visited := PTree.set src true !visited; - match rtl_successors inst with - | [] -> false - | [s] -> explore_wrap s - | [s1; s2] -> let snapshot_visited = ref !visited in begin - debug "\t\tSplit at %d: either %d or %d\n" (P.to_int src) (P.to_int s1) (P.to_int s2); - (* Remembering that we tried the ifso node *) - cb_info := PTree.set src true !cb_info; - match explore_wrap s1 with - | true -> ( - visited := !snapshot_visited; - match explore_wrap s2 with - | true -> begin - (* Both paths lead to a loop: we cannot predict the CB - * (but the explore still succeeds) *) - cb_info := PTree.remove src !cb_info; - true - end - | false -> true (* nothing to do, the explore succeeded *) - ) - | false -> begin - cb_info := PTree.set src false !cb_info; - match explore_wrap s2 with - | true -> true - | false -> (cb_info := PTree.remove src !cb_info; false) - end - end - | _ -> false + let mark_body body = + List.iter (fun n -> + match get_some @@ PTree.get n code with + | Icond (_, _, ifso, ifnot, _) -> begin + match PTree.get n !loop_info with + | None -> () + | Some _ -> + let b1 = List.mem ifso body in + let b2 = List.mem ifnot body in + if (b1 && b2) then () + else if (b1 || b2) then begin + if b1 then loop_info := PTree.set n (Some true) !loop_info + else if b2 then loop_info := PTree.set n (Some false) !loop_info + end end - and explore_wrap src = begin - match PTree.get src !memory with - | Some b -> b - | None -> - let result = explore_rec src in - (memory := PTree.set src result !memory; result) - end in explore_wrap src - (* Goes forward until a CB is encountered - * Returns None if no CB was found, or Some the_cb_node - * Marks nodes as visited along the way *) - in let rec advance_to_cb src = - if (get_some @@ PTree.get src !visited) then None - else begin - visited := PTree.set src true !visited; - match get_some @@ PTree.get src code with - | Inop s | Iop (_, _, _, s) | Iload (_,_,_,_,_,s) | Istore (_,_,_,_,s) | Icall (_,_,_,_,s) - | Ibuiltin (_,_,_,s) -> advance_to_cb s - | Icond _ -> Some src - | Ijumptable _ | Itailcall _ | Ireturn _ -> None - end - in begin - debug "Attempting to find natural loop from HEAD %d..\n" (P.to_int n); - match advance_to_cb n with - | None -> (debug "\tNo CB found\n") - | Some s -> ( debug "\tFound a CB! %d\n" (P.to_int s); - match get_some @@ PTree.get s !loop_info with - | None | Some _ -> begin - match get_some @@ PTree.get s code with - | Icond (_, _, n1, n2, _) -> ( - let b1 = explore n1 n in - let b2 = explore n2 n in - if (b1 && b2) then - debug "\tBoth paths lead back to the head: NONE\n" - else if (b1 || b2) then begin - if b1 then begin - debug "\tTrue path leads to the head: TRUE\n"; - loop_info := PTree.set s (Some true) !loop_info; - end else if b2 then begin - debug "\tFalse path leads to the head: FALSE\n"; - loop_info := PTree.set s (Some false) !loop_info - end; - debug "\tSetting other CBs encountered..\n"; - List.iter (fun (cb, dir) -> - debug "\t\t%d is %B\n" (P.to_int cb) dir; - loop_info := PTree.set cb (Some dir) !loop_info - ) (PTree.elements !cb_info) - end else - debug "\tNo path leads back to the head: NONE\n" - ) - | _ -> failwith "\tNot an Icond\n" - end - (* | Some _ -> ( debug "already loop info there\n" ) FIXME - we don't know yet whether a branch to a loop head is a backedge or not *) - ) - end - in let iloops = get_inner_loops f code is_loop_header in - begin - List.iter (fun il -> mark_path il.head il.body) iloops; - (* List.iter mark_path @@ List.filter (fun n -> get_some @@ PTree.get n is_loop_header) bfs_order; *) - debug "==================================\n"; - !loop_info - end + | _ -> () + ) body + in let bodymap = get_loop_bodies code f.fn_entrypoint in + List.iter (fun (_,obody) -> + match obody with + | None -> () + | Some body -> mark_body body + ) (PTree.elements bodymap); + !loop_info (* Remark - compared to the original Branch Prediction for Free paper, we don't use the store heuristic *) let get_directions f code entrypoint = begin @@ -397,28 +413,59 @@ let get_directions f code entrypoint = begin (* debug "\n"; *) List.iter (fun n -> match (get_some @@ PTree.get n code) with - | Icond (cond, lr, ifso, ifnot, pred) -> - (match pred with Some _ -> debug "RTL node %d already has prediction information\n" (P.to_int n) - | None -> - (* debug "Analyzing %d.." (P.to_int n); *) - let heuristics = [ do_opcode_heuristic; - do_return_heuristic; do_loop2_heuristic loop_info n; do_loop_heuristic; do_call_heuristic; - (* do_store_heuristic *) ] in - let preferred = ref None in - begin - debug "Deciding condition for RTL node %d\n" (P.to_int n); - List.iter (fun do_heur -> - match !preferred with - | None -> preferred := do_heur code cond ifso ifnot is_loop_header - | Some _ -> () - ) heuristics; - directions := PTree.set n !preferred !directions; - (match !preferred with | Some false -> debug "\tFALLTHROUGH\n" - | Some true -> debug "\tBRANCH\n" - | None -> debug "\tUNSURE\n"); - debug "---------------------------------------\n" - end - ) + | Icond (cond, lr, ifso, ifnot, pred) -> begin + if stats_oc_recording () || not @@ has_some pred then + (* debug "Analyzing %d.." (P.to_int n); *) + let heuristics = [ do_opcode_heuristic; + do_return_heuristic; do_loop2_heuristic loop_info n; do_loop_heuristic; do_call_heuristic; + (* do_store_heuristic *) ] in + let preferred = ref None in + let current_heuristic = ref 0 in + begin + debug "Deciding condition for RTL node %d\n" (P.to_int n); + List.iter (fun do_heur -> + match !preferred with + | None -> begin + preferred := do_heur code cond ifso ifnot is_loop_header; + if stats_oc_recording () then begin + (* Getting stats about mispredictions from each heuristic *) + (match !preferred, pred with + | Some false, Some true + | Some true, Some false + (* | Some _, None *) (* Uncomment for overpredicts *) + -> begin + match !current_heuristic with + | 0 -> incr wrong_opcode + | 1 -> incr wrong_return + | 2 -> incr wrong_loop2 + | 3 -> incr wrong_loop + | 4 -> incr wrong_call + | _ -> failwith "Shouldn't happen" + end + | Some false, Some false + | Some true, Some true -> begin + match !current_heuristic with + | 0 -> incr right_opcode + | 1 -> incr right_return + | 2 -> incr right_loop2 + | 3 -> incr right_loop + | 4 -> incr right_call + | _ -> failwith "Shouldn't happen" + end + | _ -> () + ); + incr current_heuristic + end + end + | Some _ -> () + ) heuristics; + directions := PTree.set n !preferred !directions; + (match !preferred with | Some false -> debug "\tFALLTHROUGH\n" + | Some true -> debug "\tBRANCH\n" + | None -> debug "\tUNSURE\n"); + debug "---------------------------------------\n" + end + end | _ -> () ) bfs_order; !directions @@ -426,11 +473,28 @@ let get_directions f code entrypoint = begin end let update_direction direction = function -| Icond (cond, lr, n, n', pred) -> +| Icond (cond, lr, n, n', pred) -> begin + (* Counting stats from profiling *) + if stats_oc_recording () then begin + incr stats_nb_total; + match pred, direction with + | None, None -> incr stats_nb_correct_predicts + | None, Some _ -> incr stats_nb_overpredict + | Some _, None -> incr stats_nb_missed_opportunities + | Some false, Some false -> incr stats_nb_correct_predicts + | Some false, Some true -> incr stats_nb_mispredicts + | Some true, Some false -> incr stats_nb_mispredicts + | Some true, Some true -> incr stats_nb_correct_predicts + end; + (* only update if there is no prior existing branch prediction *) (match pred with | None -> Icond (cond, lr, n, n', direction) - | Some _ -> Icond (cond, lr, n, n', pred) ) + | Some _ -> begin + Icond (cond, lr, n, n', pred) + end + ) + end | i -> i (* Uses branch prediction to write prediction annotations in Icond *) @@ -1026,15 +1090,20 @@ let static_predict f = let entrypoint = f.fn_entrypoint in let code = f.fn_code in let revmap = make_identity_ptree code in - let code = - if !Clflags.option_fpredict then - update_directions f code entrypoint - else code in - let code = - if !Clflags.option_fpredict then - invert_iconds code - else code in - ((code, entrypoint), revmap) + begin + reset_stats (); + set_stats_oc (); + let code = + if !Clflags.option_fpredict then + update_directions f code entrypoint + else code in + write_stats_oc (); + let code = + if !Clflags.option_fpredict then + invert_iconds code + else code in + ((code, entrypoint), revmap) + end let unroll_single f = let entrypoint = f.fn_entrypoint in |