From 4fe7ec168a9ce2c8c6e04d7f56729fd7a5758ce1 Mon Sep 17 00:00:00 2001 From: Cyril SIX Date: Wed, 11 Mar 2020 17:30:37 +0100 Subject: [BROKEN] Started to change the trace selection --- backend/Duplicateaux.ml | 92 ++++++++++++++++++++----------------------------- 1 file changed, 38 insertions(+), 54 deletions(-) (limited to 'backend/Duplicateaux.ml') diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml index 86bc06c9..c379faf3 100644 --- a/backend/Duplicateaux.ml +++ b/backend/Duplicateaux.ml @@ -2,19 +2,6 @@ open RTL open Maps open Camlcoq -(* TTL : IR emphasizing the preferred next node *) -module TTL = struct - type instruction = - | Tleaf of RTL.instruction - | Tnext of node * RTL.instruction - - type code = instruction PTree.t -end;; - -open TTL - -(** RTL to TTL *) - let get_some = function | None -> failwith "Did not get some" | Some thing -> thing @@ -242,37 +229,26 @@ let get_directions code entrypoint = !directions end -let to_ttl_inst direction = function -| Ireturn o -> Tleaf (Ireturn o) -| Inop n -> Tnext (n, Inop n) -| Iop (op, lr, r, n) -> Tnext (n, Iop(op, lr, r, n)) -| Iload (tm, m, a, lr, r, n) -> Tnext (n, Iload(tm, m, a, lr, r, n)) -| Istore (m, a, lr, r, n) -> Tnext (n, Istore(m, a, lr, r, n)) -| Icall (s, ri, lr, r, n) -> Tleaf (Icall(s, ri, lr, r, n)) -| Itailcall (s, ri, lr) -> Tleaf (Itailcall(s, ri, lr)) -| Ibuiltin (ef, lbr, br, n) -> Tleaf (Ibuiltin(ef, lbr, br, n)) -| Icond (cond, lr, n, n', i) -> (match direction with - | false -> Tnext (n', Icond(cond, lr, n, n', i)) - | true -> Tnext (n, Icond(cond, lr, n, n', i))) -| Ijumptable (r, ln) -> Tleaf (Ijumptable(r, ln)) - -let rec to_ttl_code_rec directions = function +let update_direction direction = function +| Icond (cond, lr, n, n', _) -> Icond (cond, lr, n, n', Some direction) +| i -> i + +let rec update_direction_rec directions = function | [] -> PTree.empty | m::lm -> let (n, i) = m in let direction = get_some @@ PTree.get n directions - in PTree.set n (to_ttl_inst direction i) (to_ttl_code_rec directions lm) + in PTree.set n (update_direction direction i) (update_direction_rec directions lm) -let to_ttl_code code entrypoint = +let update_directions code entrypoint = let directions = get_directions code entrypoint in begin (* Printf.printf "Ifso directions: "; ptree_printbool directions; Printf.printf "\n"; *) - Random.init(0); (* using same seed to make it deterministic *) - to_ttl_code_rec directions (PTree.elements code) + update_direction_rec directions (PTree.elements code) end -(** Trace selection on TTL *) +(** Trace selection *) let rec exists_false_rec = function | [] -> false @@ -280,7 +256,7 @@ let rec exists_false_rec = function let exists_false boolmap = exists_false_rec (PTree.elements boolmap) -(* DFS on TTL to guide the exploration *) +(* DFS using prediction info to guide the exploration *) let dfs code entrypoint = let visited = ref (PTree.map (fun n i -> false) code) in let rec dfs_list code = function @@ -291,22 +267,21 @@ let dfs code entrypoint = visited := PTree.set node true !visited; match PTree.get node code with | None -> failwith "No such node" - | Some ti -> [node] @ match ti with - | Tleaf i -> (match i with - | Icall(_, _, _, _, n) -> dfs_list code [n] - | Ibuiltin(_, _, _, n) -> dfs_list code [n] - | Ijumptable(_, ln) -> dfs_list code ln - | Itailcall _ | Ireturn _ -> [] - | _ -> failwith "Tleaf case not handled in dfs" ) - | Tnext (n,i) -> (dfs_list code [n]) @ match i with - | Icond (_, _, n1, n2, _) -> dfs_list code [n1; n2] - | Inop _ | Iop _ | Iload _ | Istore _ -> [] - | _ -> failwith "Tnext case not handled in dfs" + | Some i -> [node] @ match i with + | Icall(_, _, _, _, n) -> dfs_list code [n] + | Ibuiltin(_, _, _, n) -> dfs_list code [n] + | Ijumptable(_, ln) -> dfs_list code ln + | Itailcall _ | Ireturn _ -> [] + | Inop _ | Iop _ | Iload _ | Istore _ -> [] + | Icond (_, _, n1, n2, info) -> match info with + | Some false -> dfs_list code [n2; n1] + | _ -> dfs_list code [n1; n2] end else [] in node_dfs @ (dfs_list code ln) in dfs_list code [entrypoint] +(* let get_predecessors_ttl code = let preds = ref (PTree.map (fun n i -> []) code) in let process_inst (node, ti) = match ti with @@ -322,8 +297,7 @@ let get_predecessors_ttl code = List.iter process_inst (PTree.elements code); !preds end - -let rtl_proj code = PTree.map (fun n ti -> match ti with Tleaf i | Tnext(_, i) -> i) code +*) let rec select_unvisited_node is_visited = function | [] -> failwith "Empty list" @@ -332,11 +306,21 @@ let rec select_unvisited_node is_visited = function let best_successor_of node code is_visited = match (PTree.get node code) with | None -> failwith "No such node in the code" - | Some ti -> match ti with - | Tleaf _ -> None - | Tnext (n,_) -> if not (ptree_get_some n is_visited) then Some n - else None - + | Some i -> + let next_node = match i with + | Inop n -> Some n + | Iop (_, _, _, n) -> Some n + | Iload (_, _, _, _, _, n) -> Some n + | Istore (_, _, _, _, n) -> Some n + | Icall (_, _, _, _, n) -> Some n + | Ibuiltin (_, _, _, n) -> Some n + | Icond (_, _, n1, n2, ob) -> (match ob with None -> None | Some false -> Some n2 | Some true -> Some n1) + | _ -> None + in match next_node with + | None -> None + | Some n -> if not (ptree_get_some n is_visited) then Some n else None + +(* FIXME - could be improved by selecting in priority the predicted paths *) let best_predecessor_of node predecessors order is_visited = match (PTree.get node predecessors) with | None -> failwith "No predecessor list found" @@ -347,7 +331,7 @@ let best_predecessor_of node predecessors order is_visited = * "Trace Selection for Compiling Large C Application Programs to Microcode" *) let select_traces code entrypoint = let order = dfs code entrypoint in - let predecessors = get_predecessors_ttl code in + let predecessors = get_predecessors_rtl code in let traces = ref [] in let is_visited = ref (PTree.map (fun n i -> false) code) in begin (* mark all nodes visited *) while exists_false !is_visited do (* while (there are unvisited nodes) *) @@ -524,7 +508,7 @@ let rec invert_iconds code = function let duplicate_aux f = let entrypoint = f.fn_entrypoint in let code = f.fn_code in - let traces = select_traces (to_ttl_code code entrypoint) entrypoint in + let traces = select_traces code entrypoint in let icond_code = invert_iconds code traces in let preds = get_predecessors_rtl icond_code in if !Clflags.option_fduplicate >= 1 then -- cgit