[disabled checker] BTL Scheduling and Renumbering OK!

1 files changed, 62 insertions, 32 deletions

diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml
index 699538ca..4b5ebb32 100644
--- a/scheduling/BTLScheduleraux.ml
+++ b/scheduling/BTLScheduleraux.ml
@@ -2,6 +2,7 @@ open AST
 open Maps
 open Registers
 open BTL
+open BTLtypes
 open DebugPrint
 open RTLcommonaux
 open InstructionScheduler
@@ -108,7 +109,7 @@ let build_constraints_and_resources (opweights : opweights) insts btl =
           add_output_mem i;
           let rs = opweights.resources_of_store chk addr (List.length lr) in
           resources := rs :: !resources
-      | Bcond (cond, lr, BF (Bgoto s, _), Bnop _, _) ->
+      | Bcond (cond, lr, BF (Bgoto s, _), ibnot, _) ->
           (* TODO gourdinl test with/out this line *)
           let live = (get_some @@ PTree.get s btl).input_regs in
           add_input_regs i (Regset.elements live);
@@ -132,11 +133,7 @@ let define_problem (opweights : opweights) ibf btl =
     max_latency = -1;
     resource_bounds = opweights.pipelined_resource_bounds;
     instruction_usages = resources;
-    latency_constraints =
-      (* if (use_alias_analysis ())
-         then (get_alias_dependencies seqa) @ simple_deps
-         else *)
-      simple_deps;
+    latency_constraints = simple_deps;
   }
 
 let zigzag_scheduler problem early_ones =
@@ -161,9 +158,16 @@ let zigzag_scheduler problem early_ones =
         { problem with latency_constraints = !constraints' }
   | None -> None
 
-let prepass_scheduler_by_name name problem early_ones =
+let prepass_scheduler_by_name name problem insts =
   match name with
-  | "zigzag" -> zigzag_scheduler problem early_ones
+  | "zigzag" ->
+      let early_ones =
+        Array.map
+          (fun inst ->
+            match inst with Bcond (_, _, _, _, _) -> true | _ -> false)
+          insts
+      in
+      zigzag_scheduler problem early_ones
   | _ -> scheduler_by_name name problem
 
 let schedule_sequence insts btl =
@@ -174,13 +178,7 @@ let schedule_sequence insts btl =
       let nr_instructions = Array.length insts in
       let problem = define_problem opweights insts btl in
       match
-        prepass_scheduler_by_name
-          !Clflags.option_fprepass_sched
-          problem
-          (Array.map
-             (fun inst ->
-               match inst with Bcond (_, _, _, _, _) -> true | _ -> false)
-             insts)
+        prepass_scheduler_by_name !Clflags.option_fprepass_sched problem insts
       with
       | None ->
           Printf.printf "no solution in prepass scheduling\n";
@@ -199,23 +197,55 @@ let schedule_sequence insts btl =
 
 let flatten_blk_basics ibf =
   let ib = ibf.entry in
+  let last = ref None in
   let rec traverse_blk ib =
     match ib with
-    | BF (_, _)
-    | Bcond (_, _, BF (Bgoto _, _), BF (Bgoto _, _), _) -> []
-    | Bseq (ib1, ib2) ->
-        traverse_blk ib1 @ traverse_blk ib2
-    | _ -> [ib]
-    in
-  Array.of_list (traverse_blk ib)
+    | BF (_, _) ->
+        last := Some ib;
+        []
+    | Bseq (ib1, ib2) -> traverse_blk ib1 @ traverse_blk ib2
+    | Bcond (_, _, _, _, iinfo) -> (
+        match iinfo.pcond with
+        | Some _ -> [ ib ]
+        | None ->
+            last := Some ib;
+            [])
+    | _ -> [ ib ]
+  in
+  let ibl = traverse_blk ib in
+  (Array.of_list ibl, !last)
 
-let btl_scheduler btl entry =
-  List.iter (fun (n,ibf) ->
-    let bseq = flatten_blk_basics ibf in
-    match schedule_sequence bseq btl with
-    | Some positions ->
-        Array.iter (fun p -> debug "%d " p) positions
-    | None -> ()
-  ) (PTree.elements btl);
-  (*let seqs = get_sequences seqs in*)
-  ()
+let apply_schedule bseq olast positions =
+  let ibl = Array.to_list (Array.map (fun i -> bseq.(i)) positions) in
+  let rec build_iblock = function
+    | [] -> failwith "build_iblock: empty list"
+    | [ ib ] -> ( match olast with Some last -> Bseq (ib, last) | None -> ib)
+    | ib1 :: ib2 :: k -> Bseq (ib1, build_iblock (ib2 :: k))
+  in
+  build_iblock ibl
+
+let schedule_blk n ibf btl =
+  let bseq, olast = flatten_blk_basics ibf in
+  match schedule_sequence bseq btl with
+  | Some positions ->
+      debug "%d," (p2i n);
+      Array.iter (fun p -> debug "%d " p) positions;
+      debug "\n";
+      let new_ib = apply_schedule bseq olast positions in
+      let new_ibf =
+        { entry = new_ib; binfo = ibf.binfo; input_regs = ibf.input_regs }
+      in
+      PTree.set n new_ibf btl
+  | None -> btl
+
+let rec do_schedule btl = function
+  | [] -> btl
+  | (n, ibf) :: blks ->
+      let btl' = schedule_blk n ibf btl in
+      do_schedule btl' blks
+
+let btl_scheduler btl =
+  (*debug_flag := true;*)
+  let btl' = do_schedule btl (PTree.elements btl) in
+  (*debug_flag := false;*)
+  btl'