Vous avez reçu un message "Your GitLab account has been locked ..." ? Pas d'inquiétude : lisez cet article https://docs.gricad-pages.univ-grenoble-alpes.fr/help/unlock/

Commit f7365bc7 authored by Cyril SIX's avatar Cyril SIX
Browse files

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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment