path: root/backend/Duplicateaux.ml

(* *************************************************************)
(*                                                             *)
(*             The Compcert verified compiler                  *)
(*                                                             *)
(*           Sylvain Boulmé     Grenoble-INP, VERIMAG          *)
(*           David Monniaux     CNRS, VERIMAG                  *)
(*           Cyril Six          Kalray                         *)
(*                                                             *)
(*  Copyright Kalray. Copyright VERIMAG. All rights reserved.  *)
(*  This file is distributed under the terms of the INRIA      *)
(*  Non-Commercial License Agreement.                          *)
(*                                                             *)
(* *************************************************************)

(* Oracle for Duplicate pass.
 * - Add static prediction information to Icond nodes
 * - Performs tail duplication on interesting traces to form superblocks
 * - (TODO: perform partial loop unrolling inside innermost loops)
 *)

open RTL
open Maps
open Camlcoq

let debug_flag = ref false

let debug fmt =
  if !debug_flag then Printf.eprintf fmt
  else Printf.ifprintf stderr fmt

let get_some = function
| None -> failwith "Did not get some"
| Some thing -> thing

let rtl_successors = function
| Itailcall _ | Ireturn _ -> []
| Icall(_,_,_,_,n) | Ibuiltin(_,_,_,n) | Inop n | Iop (_,_,_,n)
| Iload (_,_,_,_,_,n) | Istore (_,_,_,_,n) -> [n]
| Icond (_,_,n1,n2,_) -> [n1; n2]
| Ijumptable (_,ln) -> ln

let bfs code entrypoint = begin
  debug "bfs\n";
  let visited = ref (PTree.map (fun n i -> false) code)
  and bfs_list = ref []
  and to_visit = Queue.create ()
  and node = ref entrypoint
  in begin
    Queue.add entrypoint to_visit;
    while not (Queue.is_empty to_visit) do
      node := Queue.pop to_visit;
      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 i ->
            bfs_list := !node :: !bfs_list;
            let succ = rtl_successors i in
            List.iter (fun n -> Queue.add n to_visit) succ
      end
    done;
    List.rev !bfs_list
  end
end

let optbool o = match o with Some _ -> true | None -> false

let ptree_get_some n ptree = get_some @@ PTree.get n ptree

let get_predecessors_rtl code = begin
  debug "get_predecessors_rtl\n";
  let preds = ref (PTree.map (fun n i -> []) code) in
  let process_inst (node, i) =
    let succ = rtl_successors i
    in List.iter (fun s ->
      let previous_preds = ptree_get_some s !preds in
      if optbool @@ List.find_opt (fun e -> e == node) previous_preds then ()
      else preds := PTree.set s (node::previous_preds) !preds) succ
  in begin
    List.iter process_inst (PTree.elements code);
    !preds
  end
end

module PInt = struct
  type t = P.t
  let compare x y = compare (P.to_int x) (P.to_int y)
end

module PSet = Set.Make(PInt)

let print_intlist l =
  let rec f = function
  | [] -> ()
  | n::ln -> (Printf.printf "%d " (P.to_int n); f ln)
  in begin
    if !debug_flag then begin
      Printf.printf "[";
      f l;
      Printf.printf "]"
    end
  end

let print_intset s =
  let seq = PSet.to_seq s
  in begin
    if !debug_flag then begin
      Printf.printf "{";
      Seq.iter (fun n ->
        Printf.printf "%d " (P.to_int n)
      ) seq;
      Printf.printf "}"
    end
  end

type vstate = Unvisited | Processed | Visited

(** 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!
  *)
let get_loop_headers code entrypoint = begin
  debug "get_loop_headers\n";
  let visited = ref (PTree.map (fun n i -> Unvisited) code)
  and is_loop_header = ref (PTree.map (fun n i -> false) code)
  in let rec dfs_visit code = function
  | [] -> ()
  | node :: ln ->
      match (get_some @@ PTree.get node !visited) with
      | Visited -> ()
      | Processed -> begin
          debug "Node %d is a loop header\n" (P.to_int node);
          is_loop_header := PTree.set node true !is_loop_header;
          visited := PTree.set node Visited !visited
        end
      | Unvisited -> begin
          visited := PTree.set node Processed !visited;
          match PTree.get node code with
          | None -> failwith "No such node"
          | Some i -> let next_visits = rtl_successors i in dfs_visit code next_visits;
          visited := PTree.set node Visited !visited;
          dfs_visit code ln
        end
  in begin
    dfs_visit code [entrypoint];
    !is_loop_header
  end
