Simplification of the Linearize heuristic (same result functionally)

1 files changed, 6 insertions, 216 deletions

diff --git a/backend/Linearizeaux.ml b/backend/Linearizeaux.ml
index 402e376d..5914f6a3 100644
--- a/backend/Linearizeaux.ml
+++ b/backend/Linearizeaux.ml
@@ -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