Smart scheduler build problem and flatten solution OK

1 files changed, 245 insertions, 237 deletions

diff --git a/aarch64/PostpassSchedulingOracle.ml b/aarch64/PostpassSchedulingOracle.ml
index 31864384..eba10496 100644
--- a/aarch64/PostpassSchedulingOracle.ml
+++ b/aarch64/PostpassSchedulingOracle.ml
@@ -5,6 +5,7 @@
 (*           Sylvain Boulmé     Grenoble-INP, VERIMAG          *)
 (*           David Monniaux     CNRS, VERIMAG                  *)
 (*           Cyril Six          Kalray                         *)
+(*           Léo Gourdin        UGA, VERIMAG                   *)
 (*                                                             *)
 (*  Copyright Kalray. Copyright VERIMAG. All rights reserved.  *)
 (*  This file is distributed under the terms of the INRIA      *)
@@ -14,20 +15,18 @@
 
 (*open Asm*)
 open Asmblock
+open OpWeightsAsm
 (*open Printf*)
 (*open Camlcoq*)
-(*open InstructionScheduler*)
+open InstructionScheduler
 (*open TargetPrinter.Target*)
 
 let debug = false
 
 (**
- * Extracting infos from Asmvliw instructions
+ * Extracting infos from Asm instructions
  *)
 
-(* TODO remove? type immediate = I32 of Integers.Int.int | I64 of Integers.Int64.int | Off of offset*)
-(*type location = Reg of preg | Mem*)
-
 type real_instruction =
   | Add | Adr | Adrp | And | Asr | B | Bic | Bl | Blr | Br | Cbnz | Cbz | Cls
   | Clz | Cmn | Cmp | Csel | Cset | Eon | Eor | Fabs | Fadd | Fcmp | Fcsel
@@ -39,19 +38,17 @@ type real_instruction =
   | Tbnz | Tbz | Tst | Ubfiz | Ubfx | Ucvtf | Udiv | Umulh | Uxtb | Uxth
   | Uxtw | Uxtx
 
-(* TODO remove? type ab_inst_rec = {*)
-  (*inst: real_instruction;*)
-  (*write_locs : location list;*)
-  (*read_locs : location list;*)
-  (*read_at_id : location list; (* Must be contained in read_locs *)*)
-  (*read_at_e1 : location list; (* idem *)*)
-  (*imm : immediate option;*)
-  (*is_control : bool;*)
-(*}*)
+type ab_inst_rec = {
+  inst: instruction;
+  is_control : bool;
+  usage: int array; (* resources consumed by the instruction *)
+  latency: int;
+}
 
 (** Asm constructor to real instructions *)
 
 exception OpaqueInstruction
+exception NYI (* XXX *)
 
 let arith_p_real = function
   | Padrp(_,_) ->       Adrp
@@ -96,6 +93,25 @@ let arith_ppp_real = function
   | Pfmul(_) ->         Fmul
   | Pfsub(_) ->         Fsub
 
+let arith_rr0r_real = function
+  | Padd(_,_) ->        Add
+  | Psub(_,_) ->        Sub
+  | Pand(_,_) ->        And
+  | Pbic(_,_) ->        Bic
+  | Peon(_,_) ->        Eon
+  | Peor(_,_) ->        Eor
+  | Porr(_,_) ->        Orr
+  | Porn(_,_) ->        Orn
+
+let arith_rr0_real = function
+  | Pandimm(_,_) ->     And
+  | Peorimm(_,_) ->     Eor
+  | Porrimm(_,_) ->     Orr
+
+let arith_arrrr0_real = function
+  | Pmadd(_) ->         Madd
+  | Pmsub(_) ->         Msub
+
 let arith_comparison_p_real = function
   | Pfcmp0(_) ->        Fcmp
   | Pcmpimm(_,_) ->     Cmp
@@ -142,7 +158,7 @@ let store_rs_a_real = function
   | Pstrd ->            Str
   | Pstrd_a ->          Str
 
-let load_rs_a_real = function
+let load_rd_a_real = function
   | Pldrw ->            Ldr
   | Pldrw_a ->          Ldr
   | Pldrx ->            Ldr
@@ -207,31 +223,32 @@ let load_rs_a_real = function
 (*let arith_rr_rec i rd rs = {  inst = arith_rr_real i; write_locs = [Reg rd]; read_locs = [Reg rs]; imm = None; is_control = false;*)
                               (*read_at_id = []; read_at_e1 = [] }*)
 
-(*let arith_r_rec i rd = match i with*)
-    (*(* For Ploadsymbol, writing the highest integer since we do not know how many bits does a symbol have *)*)
-  (*| Ploadsymbol (id, ofs) -> {  inst = loadsymbol_real; write_locs = [Reg rd]; read_locs = []; imm = Some (I64 Integers.Int64.max_signed);*)
-                                (*is_control = false; read_at_id = []; read_at_e1 = [] }*)
+(*let arith_p_rec i rd = { inst = arith_p_real i; is_control = false }*)
+(*let arith_pp_rec i rd rs = { inst = arith_pp_real i; is_control = false }*)
+(*let arith_ppp_rec i rd r1 r2 = { inst = arith_ppp_real i; is_control = false }*)
+(*let arith_rr0r_rec i rd r1 r2 = { inst = arith_rr0r_real i; is_control = false }*)
+(*let arith_rr0_rec i rd r1 = { inst = arith_rr0_real i; is_control = false }*)
+(*let arith_arrrr0_rec i rd r1 r2 r3 = { inst = arith_arrrr0_real i; is_control = false }*)
+(*let arith_comparison_pp_rec i r1 r2 = { inst = arith_comparison_pp_real i; is_control = false }*)
+(*let arith_comparison_r0r_rec i r1 r2 = { inst = arith_comparison_r0r_real i; is_control = false }*)
+(*let arith_comparison_p_rec i r1 = { inst = arith_comparison_p_real i; is_control = false }*)
+(*let load_rec ld rd a = { inst = load_rd_a_real ld; is_control = false }*)
+(*let store_rec st r a = { inst = store_rs_a_real st; is_control = false }*)
 
 (*let arith_rec i =*)
   (*match i with*)