end

let ptree_printbool pt =
  let elements = PTree.elements pt
  in begin
    if !debug_flag then begin
      Printf.printf "[";
      List.iter (fun (n, b) ->
        if b then Printf.printf "%d, " (P.to_int n) else ()
      ) elements;
      Printf.printf "]"
    end
  end

(* Looks ahead (until a branch) to see if a node further down verifies
 * the given predicate *)
let rec look_ahead code node is_loop_header predicate =
  if (predicate node) then true
  else match (rtl_successors @@ get_some @@ PTree.get node code) with
    | [n] -> if (predicate n) then true
        else (
          if (get_some @@ PTree.get n is_loop_header) then false
          else look_ahead code n is_loop_header predicate
        )
    | _ -> false

let do_call_heuristic code cond ifso ifnot is_loop_header =
  begin
    debug "\tCall heuristic..\n";
    let predicate n = (function
    | Icall _ -> true
    | _ -> false) @@ get_some @@ PTree.get n code
    in let ifso_call = look_ahead code ifso is_loop_header predicate
    in let ifnot_call = look_ahead code ifnot is_loop_header predicate
    in if ifso_call && ifnot_call then None
    else if ifso_call then Some false
    else if ifnot_call then Some true
    else None
  end

let do_opcode_heuristic code cond ifso ifnot is_loop_header =
  begin
    debug "\tOpcode heuristic..\n";
    DuplicateOpcodeHeuristic.opcode_heuristic code cond ifso ifnot is_loop_header
  end

let do_return_heuristic code cond ifso ifnot is_loop_header =
  begin
    debug "\tReturn heuristic..\n";
    let predicate n = (function
    | Ireturn _ -> true
    | _ -> false) @@ get_some @@ PTree.get n code
    in let ifso_return = look_ahead code ifso is_loop_header predicate
    in let ifnot_return = look_ahead code ifnot is_loop_header predicate
    in if ifso_return && ifnot_return then None
    else if ifso_return then Some false
    else if ifnot_return then Some true
    else None
  end

let do_store_heuristic code cond ifso ifnot is_loop_header =
  begin
    debug "\tStore heuristic..\n";
    let predicate n = (function
    | Istore _ -> true
    | _ -> false) @@ get_some @@ PTree.get n code
    in let ifso_store = look_ahead code ifso is_loop_header predicate
    in let ifnot_store = look_ahead code ifnot is_loop_header predicate
    in if ifso_store && ifnot_store then None
    else if ifso_store then Some false
    else if ifnot_store then Some true
    else None
  end

let do_loop_heuristic code cond ifso ifnot is_loop_header =
  begin
    debug "\tLoop heuristic..\n";
    let predicate n = get_some @@ PTree.get n is_loop_header in
    let ifso_loop = look_ahead code ifso is_loop_header predicate in
    let ifnot_loop = look_ahead code ifnot is_loop_header predicate in
    if ifso_loop && ifnot_loop then None (* TODO - take the innermost loop ? *)
    else if ifso_loop then Some true
    else if ifnot_loop then Some false
    else None
  end

let do_loop2_heuristic loop_info n code cond ifso ifnot is_loop_header =
  begin
    debug "\tLoop2 heuristic..\n";
    match get_some @@ PTree.get n loop_info with
    | None -> None
    | Some b -> Some b
  end

