Adjust "main" function of this pass to the previous changes.

NB: Currently, the code motion past side exits logic assumes that poor
man's SSA is turned on.

1 files changed, 57 insertions, 29 deletions

diff --git a/scheduling/MyRTLpathScheduleraux.ml b/scheduling/MyRTLpathScheduleraux.ml
index 808e823d..0f014fdb 100644
--- a/scheduling/MyRTLpathScheduleraux.ml
+++ b/scheduling/MyRTLpathScheduleraux.ml
@@ -1191,7 +1191,7 @@ let scheduler f =
     ~init:([], code, pm, next_free_pc)
     ~f:(fun (superblocks, code, pm, next_free_pc) sb ->
       let to_insert = prepend_nops_before_iconds sb code in
-      let (sb', code', pm', next_free_pc') = insert_code sb code pm to_insert ~next_free_pc in
+      let (sb', code', pm', next_free_pc', _) = insert_code sb code pm to_insert ~next_free_pc in
       (sb'::superblocks, code', pm', next_free_pc') )
   in
   debug "After adding nops before Iconds.\n";
@@ -1223,48 +1223,76 @@ let scheduler f =
   debug "\n";
   flush_all ();
 
-  let sb_renamings_insts =
-    ListLabels.map sb_renamings
-    ~f:(fun (sb, live_renames) ->
-      (* Instructions which need to be inserted to make the superblock legal again *)
-      let to_insert_restoration = restoration_instructions live_renames in
-      (sb, live_renames, to_insert_restoration) )
-  in
+  (* TODO: Insert final restoration code before downschedule_compensation_code *)
 
   (* WARNING: mutation *)
   let code = ref code in
-  let sb_toinsert_torename =
-    ListLabels.map sb_renamings_insts
-    ~f:(fun (sb, live_renames, to_insert) ->
-      let (to_insert_compensation, to_rename, code') =
+  let sb_tocompensate_liverenames =
+    ListLabels.map sb_renamings
+    ~f:(fun (sb, live_renames) ->
+      let (to_insert_compensation, _to_rename, code') =
         if !Clflags.option_prepass_past_side_exits then
           downschedule_compensation_code sb !code pm live_renames ~next_free_pc ~next_free_reg
         else
           (InsertPositionMap.empty, Regset.empty, !code)
         in
       code := code';
-      let to_insert = InsertPositionMap.merge merge_append to_insert_compensation to_insert in
-      (sb, to_insert, to_rename) )
+      (sb, to_insert_compensation, live_renames) )
   in
   let code = !code in
 
-  (* Insert the compensation code (downward scheduling) and restoration code (register
-   * renaming). *)
-  let (superblocks_torename, code, pm, next_free_pc) = ListLabels.fold_left sb_toinsert_torename
+  (* Insert the compensation code (downward scheduling) and update the restoration code
+   * information to reflect the new pcs. *)
+  let (superblocks_liverenames, code, pm, next_free_pc) = ListLabels.fold_left sb_tocompensate_liverenames
     ~init:([], code, pm, next_free_pc)
-    ~f:(fun (sbs, code, pm, next_free_pc) (sb, to_insert, to_rename) ->
-      let (sb, code, pm, next_free_pc) = insert_code sb code pm to_insert ~next_free_pc in
-      ((sb, to_rename)::sbs, code, pm, next_free_pc) )
+    ~f:(fun (sbs, code, pm, next_free_pc) (sb, to_insert_compensation, live_renames) ->
+      let (sb, code, pm, next_free_pc, fwmap) = insert_code sb code pm to_insert_compensation ~next_free_pc in
+      let live_renames =
+        PTree.fold
+          (fun acc pc insts ->
+            let pc' = apply_map' fwmap pc in
+            PTree.set pc' insts acc)
+          live_renames
+          PTree.empty
+      in
+      ((sb, live_renames)::sbs, code, pm, next_free_pc) )
   in
 
-  debug "After inserting compensation and restoration code:\n";
-  print_code code;
-  print_path_map pm;
+  debug "After inserting the compensation code:\n";
+  (* print_code code; *)
+  (* print_path_map pm; *)
+  print_superblocks (fst @@ List.split superblocks_liverenames) code;
+  debug "\n"; flush_all ();
+
+  (* Insert the restoration code *)
+   let (superblocks, code, pm, next_free_pc, next_free_reg) = ListLabels.fold_left superblocks_liverenames
+   ~init:([], code, pm, next_free_pc, next_free_reg)
+   ~f:(fun (sbs, code, pm, next_free_pc, next_free_reg) (sb, live_renames) ->
+    let pc_to_idx = Duplicateaux.generate_fwmap
+      (Array.to_list sb.instructions)
+      (List.init (Array.length sb.instructions) (fun i -> i))
+      PTree.empty
+   in
+    let (to_insert_restoration, to_rename, next_free_reg) = restoration_instructions' live_renames ~next_free_reg in
+    let code = PTree.fold
+      (fun code side_exit_pc aliases ->
+        let idx = apply_map' pc_to_idx side_exit_pc in
+        let code = rename_regs sb code aliases ~offset:idx in
+        code)
+      to_rename
+      code
+    in
+    let (sb, code, pm, next_free_pc, _fwmap) = insert_code sb code pm to_insert_restoration ~next_free_pc in
+    (sb::sbs, code, pm, next_free_pc, next_free_reg) )
+  in
+
+  debug "After inserting the restoration code:\n";
+  (* print_code code; *)
+  (* print_path_map pm; *)
   print_superblocks superblocks code;
-  debug "\n";
-  flush_all ();
+  debug "\n"; flush_all ();
 
-  let (superblocks, code, pm, next_free_pc, next_free_reg) =
+  (* let (superblocks, code, pm, next_free_pc, next_free_reg) =
     if not !Clflags.option_fpoormansssa then (
       (* In principle we need to do something like this because if we do not systematically
        * rename registers, the downward scheduling might copy a series of instructions like
@@ -1280,10 +1308,10 @@ let scheduler f =
         let restoration_insts = restoration_instructions live_renames in
         let (sb, code, pm, next_free_pc) = insert_code sb code pm restoration_insts ~next_free_pc in
         (sb::sbs, code, pm, next_free_pc, next_free_reg) ) *)
-      (fst @@ List.split superblocks_torename, code, pm, next_free_pc, next_free_reg)
+      (fst @@ List.split superblocks_torestore, code, pm, next_free_pc, next_free_reg)
     ) else
-      (fst @@ List.split superblocks_torename, code, pm, next_free_pc, next_free_reg)
-  in
+      (fst @@ List.split superblocks_torestore, code, pm, next_free_pc, next_free_reg)
+  in *)
 
   let (code, to_lift) =
     if !Clflags.option_fliftif > 0 then