From 2a0892228575205d5596224c7d73d03e9a3795c6 Mon Sep 17 00:00:00 2001
From: Justus Fasse <justus.fasse@etu.univ-grenoble-alpes.fr>
Date: Tue, 3 Aug 2021 19:56:11 +0200
Subject: Use -flift-if N to control how many instructions may be duplicated
 per

expected cycle gained
---
 scheduling/MyRTLpathScheduleraux.ml | 54 +++++++++++++++++--------------------
 1 file changed, 24 insertions(+), 30 deletions(-)

diff --git a/scheduling/MyRTLpathScheduleraux.ml b/scheduling/MyRTLpathScheduleraux.ml
index 39c77f53..5663c877 100644
--- a/scheduling/MyRTLpathScheduleraux.ml
+++ b/scheduling/MyRTLpathScheduleraux.ml
@@ -868,12 +868,15 @@ let downschedule_compensation_code sb code pm live_renames ~next_free_pc ~next_f
     | "no_move_stores" -> Ignore_liveness
     | _ -> failwith "Unsupported option for scheduling code past side exits"
   in
-  let idealized_schedule_opt = ideal_schedule'' sb code mode in
-  let idealized_schedule =
-    match idealized_schedule_opt with
-    | None -> sb.instructions
-    | Some (schedule, _final_time) -> schedule
-  in
+  match ideal_schedule'' sb code mode, ideal_schedule'' sb code Default with
+  | None, None -> InsertPositionMap.empty (* Early Exit*)
+  | None, Some _ | Some _, None -> failwith "downschedule_compensation_code: Scheduling procedure failed."
+  | Some (idealized_schedule, idealized_final_time)
+  , Some (default_schedule, default_final_time) ->
+  if idealized_final_time = default_final_time then
+    (* Early exit *)
+    InsertPositionMap.empty
+  else
 
   let sb_length = Array.length sb.instructions in
   let pc_to_idx =
@@ -962,32 +965,23 @@ let downschedule_compensation_code sb code pm live_renames ~next_free_pc ~next_f
       InsertPositionMap.empty
   in
   let to_insert_pcs = InsertPositionMap.merge merge_append to_insert_pcs to_insert_as_well in
-  (* TODO: Move out of this function since it can be inferred from to_insert *)
-  let to_rename =
-    InsertPositionMap.to_seq to_insert_pcs
-    |> List.of_seq
-    |> List.map (fun (_side_exit_pc, pcs) ->
-        List.filter_map (fun pc -> RTL.instr_defs @@ get_some @@ PTree.get pc code) pcs )
-    |> List.flatten
-    |> ListLabels.fold_left ~init:Regset.empty ~f:(fun regs r -> Regset.add r regs)
-  in
-  let to_insert =
-    InsertPositionMap.map
-      (fun pcs -> List.map (fun pc -> get_some @@ PTree.get pc code) pcs)
-      to_insert_pcs
-  in
-  let code = InsertPositionMap.fold
-    (fun _pc pcs code ->
-      let code = List.fold_left (fun code pc ->
-        debug "nop'ing pc = %d\n" (Camlcoq.P.to_int pc);
-        PTree.set pc (Inop Camlcoq.P.one) code) code pcs in
-      code )
+  let num_probably_duplicated = InsertPositionMap.fold (fun _pos pcs n ->
+    n + List.length pcs)
     to_insert_pcs
-    code
+    0
   in
-
-  debug_flag := old_debug_flag;
-  to_insert_pcs
+  let gain = default_final_time - idealized_final_time in
+  assert(gain > 0);
+  if gain * !Clflags.option_fliftif < num_probably_duplicated then (
+    debug_flag := false;
+    debug "Expected number of cycles gained, %d, not considered worth the code duplication, expected at %d instructions.\n"
+      gain num_probably_duplicated;
+    debug_flag := old_debug_flag;
+    InsertPositionMap.empty
+  ) else (
+    debug_flag := old_debug_flag;
+    to_insert_pcs
+  )
 
 let my_merge_no_overwrite m1 m2 =
   PTree.combine (fun x y -> match (x, y) with
-- 
cgit