From 690fa3a3969f3e1294f8b381f6b8d9c051b264d3 Mon Sep 17 00:00:00 2001 From: Cyril SIX Date: Tue, 3 Mar 2020 18:27:24 +0100 Subject: Linearize: Dependencies computing to decide which sequence to put first --- backend/Linearizeaux.ml | 163 +++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 132 insertions(+), 31 deletions(-) (limited to 'backend/Linearizeaux.ml') diff --git a/backend/Linearizeaux.ml b/backend/Linearizeaux.ml index 3ef86344..58d7558b 100644 --- a/backend/Linearizeaux.ml +++ b/backend/Linearizeaux.ml @@ -140,33 +140,6 @@ let rec last_element = function | e :: [] -> e | e' :: e :: l -> last_element (e::l) -(** old version -let dfs code entrypoint = - let visited = ref (PTree.map (fun n i -> false) code) in - let rec dfs_list code = function - | [] -> [] - | node :: ln -> - let node_dfs = - if not (get_some @@ PTree.get node !visited) then begin - visited := PTree.set node true !visited; - match PTree.get node code with - | None -> failwith "No such node" - | Some bb -> [node] @ match (last_element bb) with - | Lop _ | Lload _ | Lgetstack _ | Lsetstack _ | Lstore _ | Lcall _ - | Lbuiltin _ -> assert false - | Ltailcall _ | Lreturn -> [] - | Lbranch n -> dfs_list code [n] - | Lcond (_, _, ifso, ifnot) -> dfs_list code [ifnot; ifso] - | Ljumptable(_, ln) -> dfs_list code ln - end - else [] - in node_dfs @ (dfs_list code ln) - in dfs_list code [entrypoint] - -let enumerate_aux_trace f reach = dfs f.fn_code f.fn_entrypoint -*) - - let forward_sequences code entry = let visited = ref (PTree.map (fun n i -> false) code) in (* returns the list of traversed nodes, and a list of nodes to start traversing next *) @@ -273,12 +246,140 @@ let try_merge code (fs: (BinNums.positive list) list) = done; !seqs -let order_sequences fs = fs +(** Code adapted from Duplicateaux.get_loop_headers + * + * Getting loop branches with a DFS visit : + * Each node is either Unvisited, Visited, or Processed + * pre-order: node becomes Processed + * post-order: node becomes Visited + * + * If we come accross an edge to a Processed node, it's a loop! + *) +type pos = BinNums.positive + +module PP = struct + type t = pos * pos + let compare a b = + let ax, ay = a in + let bx, by = b in + let dx = compare ax bx in + if (dx == 0) then compare ay by + else dx +end + +module PPMap = Map.Make(PP) + +type vstate = Unvisited | Processed | Visited + +let get_loop_edges code entry = + let visited = ref (PTree.map (fun n i -> Unvisited) code) in + let is_loop_edge = ref PPMap.empty + in let rec dfs_visit code from = function + | [] -> () + | node :: ln -> + match (get_some @@ PTree.get node !visited) with + | Visited -> () + | Processed -> begin + let from_node = get_some from in + is_loop_edge := PPMap.add (from_node, node) true !is_loop_edge; + visited := PTree.set node Visited !visited + end + | Unvisited -> begin + visited := PTree.set node Processed !visited; + let bb = get_some @@ PTree.get node code in + let next_visits = (match (last_element bb) with + | Lop _ | Lload _ | Lgetstack _ | Lsetstack _ | Lstore _ | Lcall _ + | Lbuiltin _ -> assert false + | Ltailcall _ | Lreturn -> [] + | Lbranch n -> [n] + | Lcond (_, _, ifso, ifnot) -> [ifso; ifnot] + | Ljumptable(_, ln) -> ln + ) in dfs_visit code (Some node) next_visits; + visited := PTree.set node Visited !visited; + dfs_visit code from ln + end + in begin + dfs_visit code None [entry]; + !is_loop_edge + end + +let ppmap_is_true pp ppmap = PPMap.mem pp ppmap && PPMap.find pp ppmap + +module Int = struct + type t = int + let compare x y = compare x y +end + +module ISet = Set.Make(Int) + +let construct_depmap code entry fs = + let is_loop_edge = get_loop_edges code entry in + let visited = ref (PTree.map (fun n i -> false) code) in + let depmap = Array.map (fun e -> ISet.empty) fs in + let find_index_of_node n = + let index = ref 0 in + begin + Array.iteri (fun i s -> + match List.find_opt (fun e -> e == n) s with + | Some _ -> index := i + | None -> () + ) fs; + !index + end + in let rec dfs_visit code = function + | [] -> () + | node :: ln -> + match (get_some @@ PTree.get node !visited) with + | true -> () + | false -> begin + visited := PTree.set node true !visited; + let bb = get_some @@ PTree.get node code in + let next_visits = + match (last_element bb) with + | Ltailcall _ | Lreturn -> [] + | Lbranch n -> [n] + | Lcond (_, _, ifso, ifnot) -> begin + (if not (ppmap_is_true (node, ifso) is_loop_edge) then + let in_index_fs = find_index_of_node node in + let out_index_fs = find_index_of_node ifso in + depmap.(out_index_fs) <- ISet.add in_index_fs depmap.(out_index_fs) + else + ()); + [ifso; ifnot] + end + | Ljumptable(_, ln) -> begin + let in_index_fs = find_index_of_node node in + List.iter (fun n -> + if not (ppmap_is_true (node, n) is_loop_edge) then + let out_index_fs = find_index_of_node n in + depmap.(out_index_fs) <- ISet.add in_index_fs depmap.(out_index_fs) + else + () + ) ln; + ln + end + (* end of bblocks should not be another value than one of the above *) + | _ -> failwith "last_element gave an invalid output" + in dfs_visit code next_visits + end + in begin + dfs_visit code [entry]; + depmap + end + +let order_sequences code entry fs = + let fs_a = Array.of_list fs in + let depmap = construct_depmap code entry fs_a in + Array.iter (fun _ -> ()) depmap; + (* algo *) + fs let enumerate_aux_trace f reach = - let fs = forward_sequences f.fn_code f.fn_entrypoint - in let ofs = order_sequences fs - in List.flatten ofs + let code = f.fn_code in + let entry = f.fn_entrypoint in + let fs = forward_sequences code entry in + let ofs = order_sequences code entry fs in + List.flatten ofs let enumerate_aux f reach = if !Clflags.option_ftracelinearize then enumerate_aux_trace f reach -- cgit