Commit f7365bc7 by Cyril SIX

### Simplification of the Linearize heuristic (same result functionally)

parent 67cfb5b6
 ... ... @@ -126,6 +126,10 @@ let enumerate_aux_flat f reach = * This is a slight alteration to the above heuristic, ensuring that any * superblock will be contiguous in memory, while still following the original * heuristic * * Slight change: instead of taking the minimum pc of the superblock, we just take * the pc of the first block. * (experimentally this leads to slightly better performance..) *) let super_blocks f joins = ... ... @@ -139,13 +143,11 @@ let super_blocks f joins = let npc = P.to_int pc in if not (IntSet.mem npc !visited) then begin visited := IntSet.add npc !visited; in_block [] max_int pc in_block [] npc pc end (* in_block: add pc to block and check successors *) and in_block blk minpc pc = let npc = P.to_int pc in let blk = pc :: blk in let minpc = min npc minpc in match PTree.get pc f.fn_code with | None -> assert false | Some b -> ... ... @@ -182,218 +184,6 @@ let super_blocks f joins = let enumerate_aux_sb f reach = flatten_blocks (super_blocks f (join_points f)) (** * Alternate enumeration based on traces as identified by Duplicate.v * * This is a slight alteration to the above heuristic, ensuring that any * superblock will be contiguous in memory, while still following the original * heuristic *) let get_some = function | None -> failwith "Did not get some" | Some thing -> thing exception EmptyList let rec last_element = function | [] -> raise EmptyList | e :: [] -> e | e' :: e :: l -> last_element (e::l) let print_plist l = let rec f = function | [] -> () | n :: l -> Printf.printf "%d, " (P.to_int n); f l in begin if !debug_flag then begin Printf.printf "["; f l; Printf.printf "]" end end (* adapted from the above join_points function, but with PTree *) let get_join_points code entry = let reached = ref (PTree.map (fun n i -> false) code) in let reached_twice = ref (PTree.map (fun n i -> false) code) in let rec traverse pc = if get_some @@ PTree.get pc !reached then begin if not (get_some @@ PTree.get pc !reached_twice) then reached_twice := PTree.set pc true !reached_twice end else begin reached := PTree.set pc true !reached; traverse_succs (successors_block @@ get_some @@ PTree.get pc code) end and traverse_succs = function | [] -> () | [pc] -> traverse pc | pc :: l -> traverse pc; traverse_succs l in traverse entry; !reached_twice let forward_sequences code entry = let visited = ref (PTree.map (fun n i -> false) code) in let join_points = get_join_points code entry in (* returns the list of traversed nodes, and a list of nodes to start traversing next *) let rec traverse_fallthrough code node = (* debug "Traversing %d..\n" (P.to_int node); *) 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 -> let ln, rem = match (last_element bb) with | Lop _ | Lload _ | Lgetstack _ | Lsetstack _ | Lstore _ | Lcall _ | Lbuiltin _ -> assert false | Ltailcall _ | Lreturn -> begin (* debug "STOP tailcall/return\n"; *) ([], []) end | Lbranch n -> if get_some @@ PTree.get n join_points then ([], [n]) else let ln, rem = traverse_fallthrough code n in (ln, rem) | Lcond (_, _, ifso, ifnot, info) -> (match info with | None -> begin (* debug "STOP Lcond None\n"; *) ([], [ifso; ifnot]) end | Some false -> if get_some @@ PTree.get ifnot join_points then ([], [ifso; ifnot]) else let ln, rem = traverse_fallthrough code ifnot in (ln, [ifso] @ rem) | Some true -> if get_some @@ PTree.get ifso join_points then ([], [ifso; ifnot]) else let ln, rem = traverse_fallthrough code ifso in (ln, [ifnot] @ rem) ) | Ljumptable(_, ln) -> begin (* debug "STOP Ljumptable\n"; *) ([], ln) end in ([node] @ ln, rem) end else ([], []) in let rec f code = function | [] -> [] | node :: ln -> let fs, rem_from_node = traverse_fallthrough code node in [fs] @ ((f code rem_from_node) @ (f code ln)) in (f code [entry]) 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 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 print_iset s = begin if !debug_flag then begin Printf.printf "{"; ISet.iter (fun e -> Printf.printf "%d, " e) s; Printf.printf "}" end end let print_sequence s = if !debug_flag then begin Printf.printf "["; List.iter (fun n -> Printf.printf "%d, " (P.to_int n)) s; Printf.printf "]\n" end let print_ssequence ofs = if !debug_flag then begin Printf.printf "["; List.iter (fun s -> print_sequence s) ofs; Printf.printf "]\n" end let rec minpc_of l = match l with | [] -> None | e::l -> begin let e_score = P.to_int e in let mpc = minpc_of l in match mpc with | None -> Some e_score | Some e_score' -> if e_score < e_score' then Some e_score else Some e_score' end let order_sequences code entry fs = let fs_a = Array.of_list fs in let fs_evaluated = Array.map (fun e -> false) fs_a in let ordered_fs = ref [] in let evaluate s_id = begin assert (not fs_evaluated.(s_id)); ordered_fs := fs_a.(s_id) :: !ordered_fs; fs_evaluated.(s_id) <- true end in let choose_best_of candidates = let current_best_id = ref None in let current_best_score = ref None in begin List.iter (fun id -> match !current_best_id with | None -> begin current_best_id := Some id; match fs_a.(id) with | [] -> current_best_score := None | n::l -> current_best_score := Some (P.to_int n) end | Some b -> begin match fs_a.(id) with | [] -> () | n::l -> let nscore = P.to_int n in match !current_best_score with | None -> (current_best_id := Some id; current_best_score := Some nscore) | Some bs -> if nscore > bs then (current_best_id := Some id; current_best_score := Some nscore) end ) candidates; !current_best_id end in let select_next () = let candidates = ref [] in begin Array.iteri (fun i _ -> begin if (not fs_evaluated.(i)) then candidates := i :: !candidates end ) fs_a; if not (List.length !candidates > 0) then begin Array.iteri (fun i _ -> if (not fs_evaluated.(i)) then candidates := i :: !candidates ) fs_a; end; get_some (choose_best_of !candidates) end in begin debug "-------------------------------\n"; debug "forward sequences identified: "; print_ssequence fs; while List.length !ordered_fs != List.length fs do let next_id = select_next () in evaluate next_id done; debug "forward sequences ordered: "; print_ssequence (List.rev (!ordered_fs)); List.rev (!ordered_fs) end let enumerate_aux_trace f reach = 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 if !Clflags.option_ftracelinearize then enumerate_aux_sb f reach else enumerate_aux_flat f reach
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!