[BROKEN] Some progress, need to figure out conversion HashedPSet -> List

1 files changed, 111 insertions, 14 deletions

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index fe062e73..b54ac5dc 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -484,11 +484,11 @@ let rec make_identity_ptree_rec = function
 
 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 *)
+(* Change the pointers of 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
+  | node :: nodes ->
+      let new_pred_inst = match ptree_get_some node 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);
@@ -502,8 +502,8 @@ let rec change_pointers code n n' = function
         | 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
+      in let new_code = PTree.set node new_pred_inst code
+      in change_pointers new_code n n' nodes
 
 (* parent: parent of n to keep as parent
  * preds: all the other parents of n
@@ -527,13 +527,15 @@ let is_empty = function
   | [] -> true
   | _ -> false
 
+let next_free_pc code = maxint (List.map (fun e -> let (n, _) = e in P.to_int n) (PTree.elements code)) + 1
+
 (* 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)
+  let next_int = ref (next_free_pc code)
   (* 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
@@ -567,9 +569,8 @@ let tail_duplicate code preds ptree trace =
   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 superblockify_traces code preds traces ptree =
   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 ->
@@ -652,27 +653,123 @@ let get_inner_loops f =
     ) all_loops
   end
 
-let unroll_inner_loops f =
+let generate_fwmap ln ln' =
+  let rec f ln ln' fwmap =
+    match ln with
+    | [] -> begin
+        match ln' with
+        | [] -> fwmap
+        | _ -> failwith "ln and ln' have different lengths"
+      end
+    | n :: ln -> begin
+        match ln' with
+        | n' :: ln' -> f ln ln' (PTree.set n n' fwmap)
+        | _ -> failwith "ln and ln' have different lengths"
+      end
+  in f ln ln' PTree.empty
+
+let generate_revmap ln ln' = generate_fwmap ln' ln
+
+let apply_map fw n = P.of_int @@ ptree_get_some n fw
+
+let change_nexts fwmap = function
+  | Icall (a, b, c, d, n) -> Icall (a, b, c, d, apply_map fwmap n)
+  | Ibuiltin (a, b, c, n) -> Ibuiltin (a, b, c, apply_map fwmap n)
+  | Ijumptable (a, ln) -> Ijumptable (a, List.map (apply_map fwmap) ln)
+  | Icond (a, b, n1, n2, i) -> Icond (a, b, apply_map fwmap n1, apply_map fwmap n2, i)
+  | Inop n -> Inop (apply_map fwmap n)
+  | Iop (a, b, c, n) -> Iop (a, b, c, apply_map fwmap n)
+  | Iload (a, b, c, d, e, n) -> Iload (a, b, c, d, e, apply_map fwmap n)
+  | Istore (a, b, c, d, n) -> Istore (a, b, c, d, apply_map fwmap n)
+  | Itailcall (a, b, c) -> Itailcall (a, b, c)
+  | Ireturn o -> Ireturn o
+
+(* let change_single_next n' = function
+  | Icall (a, b, c, d, n) -> Icall (a, b, c, d, n')
+  | Ibuiltin (a, b, c, n) -> Ibuiltin (a, b, c, n')
+  | Inop n -> Inop n'
+  | Iop (a, b, c, n) -> Iop (a, b, c, n')
+  | Iload (a, b, c, d, e, n) -> Iload (a, b, c, d, e, n')
+  | Istore (a, b, c, d, n) -> Istore (a, b, c, d, n')
+  | _ -> failwith "Not an instruction with single successor"
+  *)
+
+(** Clone a list of instructions into free pc indexes
+ *
+ * The list of instructions should be contiguous, and not include any loop.
+ * It is assumed that the first instruction of the list is the head.
+ * Also, the last instruction of the list should be the loop backedge.
+ *
+ * Returns: (code', revmap', ln', fwmap)
+ *  code' is the updated code, after cloning
+ *  revmap' is the updated revmap
+ *  ln' is the list of the new indexes used to reference the cloned instructions
+ *  fwmap is a map from ln to ln'
+ *)
+let clone code revmap ln = begin
+  assert (List.length ln > 0);
+  let head' = next_free_pc code in
+  let head = P.to_int @@ List.hd ln in
+  let ln' = List.map (fun n -> n + (head' - head)) @@ List.map P.to_int ln in
+  let fwmap = generate_fwmap ln ln' in
+  let revmap' = generate_revmap ln (List.map P.of_int ln') in
+  let code' = ref code in
+  List.iter (fun n ->
+    let instr = get_some @@ PTree.get n code in
+    let instr' = change_nexts fwmap instr in
+    code' := PTree.set (apply_map fwmap n) instr' !code'
+  ) ln;
+  (!code', revmap', ln')
+end
+
+(** Unrolls a single interation of the inner loop
+ * 1) Clones the body into body'
+ * 2) Links the preds to the first instruction of body'
+ * 3) Links the last instruction of body' into the first instruction of body
+ *)
+(** FIXME - we expect a list, not a hashed PSet!
+ * Either we need a notion of first element / last element
+ * Or we need to explicitly label the head and final instructions of the inner loop
+ *)
+let unroll_inner_loop_single code revmap iloop =
+  let (code2, revmap2, dupbody, fwmap) = clone code revmap (iloop.body) in
+  let code' = ref code2 in
+  let first_n = List.hd (iloop.body) in
+  let first_n' = List.hd dupbody in
+  let last_n' = List.hd @@ List.rev dupbody in
+  begin
+    code' := change_pointers !code' first_n first_n' (iloop.preds);
+    code' := change_pointers !code' first_n' first_n [last_n'];
+    (* code' := PTree.set last_n' (change_single_next first_n @@ ptree_get_some last_n' !code') !code' *)
+    (!code', revmap2)
+  end
+  
+let unroll_inner_loops_single f revmap =
   let inner_loops = get_inner_loops f in
+  let code' = ref f.fn_code in
+  let revmap' = ref revmap in
   begin
-    debug_flag := true;
     print_inner_loops inner_loops;
-    debug_flag := false;
+    List.iter (fun iloop ->
+      let (new_code, new_revmap) = unroll_inner_loop_single !code' !revmap' iloop in
+      code' := new_code; revmap' := new_revmap
+    ) inner_loops;
+    (!code', !revmap')
   end
 
 let duplicate_aux f =
   begin
-    unroll_inner_loops 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 (code, revmap) = unroll_inner_loops_single f (make_identity_ptree code) in
+      let code = update_directions 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
+        let (new_code, pTreeId) = superblockify_traces icond_code preds traces revmap in
         ((new_code, f.fn_entrypoint), pTreeId)
       else
         ((icond_code, entrypoint), make_identity_ptree code)