(* Returns a PTree of either None or Some b where b determines the node following the loop, for a cb instruction *)
(* It uses the fact that loops in CompCert are done by a branch (backedge) instruction followed by a cb *)
let get_loop_info is_loop_header bfs_order code =
  let loop_info = ref (PTree.map (fun n i -> None) code) in
  let mark_path s n =
    let visited = ref (PTree.map (fun n i -> false) code) in
    let rec explore src dest =
      if (get_some @@ PTree.get src !visited) then false
      else if src == dest then true
      else begin
        visited := PTree.set src true !visited;
        match rtl_successors @@ get_some @@ PTree.get src code with
        | [] -> false
        | [s] -> explore s dest
        | [s1; s2] -> (explore s1 dest) || (explore s2 dest)
        | _ -> false
      end
    in let rec advance_to_cb src =
      if (get_some @@ PTree.get src !visited) then None
      else begin
        visited := PTree.set src true !visited;
        match get_some @@ PTree.get src code with
        | Inop s | Iop (_, _, _, s) | Iload (_,_,_,_,_,s) | Istore (_,_,_,_,s) | Icall (_,_,_,_,s)
        | Ibuiltin (_,_,_,s) -> advance_to_cb s
        | Icond _ -> Some src
        | Ijumptable _ | Itailcall _ | Ireturn _ -> None
      end
    in begin
      debug "Marking path from %d to %d\n" (P.to_int n) (P.to_int s);
      match advance_to_cb s with
      | None -> (debug "Nothing found\n")
      | Some s -> ( debug "Advancing to %d\n" (P.to_int s);
          match get_some @@ PTree.get s !loop_info with
          | None | Some _ -> begin
              match get_some @@ PTree.get s code with
              | Icond (_, _, n1, n2, _) ->
                  let b1 = explore n1 n in
                  let b2 = explore n2 n in
                  if (b1 && b2) then (debug "both true\n")
                  else if b1 then (debug "true privileged\n"; loop_info := PTree.set s (Some true) !loop_info)
                  else if b2 then (debug "false privileged\n"; loop_info := PTree.set s (Some false) !loop_info)
                  else (debug "none true\n")
              | _ -> ( debug "not an icond\n" )
            end
          (* | Some _ -> ( debug "already loop info there\n" ) FIXME - we don't know yet whether a branch to a loop head is a backedge or not *)
        )
    end
  in begin
    List.iter (fun n ->
      match get_some @@ PTree.get n code with
      | Inop s | Iop (_,_,_,s) | Iload (_,_,_,_,_,s) | Istore (_,_,_,_,s) | Icall (_,_,_,_,s)
      | Ibuiltin (_, _, _, s) ->
          if get_some @@ PTree.get s is_loop_header then mark_path s n
      | Icond _ -> () (* loop backedges are never Icond in CompCert RTL.3 *)
      | Ijumptable _ -> ()
      | Itailcall _ | Ireturn _ -> ()
    ) bfs_order;
    !loop_info
  end

(* Remark - compared to the original paper, we don't use the store heuristic *)
let get_directions code entrypoint = begin
  debug "get_directions\n";
  let bfs_order = bfs code entrypoint in
  let is_loop_header = get_loop_headers code entrypoint in
  let loop_info = get_loop_info is_loop_header bfs_order code in
  let directions = ref (PTree.map (fun n i -> None) code) in (* None <=> no predicted direction *)
  begin
    (* ptree_printbool is_loop_header; *)
    (* debug "\n"; *)
    List.iter (fun n ->
      match (get_some @@ PTree.get n code) with
      | Icond (cond, lr, ifso, ifnot, _) ->
          (* debug "Analyzing %d.." (P.to_int n); *)
          let heuristics = [ do_opcode_heuristic;
            do_return_heuristic; do_loop2_heuristic loop_info n; do_loop_heuristic; do_call_heuristic;
             (* do_store_heuristic *) ] in
          let preferred = ref None in
          begin
            debug "Deciding condition for RTL node %d\n" (P.to_int n);
            List.iter (fun do_heur ->
              match !preferred with
              | None -> preferred := do_heur code cond ifso ifnot is_loop_header
              | Some _ -> ()
            ) heuristics;
            directions := PTree.set n !preferred !directions;
            (match !preferred with | Some false -> debug "\tFALLTHROUGH\n"
                                   | Some true -> debug "\tBRANCH\n"
                                   | None -> debug "\tUNSURE\n");
            debug "---------------------------------------\n"
          end
      | _ -> ()
    ) bfs_order;
    !directions
  end
end

let update_direction direction = function
| Icond (cond, lr, n, n', _) -> Icond (cond, lr, n, n', 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 (update_direction direction i) (update_direction_rec directions lm)

(* Uses branch prediction to write prediction annotations in Icond *)
let update_directions code entrypoint = begin
  debug "Update_directions\n";
  let directions = get_directions code entrypoint
  in begin
    (* debug "Ifso directions: ";
    ptree_printbool directions;
    debug "\n"; *)
    update_direction_rec directions (PTree.elements code)
  end
end

(** Trace selection *)

let rec exists_false_rec = function
  | [] -> false
  | m::lm -> let (_, b) = m in if b then exists_false_rec lm else true

let exists_false boolmap = exists_false_rec (PTree.elements boolmap)

(* DFS using prediction info to guide the exploration *)
let dfs code entrypoint = begin
  debug "dfs\n";
  let visited = ref (PTree.map (fun n i -> false) code) in
  let rec dfs_list code = function
  | [] -> []
  | node :: ln ->
      if get_some @@ PTree.get node !visited then dfs_list code ln
      else begin
        visited := PTree.set node true !visited;
        let next_nodes = (match get_some @@ PTree.get node code with
        | Icall(_, _, _, _, n) | Ibuiltin (_, _, _, n) | Iop (_, _, _, n)
        | Iload (_, _, _, _, _, n) | Istore (_, _, _, _, n) | Inop n -> [n]
        | Ijumptable (_, ln) -> ln
        | Itailcall _ | Ireturn _ -> []
        | Icond (_, _, n1, n2, info) -> (match info with
          | Some false -> [n2; n1]
          | _ -> [n1; n2]
          )
        ) in node :: dfs_list code (next_nodes @ ln)
      end
  in dfs_list code [entrypoint]
end

let rec select_unvisited_node is_visited = function
| [] -> failwith "Empty list"
| n :: ln -> if not (ptree_get_some n is_visited) then n else select_unvisited_node is_visited ln

let best_successor_of node code is_visited =
  match (PTree.get node code) with
  | None -> failwith "No such node in the code"
  | Some i ->
      let next_node = match i with
      | Inop n | Iop (_,_,_,n) | Iload (_,_,_,_,_,n) | Istore(_,_,_,_,n)
      | Icall (_,_,_,_,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 code order is_visited =
  match (PTree.get node predecessors) with
  | None -> failwith "No predecessor list found"
  | Some lp ->
      try Some (List.find (fun n ->
          if (List.mem n lp) && (not (ptree_get_some n is_visited)) then
            match ptree_get_some n code with
            | Icond (_, _, n1, n2, ob) -> (match ob with
              | None -> false
              | Some false -> n == n2
              | Some true -> n == n1
              )
            | _ -> true
          else false
        ) order)
      with Not_found -> None

let print_trace t = print_intlist t

let print_traces traces =
  let rec f = function
  | [] -> ()
  | t::lt -> Printf.printf "\n\t"; print_trace t; Printf.printf ",\n"; f lt
  in begin
    if !debug_flag then begin
      Printf.printf "Traces: {";
      f traces;
      Printf.printf "}\n";
    end
  end

(* Dumb (but linear) trace selection *)
let select_traces_linear code entrypoint =
  let is_visited = ref (PTree.map (fun n i -> false) code) in
  let bfs_order = bfs code entrypoint in
  let rec go_through node = begin
    is_visited := PTree.set node true !is_visited;
    let next_node = match (get_some @@ PTree.get node code) with
      | Icall(_, _, _, _, n) | Ibuiltin (_, _, _, n) | Iop (_, _, _, n)
      | Iload (_, _, _, _, _, n) | Istore (_, _, _, _, n) | Inop n -> Some n
      | Ijumptable _ | Itailcall _ | Ireturn _ -> None
      | Icond (_, _, n1, n2, info) -> (match info with
        | Some false -> Some n2
        | Some true -> Some n1
        | None -> None
        )
    in match next_node with
    | None -> [node]
    | Some n ->
        if not (get_some @@ PTree.get n !is_visited) then node :: go_through n
        else [node]
    end
  in let traces = ref [] in begin
    List.iter (fun n ->
      if not (get_some @@ PTree.get n !is_visited) then
        traces := (go_through n) :: !traces
    ) bfs_order;
    !traces
  end


(* Algorithm mostly inspired from Chang and Hwu 1988
 * "Trace Selection for Compiling Large C Application Programs to Microcode" *)
let select_traces_chang code entrypoint = begin
  debug "select_traces\n";
  let order = dfs code entrypoint 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 *)
    debug "Length: %d\n" (List.length order);
    while exists_false !is_visited do (* while (there are unvisited nodes) *)
      let seed = select_unvisited_node !is_visited order in
      let trace = ref [seed] in
      let current = ref seed in begin
        is_visited := PTree.set seed true !is_visited; (* mark seed visited *)
        let quit_loop = ref false in begin
          while not !quit_loop do
            let s = best_successor_of !current code !is_visited in
            match s with
            | None -> quit_loop := true (* if (s==0) exit loop *)
            | Some succ -> begin
                trace := !trace @ [succ];
                is_visited := PTree.set succ true !is_visited; (* mark s visited *)
                current := succ
                end
          done;
          current := seed;
          quit_loop := false;
          while not !quit_loop do
            let s = best_predecessor_of !current predecessors code order !is_visited in
            match s with
            | None -> quit_loop := true (* if (s==0) exit loop *)
            | Some pred -> begin
                trace := pred :: !trace;
                is_visited := PTree.set pred true !is_visited; (* mark s visited *)
                current := pred
                end
          done;
          traces := !trace :: !traces;
        end
      end
    done;
    (* debug "DFS: \t"; print_intlist order; debug "\n"; *)
    debug "Traces: "; print_traces !traces;
    !traces
  end
end

let select_traces code entrypoint =
  let length = List.length @@ PTree.elements code in
  if (length < 5000) then select_traces_chang code entrypoint
  else select_traces_linear code entrypoint

let rec make_identity_ptree_rec = function
| [] -> PTree.empty
| m::lm -> let (n, _) = m in PTree.set n n (make_identity_ptree_rec lm)

let make_identity_ptree code = make_identity_ptree_rec (PTree.elements code)

(* Change the pointers of preds nodes to point to n' instead of n *)
let rec change_pointers code n n' = function
  | [] -> code
  | pred :: preds ->
      let new_pred_inst = match ptree_get_some pred code with
        | Icall(a, b, c, d, n0) -> assert (n0 == n); Icall(a, b, c, d, n')
        | Ibuiltin(a, b, c, n0) -> assert (n0 == n); Ibuiltin(a, b, c, n')
        | Ijumptable(a, ln) -> assert (optbool @@ List.find_opt (fun e -> e == n) ln);
                               Ijumptable(a, List.map (fun e -> if (e == n) then n' else e) ln)
        | Icond(a, b, n1, n2, i) -> assert (n1 == n || n2 == n);
                                 let n1' = if (n1 == n) then n' else n1
                                 in let n2' = if (n2 == n) then n' else n2
                                 in Icond(a, b, n1', n2', i)
        | Inop n0 -> assert (n0 == n); Inop n'
        | Iop (a, b, c, n0) -> assert (n0 == n); Iop (a, b, c, n')
        | Iload (a, b, c, d, e, n0) -> assert (n0 == n); Iload (a, b, c, d, e, n')
        | Istore (a, b, c, d, n0) -> assert (n0 == n); Istore (a, b, c, d, n')
        | Itailcall _ | Ireturn _ -> failwith "That instruction cannot be a predecessor"
      in let new_code = PTree.set pred new_pred_inst code
      in change_pointers new_code n n' preds

(* parent: parent of n to keep as parent
 * preds: all the other parents of n
 * n': the integer which should contain the duplicate of n
 * returns: new code, new ptree *)
let duplicate code ptree parent n preds n' =
  debug "Duplicating node %d into %d..\n" (P.to_int n) (P.to_int n');
  match PTree.get n' code with
  | Some _ -> failwith "The PTree already has a node n'"
  | None ->
      let c' = change_pointers code n n' preds
      in let new_code = PTree.set n' (ptree_get_some n code) c'
      and new_ptree = PTree.set n' n ptree
      in (new_code, new_ptree)

let rec maxint = function
  | [] -> 0
  | i :: l -> assert (i >= 0); let m = maxint l in if i > m then i else m

let is_empty = function
  | [] -> true
  | _ -> false

(* code: RTL code
 * preds: mapping node -> predecessors
 * ptree: the revmap
 * trace: the trace to follow tail duplication on *)
let tail_duplicate code preds ptree trace =
  (* next_int: unused integer that can be used for the next duplication *)
  let next_int = ref (maxint (List.map (fun e -> let (n, _) = e in P.to_int n) (PTree.elements code)) + 1)
  (* last_node and last_duplicate store resp. the last processed node of the trace, and its duplication *)
  in let last_node = ref None
  in let last_duplicate = ref None
  in let nb_duplicated = ref 0
  (* recursive function on a trace *)
  in let rec f code ptree is_first = function
    | [] -> (code, ptree)
    | n :: t ->
        let (new_code, new_ptree) =
          if is_first then (code, ptree) (* first node is never duplicated regardless of its inputs *)
          else
            let node_preds = ptree_get_some n preds
            in let node_preds_nolast = List.filter (fun e -> e <> get_some !last_node) node_preds
            in let final_node_preds = match !last_duplicate with
              | None -> node_preds_nolast
              | Some n' -> n' :: node_preds_nolast
            in if not (is_empty final_node_preds) then
              let n' = !next_int
              in let (newc, newp) = duplicate code ptree !last_node n final_node_preds (P.of_int n')
              in begin
                next_int := !next_int + 1;
                nb_duplicated := !nb_duplicated + 1;
                last_duplicate := Some (P.of_int n');
                (newc, newp)
              end
            else (code, ptree)
        in begin
          last_node := Some n;
          f new_code new_ptree false t
        end
  in let new_code, new_ptree = f code ptree true trace
  in (new_code, new_ptree, !nb_duplicated)

let superblockify_traces code preds traces =
  let max_nb_duplicated = !Clflags.option_fduplicate (* FIXME - should be architecture dependent *)
  in let ptree = make_identity_ptree code
  in let rec f code ptree = function
    | [] -> (code, ptree, 0)
    | trace :: traces ->
        let new_code, new_ptree, nb_duplicated = tail_duplicate code preds ptree trace
        in if (nb_duplicated < max_nb_duplicated)
          then (debug "End duplication\n"; f new_code new_ptree traces)
          else (debug "Too many duplicated nodes, aborting tail duplication\n"; (code, ptree, 0))
  in let new_code, new_ptree, _ = f code ptree traces
  in (new_code, new_ptree)

let rec invert_iconds_trace code = function
  | [] -> code
  | n :: ln ->
      let code' = match ptree_get_some n code with
        | Icond (c, lr, ifso, ifnot, info) -> (match info with
            | Some true -> begin
                (* debug "Reversing ifso/ifnot for node %d\n" (P.to_int n); *)
                PTree.set n (Icond (Op.negate_condition c, lr, ifnot, ifso, Some false)) code
              end
            | _ -> code)
        | _ -> code
      in invert_iconds_trace code' ln

let rec invert_iconds code = function
  | [] -> code
  | t :: ts ->
      let code' = if !Clflags.option_finvertcond then invert_iconds_trace code t
                  else code
      in invert_iconds code' ts

let duplicate_aux f =
  let entrypoint = f.fn_entrypoint in
  if !Clflags.option_fduplicate < 0 then
    ((f.fn_code, entrypoint), make_identity_ptree f.fn_code)
  else
    let code = update_directions (f.fn_code) 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
      let (new_code, pTreeId) = ((* print_traces traces; *) superblockify_traces icond_code preds traces) in
      ((new_code, f.fn_entrypoint), pTreeId)
    else
      ((icond_code, entrypoint), make_identity_ptree code)