prepass reordering activated

2 files changed, 36 insertions, 12 deletions

diff --git a/kvx/lib/PrepassSchedulingOracle.ml b/kvx/lib/PrepassSchedulingOracle.ml
index 14239ed2..eec2d9b5 100644
--- a/kvx/lib/PrepassSchedulingOracle.ml
+++ b/kvx/lib/PrepassSchedulingOracle.ml
@@ -24,6 +24,7 @@ let get_simple_dependencies (seqa : instruction array) =
   and last_reg_write : (int*int) PTree.t ref = ref PTree.empty
   and last_mem_reads : int list ref = ref []
   and last_mem_write : int option ref = ref None
+  and last_branch : int option ref = ref None
   and latency_constraints : latency_constraint list ref = ref [] in
   let add_constraint instr_from instr_to latency =
     assert (instr_from <= instr_to);
@@ -111,7 +112,14 @@ let get_simple_dependencies (seqa : instruction array) =
     | BA_splitlong(hi, lo) -> add_builtin_arg i hi;
                               add_builtin_arg i lo
     | BA_addptr(a1, a2) -> add_builtin_arg i a1;
-                           add_builtin_arg i a2
+                           add_builtin_arg i a2 in
+  let irreversible_action i =
+    match !last_branch with
+    | None -> ()
+    | Some j -> add_constraint j i 1 in
+  let set_branch i =
+    irreversible_action i;
+    last_branch := Some i
   in
   Array.iteri
     begin
@@ -126,10 +134,12 @@ let get_simple_dependencies (seqa : instruction array) =
          add_input_regs i addr_regs;
          add_output_reg i (latency_of_load trap chunk addressing (List.length addr_regs)) output
       | Istore(chunk, addressing, addr_regs, input, _) ->
+         irreversible_action i;
          add_input_regs i addr_regs;
          add_input_reg i input;
          add_output_mem i
       | Icall(signature, ef, inputs, output, _) ->
+         irreversible_action i;
          (match ef with
           | Datatypes.Coq_inl r -> add_input_reg i r
           | Datatypes.Coq_inr symbol -> ()
@@ -139,6 +149,7 @@ let get_simple_dependencies (seqa : instruction array) =
          add_output_reg i (latency_of_call signature ef) output;
          add_output_mem i
       | Itailcall(signature, ef, inputs) ->
+         set_branch i;
         (match ef with
           | Datatypes.Coq_inl r -> add_input_reg i r
           | Datatypes.Coq_inr symbol -> ()
@@ -146,17 +157,22 @@ let get_simple_dependencies (seqa : instruction array) =
          add_input_mem i;
          add_input_regs i inputs
       | Ibuiltin(ef, builtin_inputs, builtin_output, _) ->
+         set_branch i;
          add_input_mem i;
          List.iter (add_builtin_arg i) builtin_inputs;
          add_builtin_res i builtin_output;
          add_output_mem i
       | Icond(cond, inputs, _, _, _) ->
+         set_branch i;
          add_input_regs i inputs
       | Ijumptable(input, _) ->
+         set_branch i;
          add_input_reg i input
       | Ireturn(Some input) ->
+         set_branch i;
          add_input_reg i input
-      | Ireturn(None) -> ()
+      | Ireturn(None) ->
+         set_branch i
     end seqa;
   !latency_constraints;;
 
@@ -377,7 +393,7 @@ let define_problem seqa =
 let schedule_sequence (seqa : instruction array) =
   try
     if (Array.length seqa) <= 1
-    then seqa
+    then None
     else
       begin
       let nr_instructions = Array.length seqa in
@@ -388,7 +404,7 @@ let schedule_sequence (seqa : instruction array) =
       match reverse_list_scheduler problem
       (* scheduler_by_name !Clflags.option_fprepass_sched problem *) with
       | None -> Printf.printf "no solution in prepass scheduling\n";
-                seqa
+                None
       | Some solution ->
          let positions = Array.init nr_instructions (fun i -> i) in
          Array.sort (fun i j ->
@@ -396,11 +412,9 @@ let schedule_sequence (seqa : instruction array) =
              if si < sj then -1
              else if si > sj then 1
              else i - j) positions;
-         let reordered = Array.init nr_instructions
-                           (fun i -> seqa.(positions.(i))) in
-         reordered
+         Some positions
     end
   with (Failure s) ->
     Printf.printf "failure in prepass scheduling: %s\n" s;
-    seqa;;
+    None;;
                                                             
diff --git a/kvx/lib/RTLpathScheduleraux.ml b/kvx/lib/RTLpathScheduleraux.ml
index c304c6d3..3008543c 100644
--- a/kvx/lib/RTLpathScheduleraux.ml
+++ b/kvx/lib/RTLpathScheduleraux.ml
@@ -97,12 +97,23 @@ end
 let schedule_superblock sb code =
   let old_flag = !debug_flag in
   debug_flag := true;
+  print_endline "ORIGINAL SUPERBLOCK";
   print_superblock sb code;
-  let _ = PrepassSchedulingOracle.schedule_sequence
+  debug_flag := old_flag;
+  match PrepassSchedulingOracle.schedule_sequence
               (Array.map (fun i ->
                    match PTree.get i code with Some ii -> ii | None -> failwith "RTLpathScheduleraux.schedule_superblock")
-                 sb.instructions) in
-  debug_flag := old_flag;
+                 sb.instructions) with
+  | None -> sb.instructions
+  | Some order ->
+     let ins' = Array.map (fun i -> sb.instructions.(i)) order in
+     Printf.printf "REORDERED SUPERBLOCK %d\n" (Array.length ins');
+     debug_flag := true;
+     print_instructions (Array.to_list ins') code;
+     debug_flag := old_flag;
+     (*sb.instructions; *)
+     ins';;
+
   (* stub2: reverse function *)
   (*
   let reversed = Array.of_list @@ List.rev @@ Array.to_list (sb.instructions) in
@@ -114,7 +125,6 @@ let schedule_superblock sb code =
     reversed
   end *)
   (* stub: identity function *)
-  sb.instructions
 
 let change_successors i = function
   | [] -> (