-  (*| PArithRRI32 (i, rd, rs, imm32) -> arith_rri32_rec i (IR rd) (IR rs) (Some (I32 imm32))*)
-  (*| PArithRRI64 (i, rd, rs, imm64) -> arith_rri64_rec i (IR rd) (IR rs) (Some (I64 imm64))*)
-  (*| PArithRRR (i, rd, rs1, rs2) -> arith_rrr_rec i (IR rd) (IR rs1) (IR rs2)*)
-  (*| PArithARR (i, rd, rs) -> arith_arr_rec i (IR rd) (IR rs)*)
-  (*(* Seems like single constant constructor types are elided *)*)
-  (*| PArithARRI32 (i, rd, rs, imm32) -> arith_arri32_rec i (IR rd) (IR rs) (Some (I32 imm32))*)
-  (*| PArithARRI64 (i, rd, rs, imm64) -> arith_arri64_rec i (IR rd) (IR rs) (Some (I64 imm64))*)
-  (*| PArithARRR (i, rd, rs1, rs2) -> arith_arrr_rec i (IR rd) (IR rs1) (IR rs2)*)
-  (*| PArithRI32 (rd, imm32) -> { inst = arith_ri32_real; write_locs = [Reg (IR rd)]; read_locs = []; imm = (Some (I32 imm32)) ; is_control = false;*)
-                                (*read_at_id = []; read_at_e1 = [] }*)
-  (*| PArithRI64 (rd, imm64) -> { inst = arith_ri64_real; write_locs = [Reg (IR rd)]; read_locs = []; imm = (Some (I64 imm64)) ; is_control = false;*)
-                                (*read_at_id = []; read_at_e1 = [] }*)
-  (*| PArithRF32 (rd, f) -> { inst = arith_rf32_real; write_locs = [Reg (IR rd)]; read_locs = [];*)
-                            (*imm = (Some (I32 (Floats.Float32.to_bits f))); is_control = false; read_at_id = []; read_at_e1 = []}*)
-  (*| PArithRF64 (rd, f) -> { inst = arith_rf64_real; write_locs = [Reg (IR rd)]; read_locs = [];*)
-                            (*imm = (Some (I64 (Floats.Float.to_bits f))); is_control = false; read_at_id = []; read_at_e1 = []}*)
-  (*| PArithRR (i, rd, rs) -> arith_rr_rec i (IR rd) (IR rs)*)
-  (*| PArithR (i, rd) -> arith_r_rec i (IR rd)*)
+  (*| PArithP (i', rd) -> arith_p_rec i' rd*)
+  (*| PArithPP (i', rd, rs) -> arith_pp_rec i' rd rs*)
+  (*| PArithPPP (i', rd, r1, r2) -> arith_ppp_rec i' rd r1 r2*)
+  (*| PArithRR0R (i', rd, r1, r2) -> arith_rr0r_rec i' rd r1 r2*)
+  (*| PArithRR0 (i', rd, r1) -> arith_rr0_rec i' rd r1*)
+  (*| PArithARRRR0 (i', rd, r1, r2, r3) -> arith_arrrr0_rec i' rd r1 r2 r3*)
+  (*| PArithComparisonPP (i', r1, r2) -> arith_comparison_pp_rec i' r1 r2*)
+  (*| PArithComparisonR0R (i', r1, r2) -> arith_comparison_r0r_rec i' r1 r2*)
+  (*| PArithComparisonP (i', r1) -> arith_comparison_p_rec i' r1*)
+  (*| _ -> raise NYI*)
+
+
 
 (*let load_rec i = match i with*)
   (*| PLoadRRO (trap, i, rs1, rs2, imm) ->*)
@@ -271,49 +288,61 @@ let load_rs_a_real = function
 (*let set_rec rd (rs:gpreg) = { inst = set_real; write_locs = [Reg rd]; read_locs = [Reg (IR rs)]; imm = None; is_control = false;*)
                               (*read_at_id = [Reg (IR rs)]; read_at_e1 = [] }*)
 
-(*let basic_rec i =*)
+let basic_rec i =
+  let opweights = get_opweights ()
+  and i' = PBasic i in
+  { inst = i'; usage = opweights.resources_of_op i' 0; latency = opweights.latency_of_op i' 0; is_control = false }
+  (*match i with*)
+  (*| PArith (i') -> arith_rec i'*)
+  (*| PLoad (ld, rd, a) -> load_rec ld rd a*)
+  (*| PStore (st, r, a) -> store_rec st r a*)
+  (*| Pallocframe (_,_) -> raise OpaqueInstruction*)
+  (*| Pfreeframe (_,_) -> raise OpaqueInstruction*)
+  (*| Ploadsymbol (rd, id) -> raise OpaqueInstruction (* XXX how to manage this one? *)*)
+  (*| Pcvtsw2x (rd, r1) -> { inst = Sxtw; is_control = false }*)
+  (*| Pcvtuw2x (rd, r1) -> { inst = Uxtw; is_control = false }*)
+  (*| Pcvtx2w (rd) -> raise OpaqueInstruction (* XXX NYI in TargetPrinter? *)*)
+  (*(*| Pget (rd, rs) -> get_rec rd rs*)*)
+  (*(*| Pset (rd, rs) -> set_rec rd rs*)*)
+  (*(*| Pnop -> { inst = nop_real; write_locs = []; read_locs = []; imm = None ; is_control = false; read_at_id = []; read_at_e1 = []}*)*)
+
+let builtin_rec ef args res = raise OpaqueInstruction (* XXX not sure *)
+
+(*let ctl_flow_rec i =*)
+  (*let opweights = OpWeightsAsm.get_opweights () in*)
+  (*{ inst = i; usage = opweights.resources_of_op i 0; latency = opweights.latency_of_op i 0; is_control = true }*)
   (*match i with*)
-  (*| PArith i -> arith_rec i*)
-  (*| PLoad i -> load_rec i*)
-  (*| PStore i -> store_rec i*)
-  (*| Pallocframe (_, _) -> raise OpaqueInstruction*)
-  (*| Pfreeframe (_, _) -> raise OpaqueInstruction*)
-  (*| Pget (rd, rs) -> get_rec rd rs*)
-  (*| Pset (rd, rs) -> set_rec rd rs*)
-  (*| Pnop -> { inst = nop_real; write_locs = []; read_locs = []; imm = None ; is_control = false; read_at_id = []; read_at_e1 = []}*)
-
-(*let expand_rec = function*)
-  (*| Pbuiltin _ -> raise OpaqueInstruction*)
-
-(*let ctl_flow_rec = function*)
-  (*| Pret -> { inst = ret_real; write_locs = []; read_locs = [Reg RA]; imm = None ; is_control = true; read_at_id = [Reg RA]; read_at_e1 = []}*)
-  (*| Pcall lbl -> { inst = call_real; write_locs = [Reg RA]; read_locs = []; imm = None ; is_control = true; read_at_id = []; read_at_e1 = []}*)
-  (*| Picall r -> { inst = icall_real; write_locs = [Reg RA]; read_locs = [Reg (IR r)]; imm = None; is_control = true;*)
-                  (*read_at_id = [Reg (IR r)]; read_at_e1 = [] }*)
-  (*| Pgoto lbl -> { inst = goto_real; write_locs = []; read_locs = []; imm = None ; is_control = true; read_at_id = []; read_at_e1 = []}*)
-  (*| Pigoto r -> { inst = igoto_real; write_locs = []; read_locs = [Reg (IR r)]; imm = None ; is_control = true;*)
-                  (*read_at_id = [Reg (IR r)]; read_at_e1 = [] }*)
-  (*| Pj_l lbl -> { inst = goto_real; write_locs = []; read_locs = []; imm = None ; is_control = true; read_at_id = []; read_at_e1 = []}*)
-  (*| Pcb (bt, rs, lbl) -> { inst = cb_real; write_locs = []; read_locs = [Reg (IR rs)]; imm = None ; is_control = true;*)
-                           (*read_at_id = [Reg (IR rs)]; read_at_e1 = [] }*)
-  (*| Pcbu (bt, rs, lbl) -> { inst = cbu_real; write_locs = []; read_locs = [Reg (IR rs)]; imm = None ; is_control = true;*)
-                           (*read_at_id = [Reg (IR rs)]; read_at_e1 = [] }*)
-  (*| Pjumptable (r, _) -> raise OpaqueInstruction (* { inst = "Pjumptable"; write_locs = [Reg (IR GPR62); Reg (IR GPR63)]; read_locs = [Reg (IR r)]; imm = None ; is_control = true} *)*)
-
-(*let control_rec i =*)
+  (*| Pb(_) ->          { inst = B; is_control = true }*)
+  (*| Pbc(_,_) ->       { inst = B; is_control = true }*)
+  (*| Pbl(_,_) ->       { inst = Bl; is_control = true }*)
+  (*| Pbs(_,_) ->       { inst = B; is_control = true }*)
+  (*| Pblr(_,_) ->      { inst = Blr; is_control = true }*)
+  (*| Pbr(_,_) ->       { inst = Br; is_control = true }*)
+  (*| Pret(_) ->        { inst = Ret; is_control = true }*)
+  (*| Pcbnz(_,_,_) ->   { inst = Cbnz; is_control = true }*)
+  (*| Pcbz(_,_,_) ->    { inst = Cbz; is_control = true }*)
+  (*| Ptbnz(_,_,_,_) -> { inst = Tbnz; is_control = true }*)
+  (*| Ptbz(_,_,_,_) ->  { inst = Tbz; is_control = true }*)
+  (*| Pbtbl(_,_) ->  raise OpaqueInstruction (* XXX how to manage this one? Maybe Br *)*)
+
+let control_rec i =
+  let opweights = get_opweights ()
+  and i' = PControl i in
+  { inst = i'; usage = opweights.resources_of_op i' 0; latency = opweights.latency_of_op i' 0; is_control = true }
   (*match i with*)
-  (*| PExpand i -> expand_rec i*)
-  (*| PCtlFlow i -> ctl_flow_rec i*)
+  (*| Pbuiltin (ef, args, res) -> builtin_rec ef args res*)
+  (*| PCtlFlow (i') -> ctl_flow_rec i'*)
 
-(*let rec basic_recs body = match body with*)
-  (*| [] -> []*)
-  (*| bi :: body -> (basic_rec bi) :: (basic_recs body)*)
+(* TODO Continue here by calling constructors *)
+let rec basic_recs body = match body with
+  | [] -> []
+  | bi :: body -> (basic_rec bi) :: (basic_recs body)
 
-(*let exit_rec exit = match exit with*)
-  (*| None -> []*)
-  (*| Some ex -> [control_rec ex]*)
+let exit_rec exit = match exit with
+  | None -> []
+  | Some ex -> [control_rec ex]
 
-(*let instruction_recs bb = (basic_recs bb.body) @ (exit_rec bb.exit)*)
+let instruction_recs bb = (basic_recs bb.body) @ (exit_rec bb.exit)
 
 (**
  * Providing informations relative to the real instructions
@@ -321,10 +350,6 @@ let load_rs_a_real = function
 
 (** Abstraction providing all the necessary informations for solving the scheduling problem *)
 (*type inst_info = {*)
-  (*write_locs : location list;*)
-  (*read_locs : location list;*)
-  (*reads_at_id : bool;*)
-  (*reads_at_e1 : bool;*)
   (*is_control : bool;*)
   (*usage: int array; (* resources consumed by the instruction *)*)
   (*latency: int;*)
@@ -614,19 +639,16 @@ let load_rs_a_real = function
   (*| [] -> true*)
   (*| b::lb -> if (List.mem b la) then false else empty_inter la lb*)
 
-(*let rec_to_info r : inst_info =*)
-  (*let usage = rec_to_usage r*)
-  (*and latency = real_inst_to_latency r.inst*)
-  (*and reads_at_id = not (empty_inter r.read_locs r.read_at_id)*)
-  (*and reads_at_e1 = not (empty_inter r.read_locs r.read_at_e1)*)
-  (*in {  write_locs = r.write_locs; read_locs = r.read_locs; usage=usage; latency=latency; is_control=r.is_control;*)
-        (*reads_at_id = reads_at_id; reads_at_e1 = reads_at_e1 }*)
+(*let rec_to_info (r : ab_inst_rec) : inst_info =*)
+  (*let opweights = OpWeightsAsm.get_opweights ()*)
+  (*in { usage=opweights.resources_of_op r.inst; latency=opweights.latency_of_op r.inst; is_control=r.is_control }*)
 
 (*let instruction_infos bb = List.map rec_to_info (instruction_recs bb)*)
+let instruction_infos bb = instruction_recs bb
 
-(*let instruction_usages bb =*)
-  (*let usages = List.map (fun info -> info.usage) (instruction_infos bb)*)
-  (*in Array.of_list usages*)
+let instruction_usages bb =
+  let usages = List.map (fun info -> info.usage) (instruction_infos bb)
+  in Array.of_list usages
 
 (**
  * Latency constraints building
@@ -672,109 +694,106 @@ let load_rs_a_real = function
   (*in let lat = ifrom.latency + dlat*)
   (*in assert (lat >= 0); if (lat == 0) then 1 else lat*)
 
-(*let latency_constraints bb =*)
-  (*let written = LocHash.create 70*)
-  (*and read = LocHash.create 70*)
-  (*and count = ref 0*)
-  (*and constraints = ref []*)
-  (*and instr_infos = instruction_infos bb*)
-  (*in let step (i: inst_info) =*)
-    (*let raw = get_accesses written i.read_locs*)
-    (*and waw = get_accesses written i.write_locs*)
-    (*and war = get_accesses read i.write_locs*)
-    (*in begin*)
-      (*List.iter (fun i -> constraints := {instr_from = i; instr_to = !count;*)
-                                          (*latency = compute_latency (List.nth instr_infos i) (List.nth instr_infos !count)} :: !constraints) raw;*)
-      (*List.iter (fun i -> constraints := {instr_from = i; instr_to = !count;*)
-                                          (*latency = compute_latency (List.nth instr_infos i) (List.nth instr_infos !count)} :: !constraints) waw;*)
-      (*List.iter (fun i -> constraints := {instr_from = i; instr_to = !count; latency = 0} :: !constraints) war;*)
-      (*if i.is_control then List.iter (fun n -> constraints := {instr_from = n; instr_to = !count; latency = 0} :: !constraints) (intlist !count);*)
-      (*(* Updating "read" and "written" hashmaps *)*)
-      (*List.iter (fun loc ->*)
-                  (*begin *)
-                    (*LocHash.replace written loc [!count];*)
-                    (*LocHash.replace read loc []; (* Clearing all the entries of "read" hashmap when a register is written *)*)
-                  (*end) i.write_locs;*)
-      (*List.iter (fun loc -> LocHash.replace read loc ((!count) :: (find_in_hash read loc))) i.read_locs;*)
-      (*count := !count + 1*)
-    (*end*)
-  (*in (List.iter step instr_infos; !constraints)*)
+let latency_constraints bb =
+  let count = ref 0
+  and constraints = ref []
+  and instr_infos = instruction_infos bb
+  in let step (i: ab_inst_rec) =
+    begin
+      constraints := {instr_from = !count; instr_to = !count+1; latency = i.latency} :: !constraints;
+      count := !count + 1
+    end
+  in (List.iter step instr_infos; !constraints)
 
 (**
  * Using the InstructionScheduler
  *)
 
-(* TODO RESUME HERE 
-(*let build_problem bb = *)
-  (*{ max_latency = -1; resource_bounds = resource_bounds;*)
-    (*instruction_usages = instruction_usages bb; latency_constraints = latency_constraints bb }*)
-
-let rec find_min_opt (l: int option list) =
-  match l with
-  | [] -> None 
-  | e :: l ->
-    begin match find_min_opt l with
-    | None -> e
-    | Some m ->
-      begin match e with
-      | None -> Some m
-      | Some n -> if n < m then Some n else Some m
-      end
-    end
+(* TODO RESUME HERE *)
 
-let rec filter_indexes predicate = function
-  | [] -> []
-  | e :: l -> if (predicate e) then e :: (filter_indexes predicate l) else filter_indexes predicate l
+let opweights = OpWeightsAsm.get_opweights () 
+
+let build_problem bb = 
+{ max_latency = -1; resource_bounds = opweights.pipelined_resource_bounds;
+  instruction_usages = instruction_usages bb; latency_constraints = latency_constraints bb }
+
+(*let rec find_min_opt (l: int option list) =*)
+  (*match l with*)
+  (*| [] -> None *)
+  (*| e :: l ->*)
+    (*begin match find_min_opt l with*)
+    (*| None -> e*)
+    (*| Some m ->*)
+      (*begin match e with*)
+      (*| None -> Some m*)
+      (*| Some n -> if n < m then Some n else Some m*)
+      (*end*)
+    (*end*)
+
+(*let rec filter_indexes predicate = function*)
+  (*| [] -> []*)
+  (*| e :: l -> if (predicate e) then e :: (filter_indexes predicate l) else filter_indexes predicate l*)
 
 let get_from_indexes indexes l = List.map (List.nth l) indexes
 
-let is_basic = function PBasic _ -> true | _ -> false
-let is_control = function PCtlFlow _ -> true | PExpand _ -> true | _ -> false
+(*let is_basic = function PBasic _ -> true | _ -> false*)
+let is_control = function PControl _ -> true | _ -> false
 let to_basic = function PBasic i -> i | _ -> failwith "to_basic: control instruction found"
 let to_control = function PControl i -> i | _ -> failwith "to_control: basic instruction found"
 
-let bundlize li hd =
+let rec body_to_instrs bdy = 
+  match bdy with
+  | [] -> []
+  | i :: l' -> PBasic i :: body_to_instrs l'
+
+let rec instrs_to_bdy instrs =
+  match instrs with
+  | [] -> []
+  | PBasic i :: l' -> i :: instrs_to_bdy l'
+  | PControl _ :: l' -> failwith "instrs_to_bdy: control instruction found"
+
+let repack li hd =
   let last = List.nth li (List.length li - 1)
   in if is_control last then
       let cut_li = Array.to_list @@ Array.sub (Array.of_list li) 0 (List.length li - 1)
-      in { header = hd; body = cut_li; exit = Some (to_control last) }
+      in { header = hd; body = (instrs_to_bdy cut_li); exit = Some (to_control last) }
     else 
-      { header = hd; body = li; exit = None }
+      { header = hd; body = (instrs_to_bdy li); exit = None }
 
-let extract_some o = match o with Some e -> e | None -> failwith "extract_some: None found"
+(*let extract_some o = match o with Some e -> e | None -> failwith "extract_some: None found"*)
 
-let rec find_min = function
-  | [] -> None
-  | e :: l ->
-    match find_min l with
-    | None -> Some e
-    | Some m -> if (e < m) then Some e else Some m
+(*let rec find_min = function*)
+  (*| [] -> None*)
+  (*| e :: l ->*)
+    (*match find_min l with*)
+    (*| None -> Some e*)
+    (*| Some m -> if (e < m) then Some e else Some m*)
 
-let rec remove_all m = function
-  | [] -> []
-  | e :: l -> if m=e then remove_all m l
-                     else e :: (remove_all m l)
+(*let rec remove_all m = function*)
+  (*| [] -> []*)
+  (*| e :: l -> if m=e then remove_all m l*)
+                     (*else e :: (remove_all m l)*)
 
-let rec find_mins l = match find_min l with
-  | None -> []
-  | Some m -> m :: find_mins (remove_all m l)
+(*let rec find_mins l = match find_min l with*)
+  (*| None -> []*)
+  (*| Some m -> m :: find_mins (remove_all m l)*)
 
-let find_all_indices m l = 
-  let rec find m off = function
-    | [] -> []
-    | e :: l -> if m=e then off :: find m (off+1) l
-                       else find m (off+1) l
-  in find m 0 l
+(*let find_all_indices m l = *)
+  (*let rec find m off = function*)
+    (*| [] -> []*)
+    (*| e :: l -> if m=e then off :: find m (off+1) l*)
+                       (*else find m (off+1) l*)
+  (*in find m 0 l*)
 
 module TimeHash = Hashtbl
 
-(* Hash table : time => list of instruction ids *)
+(*Hash table : time => list of instruction ids *)
 
-let hashtbl2list h maxint = 
+let hashtbl2flatarray h maxint = 
   let rec f i = match TimeHash.find_opt h i with
   | None -> if (i > maxint) then [] else (f (i+1))
-  | Some bund -> bund :: (f (i+1))
-  in f 0 
+  | Some bund -> bund @ (f (i+1))
+  in f 0
 
 let find_max l =
   let rec f = function
@@ -786,7 +805,7 @@ let find_max l =
   | None -> raise Not_found
   | Some m -> m 
 
-(* [0, 2, 3, 1, 1, 2, 4, 5] -> [[0], [3, 4], [1, 5], [2], [6], [7]] *)
+(*(* [0, 2, 3, 1, 1, 2, 4, 5] -> [[0], [3, 4], [1, 5], [2], [6], [7]] *)*)
 let minpack_list (l: int list) =
   let timehash = TimeHash.create (List.length l)
   in let rec f i = function
@@ -799,58 +818,52 @@ let minpack_list (l: int list) =
     end 
   in begin
     f 0 l;
-    hashtbl2list timehash (find_max l)
+    hashtbl2flatarray timehash (find_max l)
   end;;
 
-(* let minpack_list l =
-  let mins = find_mins l
-  in List.map (fun m -> find_all_indices m l) mins
-  *)
+(*let minpack_list l =*)
+  (*let mins = find_mins l*)
+  (*in List.map (fun m -> find_all_indices m l) mins*)
 
-let bb_to_instrs bb = bb.body @ (match bb.exit with None -> [] | Some e -> [Some e])
+let bb_to_instrs bb = body_to_instrs bb.body @ (match bb.exit with None -> [] | Some e -> [PControl e])
 
-let bundlize_solution bb sol =
+let build_solution bb sol =
+  (* Remove last element - the total *)
   let tmp = (Array.to_list @@ Array.sub sol 0 (Array.length sol - 1))
-  in let packs = minpack_list tmp
+  in let pack = minpack_list tmp
   and instrs = bb_to_instrs bb
-  in let rec bund hd = function
-    | [] -> []
-    | pack :: packs -> bundlize (get_from_indexes pack instrs) hd :: (bund [] packs)
-  in bund bb.header packs
-*)
+  in repack (get_from_indexes pack instrs) bb.header
+  (*in let rec bund hd = function*)
+    (*| [] -> []*)
+    (*| pack :: packs -> repack (get_from_indexes pack instrs) hd :: (bund [] packs)*)
+  (*in bund bb.header packs*)
+
 (*let print_inst oc = function*)
-  (*| Asm.Pallocframe(sz, ofs) -> fprintf oc "	Pallocframe\n"*)
-  (*| Asm.Pfreeframe(sz, ofs) -> fprintf oc "	Pfreeframe\n"*)
-  (*| Asm.Pbuiltin(ef, args, res) -> fprintf oc "	Pbuiltin\n"*)
-  (*| i -> print_instruction oc i*)
+  (*| i -> TargetPrinter.Target.print_instruction oc i*)
+  (*(*| Asm.Pallocframe(sz, ofs) -> Printf.fprintf oc "	Pallocframe\n"*)*)
+  (*(*| Asm.Pfreeframe(sz, ofs) -> Printf.fprintf oc "	Pfreeframe\n"*)*)
+  (*(*| Asm.Pbuiltin(ef, args, res) -> Printf.fprintf oc "	Pbuiltin\n"*)*)
+  (*(*| i -> TargetPrinter.Target.print_instruction oc i*)*)
 
 (*let print_bb oc bb =*)
-  (*let asm_instructions = Asm.unfold_bblock bb*)
-  (*in List.iter (print_inst oc) asm_instructions*)
-
-(*let print_schedule sched =*)
-  (*print_string "[ ";*)
-  (*Array.iter (fun x -> Printf.printf "%d; " x) sched;*)
-  (*print_endline "]";;*)
-
-(*let do_schedule bb =*)
-  (*let problem = build_problem bb in*)
-  (*(if debug then print_problem stdout problem);*)
-  (*let solution = scheduler_by_name (!Clflags.option_fpostpass_sched) problem*)
-  (*in match solution with*)
-  (*| None -> failwith "Could not find a valid schedule"*)
-  (*| Some sol ->*)
-     (*((if debug then print_schedule sol);*)
-     (*let bundles = bundlize_solution bb sol in *)
-      (*(if debug then*)
-      (*begin*)
-        (*Printf.eprintf "Scheduling the following group of instructions:\n";*)
-        (*print_bb stderr bb;*)
-        (*Printf.eprintf "Gave the following solution:\n";*)
-        (*List.iter (print_bb stderr) bundles;*)
-        (*Printf.eprintf "--------------------------------\n"*)
-      (*end;*)
-      (*bundles))*)
+  (*match Asmgen.Asmblock_TRANSF.unfold_bblock bb with*)
+  (*| Errors.OK instructions -> List.iter (print_inst oc) instructions*)
+  (*| Errors.Error _ -> Printf.eprintf "Error in print_bb"*)
+
+let print_schedule sched =
+  print_string "[ ";
+  Array.iter (fun x -> Printf.printf "%d; " x) sched;
+  print_endline "]";;
+
+let do_schedule bb =
+  let problem = build_problem bb in
+  (if debug then print_problem stdout problem);
+  let solution = scheduler_by_name (!Clflags.option_fpostpass_sched) problem
+  in match solution with
+  | None -> failwith "Could not find a valid schedule"
+  | Some sol ->
+     ((if debug then print_schedule sol);
+     build_solution bb sol)
 
 (**
  * Dumb schedule if the above doesn't work
@@ -868,32 +881,29 @@ let is_opaque = function
   | _ -> false
 
 (* Returns : (accumulated instructions, remaining instructions, opaque instruction if found) *)
-let rec biggest_wo_opaque = function
+(*let rec biggest_wo_opaque = function
   | [] -> ([], [], None)
   | i :: li -> if is_opaque i then ([], li, Some i)
                else let big, rem, opaque = biggest_wo_opaque li in (i :: big, rem, opaque);;
 
-(*let separate_opaque bb =*)
-  (*let instrs = bb_to_instrs bb*)
-  (*in let rec f hd li =*)
-    (*match li with*)
-    (*| [] -> []*)
-    (*| li -> let big, rem, opaque = biggest_wo_opaque li in*)
-            (*match opaque with*)
-            (*| Some i ->*)
-                (*(match big with*)
-                (*| [] -> (bundlize [i] hd) :: (f [] rem)*)
-                (*| big -> (bundlize big hd) :: (bundlize [i] []) :: (f [] rem)*)
-                (**)
-            (*| None -> (bundlize big hd) :: (f [] rem)*)
-  (*in f bb.header instrs*)
-
-(*let smart_schedule bb =*)
-  (*let lbb = separate_opaque bb*)
-  (*in let rec f = function*)
-  (*| [] -> []*)
-  (*| bb :: lbb -> *)
-      (*let bundles =*)
+let separate_opaque bb =
+  let instrs = bb_to_instrs bb
+  in let rec f hd li =
+    match li with
+    | [] -> []
+    | li -> let big, rem, opaque = biggest_wo_opaque li in
+            match opaque with
+            | Some i ->
+                (match big with
+                | [] -> (bundlize [i] hd) :: (f [] rem)
+                | big -> (bundlize big hd) :: (bundlize [i] []) :: (f [] rem)
+                )
+            | None -> (bundlize big hd) :: (f [] rem)
+  in f bb.header instrs*)
+
+let smart_schedule bb =
+  (*let lbb = separate_opaque bb in*)
+  let bb' = do_schedule bb in (bb'.body, bb'.exit)
         (*try do_schedule bb*)
         (*with OpaqueInstruction -> dumb_schedule bb*)
         (*| e -> *)
@@ -909,14 +919,12 @@ let rec biggest_wo_opaque = function
             (*dumb_schedule bb*)
             (**)*)
           (*end*)
-      (*in bundles @ (f lbb)*)
-  (*in f lbb*)
 
 let bblock_schedule bb =
-  (*if debug then (eprintf "###############################\n"; Printf.eprintf "SCHEDULING\n"; print_bb stderr bb);*)
-  (* print_problem (build_problem bb); *)
-  (*TODO if Compopts.optim_postpass () then smart_schedule bb else dumb_schedule bb*)
-  dumb_schedule bb
+  if debug then (Printf.eprintf "###############################\n"; Printf.eprintf "SCHEDULING\n");
+  print_problem stdout (build_problem bb); 
+  (*if Compopts.optim_postpass () then smart_schedule bb else dumb_schedule bb*)
+  smart_schedule bb
 
 (** Called schedule function from Coq *)