Make it possible to only rename select registers

Not used yet.

1 files changed, 35 insertions, 24 deletions

diff --git a/scheduling/MyRTLpathScheduleraux.ml b/scheduling/MyRTLpathScheduleraux.ml
index bae1863c..5bc63798 100644
--- a/scheduling/MyRTLpathScheduleraux.ml
+++ b/scheduling/MyRTLpathScheduleraux.ml
@@ -85,7 +85,7 @@ let change_dest_reg inst fwmap =
   | Iop(op, args, res, s) -> Iop(op, args, (apply_map' fwmap res), s)
   | Iload(trap, chunk, addr, args, dst, s) -> Iload(trap, chunk, addr, args, (apply_map' fwmap dst), s)
 
-let maybe_change_dest_reg inst fwmap ~next_free_reg =
+let maybe_change_dest_reg ?only_rename inst fwmap ~next_free_reg =
   let do_nothing = (inst, fwmap, next_free_reg) in
   match inst with
   | Icall _
@@ -97,13 +97,15 @@ let maybe_change_dest_reg inst fwmap ~next_free_reg =
     match RTL.instr_defs i with
     | None -> do_nothing
     | Some r ->
-      (match PTree.get r fwmap with
-       | None -> (i, PTree.set r r fwmap, next_free_reg)
-       | Some _previous_name ->
-          let new_name = next_free_reg in
-          let fwmap = PTree.set r new_name fwmap in
-          (change_dest_reg i fwmap, fwmap, Camlcoq.P.succ next_free_reg)
-      )
+      if Option.is_some only_rename && not (Regset.mem r (get_some only_rename)) then
+        do_nothing
+      else
+        (match PTree.get r fwmap with
+        | None -> (i, PTree.set r r fwmap, next_free_reg)
+        | Some _previous_name ->
+            let new_name = next_free_reg in
+            let fwmap = PTree.set r new_name fwmap in
+            (change_dest_reg i fwmap, fwmap, Camlcoq.P.succ next_free_reg) )
 
 let ptree_get_or_default ptree key default =
   match PTree.get key ptree with
@@ -238,27 +240,18 @@ let update_live_renames pc live_renames fwmap regs =
   regs
   live_renames
 
-(* Pass over the superblock instruction in-order
- * For each redefinition of a register, create a new register name and use that one from
- * then on. There is one exception, if the last instruction defines a register, it will be
- * left unchanged since the rest of the path cannot possibly use it.
- * WARNING: This invalidates the superblock, it will need to be repaired with the
- * information returned. *)
-let local_single_assignment sb code liveatentry ~next_free_reg =
+let rename_regs ?only_rename sb code ~liveatentry ~next_free_reg =
   let old_debug_flag = !debug_flag in
 
   let length = Array.length sb.instructions in
   assert (length > 0);
   (* The last instruction is treated in a special way because if it defines a register,
-   * that register cannot possibly be used afterwards in the path AND often we cannot
-   * insert restoration code later after it since it must remain at the end of the path.
-   * In the future, this may be resolved by only renaming registers which are used
-   * afterwards in path, which would exclude the register possibly assigned by the last
-   * instruction. *)
+    * that register cannot possibly be used afterwards in the path AND often we cannot
+    * insert restoration code later after it since it must remain at the end of the path.
+    * In the future, this may be resolved by only renaming registers which are used
+    * afterwards in path, which would exclude the register possibly assigned by the last
+    * instruction. *)
   let last_pc = sb.instructions.(length - 1) in
-  (* I wish OCaml just had a proper (persistent) "vector" type in the standard library as
-   * well as slices/views.
-   * This should probably be rewritten to use indices in order to avoid the array copy. *)
   let upto_last = Array.init (length - 1) (fun i -> sb.instructions.(i)) in
   let liveatentry = Regset.elements liveatentry in
   let fwmap = Duplicateaux.generate_fwmap liveatentry liveatentry PTree.empty in
@@ -270,7 +263,9 @@ let local_single_assignment sb code liveatentry ~next_free_reg =
       (* Rewrite instruction to use potentially renamed registers *)
       let inst = get_some @@ PTree.get pc code in
       let inst = change_arg_regs inst fwmap in
-      let (inst, fwmap, next_free_reg) = maybe_change_dest_reg inst fwmap ~next_free_reg in
+      let (inst, fwmap, next_free_reg) =
+        maybe_change_dest_reg ?only_rename inst fwmap ~next_free_reg
+      in
       let code = PTree.set pc inst code in
 
       let live_renames =
@@ -294,6 +289,22 @@ let local_single_assignment sb code liveatentry ~next_free_reg =
 
   (code, live_renames, next_free_reg)
 
+(* Pass over the superblock instruction in-order
+ * For each redefinition of a register, create a new register name and use that one from
+ * then on. There is one exception, if the last instruction defines a register, it will be
+ * left unchanged since the rest of the path cannot possibly use it.
+ * WARNING: This invalidates the superblock, it will need to be repaired with the
+ * information returned. *)
+let local_single_assignment sb code liveatentry ~next_free_reg =
+  let old_debug_flag = !debug_flag in
+
+  let (code, live_renames, next_free_reg) =
+    rename_regs sb code ~liveatentry ~next_free_reg
+  in
+
+  debug_flag := old_debug_flag;
+  (code, live_renames, next_free_reg)
+
 let restoration_instructions live_renames =
   let to_insert =
     PTree.map