Make prepass scheduling sensitive to register pressure, by Nicolas Nardino.

Squashed commit of the following:

commit cf033ec29391d5358dea1d3b25da1738957478c4
Author: David Monniaux <David.Monniaux@univ-grenoble-alpes.fr>
Date:   Fri Jul 16 18:01:03 2021 +0200

    comment for authors

commit 2ff766a18432fd75739abab0b5741ded6b67a2a5
Author: David Monniaux <David.Monniaux@univ-grenoble-alpes.fr>
Date:   Fri Jul 16 15:29:25 2021 +0200

    activate register pressure by default

commit 67f4ae2b702cc95ed7cef67b726e15abbf18e768
Author: David Monniaux <David.Monniaux@univ-grenoble-alpes.fr>
Date:   Fri Jul 16 15:26:03 2021 +0200

    use a more recognizable option name

commit 6121be54b80a55fdadd8b64dfad53357148c9090
Author: David Monniaux <David.Monniaux@univ-grenoble-alpes.fr>
Date:   Fri Jul 16 14:13:50 2021 +0200

    fix for KVX

commit 43d4932e8ba9e00eb8c8788c86f56b6bddd46392
Author: David Monniaux <David.Monniaux@univ-grenoble-alpes.fr>
Date:   Fri Jul 16 13:28:26 2021 +0200

    setup registers

commit 169a221104c37737f12abe79711009fc0d88ce09
Author: David Monniaux <David.Monniaux@univ-grenoble-alpes.fr>
Date:   Fri Jul 16 13:00:56 2021 +0200

    rm useless code

commit d6a846b641787ea6a5ed113b1d7275ffb5028d9c
Author: David Monniaux <David.Monniaux@univ-grenoble-alpes.fr>
Date:   Fri Jul 16 12:54:19 2021 +0200

    rm "Admitted"

commit fd4d085aa988a6044f89fc17e8422be23bc87f9d
Merge: 70f5867e 56498b64
Author: David Monniaux <David.Monniaux@univ-grenoble-alpes.fr>
Date:   Fri Jul 16 12:30:25 2021 +0200

    Merge remote-tracking branch 'origin/kvx-work' into kvx-sched-w-reg-press

commit 70f5867e441e253869cb3b432af77636a186d1cb
Author: David Monniaux <David.Monniaux@univ-grenoble-alpes.fr>
Date:   Fri Jul 16 12:26:27 2021 +0200

    rm TODO

commit f86f5df47b69053702661671340b0fcb31506aa3
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Thu Jul 8 11:22:17 2021 +0200

    add more debug info

commit a4a0b36f56a94c19da301265a4e3acad1fbdf6c4
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Thu Jul 8 11:20:49 2021 +0200

    Deactivate sched validator (i think)

commit af97fca0f1d824f3becf9c6895f44ad234e262f8
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Tue Jul 6 15:32:35 2021 +0200

    Add debug info

commit b96a48de58e1969535865b7b345514a24f7178a6
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Mon Jun 28 16:04:44 2021 +0200

    Change temporary solution (see prev commits), and add option for it

commit 9ac49c465f9c8969fba00e6242da0c188a6a3080
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Fri Jun 25 09:42:41 2021 +0200

    Changed printfs into debugs

commit dfa09586ae40c70769eeda688a0e7f59f611749f
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Thu Jun 24 18:33:20 2021 +0200

    Another scheduler

commit c5e8595480604c78260017cc771b0e4195fdd182
Merge: 10cbe4b2 cf2aa686
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Tue Jun 22 15:58:10 2021 +0200

    Merge branch 'kvx-sched-w-reg-press' of gricad-gitlab.univ-grenoble-alpes.fr:sixcy/CompCert into kvx-sched-w-reg-press

commit 10cbe4b28ef6dc5d02c9a5d4d369484e4943a18d
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Tue Jun 22 15:57:21 2021 +0200

    Changed default threshold value following tests

commit cf2aa686bcf9a823562fe977df6dd778d5467985
Merge: eddbce33 fe557bf6
Author: David Monniaux <david.monniaux@univ-grenoble-alpes.fr>
Date:   Thu Jun 17 17:05:30 2021 +0200

    Merge branch 'kvx-sched-w-reg-press' of gricad-gitlab.univ-grenoble-alpes.fr:sixcy/CompCert into kvx-sched-w-reg-press

commit eddbce33e28c49bf7b9e83ebd5dbf6cb0d770090
Merge: 8f399dfa fae8d9b5
Author: David Monniaux <david.monniaux@univ-grenoble-alpes.fr>
Date:   Thu Jun 17 17:05:20 2021 +0200

    Merge branch 'kvx-sched-w-reg-press' of gricad-gitlab.univ-grenoble-alpes.fr:sixcy/CompCert into kvx-sched-w-reg-press

commit 8f399dfa9d794f2f728f523ff1aa7788cc3599b2
Author: David Monniaux <david.monniaux@univ-grenoble-alpes.fr>
Date:   Thu Jun 17 17:04:52 2021 +0200

    fix for Risc-V

commit fe557bf65ec738eaa078bc5e398ff690eb1f2b9e
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Thu Jun 17 17:03:53 2021 +0200

    changed type of schedule_seq in x86 for compatibility

commit fae8d9b5c5f93d5eda36f800eb0ca1837b237cba
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Thu Jun 17 17:00:57 2021 +0200

    fix riscv/Machregsaux.mli

commit 9759e94256fd09f4995418b67b7aedbcf84b4b10
Merge: 4413c27d 04b2489d
Author: David Monniaux <david.monniaux@univ-grenoble-alpes.fr>
Date:   Thu Jun 17 16:52:09 2021 +0200

    Merge remote-tracking branch 'origin/kvx-work' into kvx-sched-w-reg-press

commit 4413c27d6c6a3d69df34955d9d453c38b32174c7
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Thu Jun 17 15:38:13 2021 +0200

    Add option to set thresold and support for riscv

commit 21278bd87e89210bcc287116f6e35fc1b52d0df2
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Wed Jun 16 20:27:31 2021 +0200

    Now working, tests show a decrease in spillage

    Should still find a proper way to treat the case mentioned in earlier
    commits

commit 87c82b6fcf2bf825a8c60fc6a95498aac9f826d4
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Tue Jun 15 14:44:56 2021 +0200

    kinda fixed

    Spills are definitely reduced, but lots of arbitrary in there:
    See previous commit: need to determine what to do if pressure is too
    high but no schedulable instruction can reduce it. For now, advance
    time for at most 5 cycles, if still no suitable instruction, go back
    to CSP

commit 19464b3992eadf7670acc7231896103ab54885e5
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Tue Jun 15 12:07:43 2021 +0200

    fixing

    Still need to find what to do when pressure is high but there are no
    instructions available that decrease it

commit bff4e6ff0b782619b6fcc18751fa575cbb11de68
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Mon Jun 14 17:39:58 2021 +0200

    was very wrong, fixing

commit 3eb3751f84348a20b7ce211fdbf1d01a9c4685a8
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Mon Jun 14 14:46:01 2021 +0200

    One fewer spill with new sched on `test/.../spille_forw.c`

commit 66e15205c40de54639387a4c9b1cc78994525d55
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Mon Jun 14 13:53:08 2021 +0200

    scheduler written, need to test now

commit 2b814b1f9bb30d9c8b59a713f69bced808bca7c7
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Sat Jun 12 10:52:59 2021 +0200

    work on the scheduler

commit 1701e43316ee8e69e794a025a8c9979af6bb8c93
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Thu Jun 10 16:31:51 2021 +0200

    Work on new schedluer

    Renamed a test file, wrote function to compute pressure deltas,
    Still need to pass the info in some way; beginning of the actual
    scheduler function

commit 386b9053177bb4ef2801cec00b717c400a828139
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Tue Jun 8 16:53:19 2021 +0200

    Fix RTLpathScheduleraux.get_live_regs_entry

commit 9b6247b7996f3e0181d27ec0e20daffd28e0884f
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Tue Jun 8 16:06:36 2021 +0200

    Another test : one spill when scheduled forward, none if not

commit 52378f0600652a94edcc8c78e4b426243f717a89
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Tue Jun 8 15:11:03 2021 +0200

    Add some tests

commit 2249f3c7771c285ccd25f6e94478be388a741da5
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Sun Jun 6 20:49:34 2021 +0200

    Adding debug info

commit 9118878bd14e24cc04c2f36cab7aa7271a0f1852
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Sun Jun 6 12:11:15 2021 +0200

    Fixing scope error, and non-exhaustive pattern matching

commit 599823a6410f1629f2b8704291839e0974bce83b
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Sat Jun 5 19:52:59 2021 +0200

    function written, now needs testing

commit 98a7a04258f2cf6caf9f18925cbeeae2f5b17be4
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Fri Jun 4 16:56:32 2021 +0200

    computing live regs at sb entry from its live output regs

commit 7ae1fb0faea68ce5cfe04a232e49659247c244e9
Author: nicolas.nardino <nicolas.nardino@ens-lyon.fr>
Date:   Fri Jun 4 14:24:07 2021 +0200

    Passing info of live regs to scheduler: beginning

1 files changed, 501 insertions, 2 deletions

diff --git a/scheduling/InstructionScheduler.ml b/scheduling/InstructionScheduler.ml
index eab0b21a..0203d9c8 100644
--- a/scheduling/InstructionScheduler.ml
+++ b/scheduling/InstructionScheduler.ml
@@ -33,6 +33,10 @@ type latency_constraint = {
 type problem = {
   max_latency : int;
   resource_bounds : int array;
+  live_regs_entry : Registers.Regset.t;
+  typing : RTLtyping.regenv;
+  reference_counting : ((Registers.reg, int * int) Hashtbl.t
+                       * ((Registers.reg * bool) list array)) option;
   instruction_usages : int array array;
   latency_constraints : latency_constraint list;
   };;
@@ -118,6 +122,13 @@ let vector_less_equal a b =
     true
   with Exit -> false;;
 
+(* let vector_add a b =
+ *   assert ((Array.length a) = (Array.length b));
+ *   for i=0 to (Array.length a)-1
+ *   do
+ *     b.(i) <- b.(i) + a.(i)
+ *   done;; *)
+
 let vector_subtract a b =
   assert ((Array.length a) = (Array.length b));
   for i=0 to (Array.length a)-1
@@ -257,8 +268,8 @@ let priority_list_scheduler (order : list_scheduler_order)
       assert(!time >= 0);
       !time
     with Exit -> -1
-               
   in
+  
   let advance_time() =
     begin
       (if !current_time < max_time-1
@@ -267,7 +278,8 @@ let priority_list_scheduler (order : list_scheduler_order)
           Array.blit problem.resource_bounds 0 current_resources 0
             (Array.length current_resources);
           ready.(!current_time + 1) <-
-            InstrSet.union (ready.(!current_time)) (ready.(!current_time + 1));
+            InstrSet.union (ready.(!current_time))
+              (ready.(!current_time + 1));
           ready.(!current_time) <- InstrSet.empty;
         end);
       incr current_time
@@ -334,6 +346,485 @@ let list_scheduler = priority_list_scheduler CRITICAL_PATH_ORDER;;
 (* dummy code for placating ocaml's warnings *)
 let _ = fun x -> priority_list_scheduler INSTRUCTION_ORDER x;;
 
+
+(* A scheduler sensitive to register pressure *)
+let reg_pres_scheduler (problem : problem) : solution option =
+  DebugPrint.debug_flag := true;
+
+  let nr_instructions = get_nr_instructions problem in
+
+  if !Clflags.option_debug_compcert > 6 then
+    DebugPrint.debug "SCHEDULING_SUPERBLOCK %d\n" nr_instructions;
+
+  let successors = get_successors problem
+  and predecessors = get_predecessors problem
+  and times = Array.make (nr_instructions+1) (-1) in
+  let live_regs_entry = problem.live_regs_entry in
+
+  let available_regs = Array.copy Machregsaux.nr_regs in
+
+  let nr_types_regs = Array.length available_regs in
+
+  let thres = Array.fold_left (min)
+                (max !(Clflags.option_regpres_threshold) 0)
+                Machregsaux.nr_regs
+  in
+  
+
+  let regs_thresholds = Array.make nr_types_regs thres in
+  (* placeholder value *)
+  
+  let class_r r =
+    Machregsaux.class_of_type (problem.typing r) in
+  
+  let live_regs = Hashtbl.create 42 in
+
+  List.iter (fun r -> let classe = Machregsaux.class_of_type
+                                  (problem.typing r) in
+                   available_regs.(classe)
+                   <- available_regs.(classe) - 1;
+                   Hashtbl.add live_regs r classe)
+    (Registers.Regset.elements live_regs_entry);
+
+  let csr_b = ref false in
+
+  let counts, mentions =
+    match problem.reference_counting with
+    | Some (l, r) -> l, r
+    | None -> assert false
+  in
+  
+  let fold_delta i  = (fun a (r, b) ->
+    a +
+      if class_r r <> i then 0 else
+        (if b then
+           if (Hashtbl.find counts r = (i, 1))
+           then 1 else 0
+         else
+           match Hashtbl.find_opt live_regs r with
+           | None -> -1
+           | Some t -> 0
+  )) in
+  
+  let priorities = critical_paths successors in
+  
+  let current_resources = Array.copy problem.resource_bounds in
+
+  let module InstrSet =
+    struct 
+      module MSet = 
+        Set.Make (struct
+            type t=int
+            let compare x y =
+              match priorities.(y) - priorities.(x) with
+              | 0 -> x - y
+              | z -> z
+          end)
+
+      let empty = MSet.empty
+      let is_empty = MSet.is_empty
+      let add = MSet.add
+      let remove = MSet.remove
+      let union = MSet.union
+      let iter = MSet.iter
+
+      let compare_regs i x y =
+        let pyi = List.fold_left (fold_delta i) 0 mentions.(y) in
+        (* print_int y;
+         * print_string " ";
+         * print_int pyi;
+         * print_newline ();
+         * flush stdout; *)
+        let pxi = List.fold_left (fold_delta i) 0 mentions.(x) in
+        match pyi - pxi with
+        | 0 -> (match priorities.(y) - priorities.(x) with
+               | 0 -> x - y
+               | z -> z)
+        | z -> z
+
+      (** t is the register class *)
+      let sched_CSR t ready usages =
+        (* print_string "looking for max delta";
+         * print_newline ();
+         * flush stdout; *)
+        let result = ref (-1) in
+        iter (fun i ->
+            if vector_less_equal usages.(i) current_resources
+            then if !result = -1 || (compare_regs t !result i > 0)
+                 then result := i) ready;
+        !result
+    end
+  in
+
+  let max_time = bound_max_time problem + 5*nr_instructions in
+  let ready = Array.make max_time InstrSet.empty in
+
+  Array.iteri (fun i preds ->
+      if i < nr_instructions && preds = []
+      then ready.(0) <- InstrSet.add i ready.(0)) predecessors;
+
+  let current_time = ref 0
+  and earliest_time i =
+    try
+      let time = ref (-1) in
+      List.iter (fun (j, latency) ->
+          if times.(j) < 0
+          then raise Exit
+          else let t = times.(j) + latency in
+               if t > !time
+               then time := t) predecessors.(i);
+      assert (!time >= 0);
+      !time
+    with Exit -> -1
+  in
+
+  let advance_time () =
+    (if !current_time < max_time-1
+     then (
+       Array.blit problem.resource_bounds 0 current_resources 0
+         (Array.length current_resources);
+       ready.(!current_time + 1) <-
+         InstrSet.union (ready.(!current_time))
+           (ready.(!current_time +1));
+       ready.(!current_time) <- InstrSet.empty));
+    incr current_time
+  in
+
+  (* ALL MENTIONS TO cnt ARE PLACEHOLDERS *)
+  let cnt = ref 0 in
+
+  let attempt_scheduling ready usages =
+    let result = ref (-1) in
+    try
+      Array.iteri (fun i avlregs ->
+          (* print_string "avlregs: ";
+           * print_int i;
+           * print_string " ";
+           * print_int avlregs;
+           * print_newline ();
+           * print_string "live regs: ";
+           * print_int (Hashtbl.length live_regs);
+           * print_newline ();
+           * flush stdout; *)
+          if avlregs <= regs_thresholds.(i)
+          then (
+            csr_b := true;
+            let maybe = InstrSet.sched_CSR i ready usages in
+            (* print_string "maybe\n";
+             * print_int maybe;
+             * print_newline ();
+             * flush stdout; *)
+            (if maybe > 0 &&
+                  let delta = 
+                    List.fold_left (fold_delta i) 0 mentions.(maybe) in
+                  (* print_string "delta ";
+                   * print_int delta;
+                   * print_newline ();
+                   * flush stdout; *)
+                  delta > 0
+             then
+               (vector_subtract usages.(maybe) current_resources;
+                result := maybe)
+             else
+               if not !Clflags.option_regpres_wait_window
+               then
+                 (InstrSet.iter (fun ins ->
+                      if vector_less_equal usages.(ins) current_resources &&
+                           List.fold_left (fold_delta i) 0 mentions.(maybe) >= 0
+                      then result := ins
+                    ) ready;
+                  if !result <> -1 then
+                    vector_subtract usages.(!result) current_resources)
+               else
+                 (incr cnt)
+            );
+            raise Exit)) available_regs;
+      InstrSet.iter (fun i ->
+          if vector_less_equal usages.(i) current_resources
+          then (
+            vector_subtract usages.(i) current_resources;
+            result := i;
+            raise Exit)) ready;
+      -1
+    with Exit ->
+      !result in
+  
+  while !current_time < max_time
+  do
+    if (InstrSet.is_empty ready.(!current_time))
+    then advance_time ()
+    else
+      match attempt_scheduling ready.(!current_time)
+              problem.instruction_usages with
+      | -1 -> advance_time()
+      | i -> (assert(times.(i) < 0);
+            ((* print_string "INSTR ISSUED: ";
+              * print_int i;
+              * print_newline ();
+              * flush stdout; *)
+             if !csr_b && !Clflags.option_debug_compcert > 6 then
+               DebugPrint.debug "REGPRES: high pres class %d\n" i;
+             csr_b := false;
+             if !Clflags.option_regpres_wait_window then
+               cnt := 0;
+             List.iter (fun (r,b) ->
+                 if b then
+                   (match Hashtbl.find_opt counts r with
+                    | None -> assert false
+                    | Some (t, n) ->
+                       Hashtbl.remove counts r;
+                       if n = 1 then
+                         (Hashtbl.remove live_regs r;
+                          available_regs.(t)
+                          <- available_regs.(t) + 1))
+                 else
+                   let t = class_r r in
+                   match Hashtbl.find_opt live_regs r with
+                   | None -> (Hashtbl.add live_regs r t;
+                             available_regs.(t)
+                             <- available_regs.(t) - 1)
+                   | Some i -> ()
+               ) mentions.(i));
+             times.(i) <- !current_time;
+             ready.(!current_time)
+             <- InstrSet.remove i (ready.(!current_time));
+             List.iter (fun (instr_to, latency) ->
+                 if instr_to < nr_instructions then
+                   match earliest_time instr_to with
+                   | -1 -> ()
+                   | to_time ->
+                      ((* DebugPrint.debug "TO TIME %d : %d\n" to_time
+                        *   (Array.length ready); *)
+                      ready.(to_time)
+                      <- InstrSet.add instr_to ready.(to_time))
+               ) successors.(i);
+             successors.(i) <- []
+            )
+  done;
+
+  try
+    let final_time = ref (-1) in
+    for i = 0 to nr_instructions - 1 do
+      (* print_int i;
+       * flush stdout; *)
+      (if times.(i) < 0 then raise Exit);
+      (if !final_time < times.(i) + 1 then final_time := times.(i) + 1)
+    done;
+    List.iter (fun (i, latency) ->
+        let target_time = latency + times.(i) in
+        if target_time > !final_time then
+          final_time := target_time) predecessors.(nr_instructions);
+    times.(nr_instructions) <- !final_time;
+    DebugPrint.debug_flag := false;
+    Some times
+  with Exit ->
+    DebugPrint.debug "reg_pres_sched failed\n";
+    DebugPrint.debug_flag := false;
+    None
+              
+;;
+
+
+(********************************************************************)
+
+let reg_pres_scheduler_bis (problem : problem) : solution option =
+  DebugPrint.debug_flag := true;
+  Printf.printf "\nNEW\n\n";
+  let nr_instructions = get_nr_instructions problem in
+  let successors = get_successors problem
+  and predecessors = get_predecessors problem
+  and times = Array.make (nr_instructions+1) (-1) in
+  let live_regs_entry = problem.live_regs_entry in
+
+  (* let available_regs = Array.copy Machregsaux.nr_regs in *)
+
+  let class_r r =
+    Machregsaux.class_of_type (problem.typing r) in
+  
+  let live_regs = Hashtbl.create 42 in
+
+  List.iter (fun r -> let classe = Machregsaux.class_of_type
+                                  (problem.typing r) in
+                   (* available_regs.(classe)
+                    * <- available_regs.(classe) - 1; *)
+                   Hashtbl.add live_regs r classe)
+    (Registers.Regset.elements live_regs_entry);
+
+
+  let counts, mentions =
+    match problem.reference_counting with
+    | Some (l, r) -> l, r
+    | None -> assert false
+  in
+  
+  let fold_delta a (r, b) =
+    a + (if b then
+           match Hashtbl.find_opt counts r with
+           | Some (_, 1) -> 1
+           | _ -> 0
+         else
+           match Hashtbl.find_opt live_regs r with
+           | None -> -1
+           | Some t -> 0
+        ) in
+  
+  let priorities = critical_paths successors in
+  
+  let current_resources = Array.copy problem.resource_bounds in
+
+  let compare_pres x y =
+    let pdy = List.fold_left (fold_delta) 0 mentions.(y) in
+    let pdx = List.fold_left (fold_delta) 0 mentions.(x) in
+    match pdy - pdx with
+    | 0 -> x - y
+    | z -> z
+  in
+  
+  let module InstrSet =
+    Set.Make (struct
+        type t = int
+        let compare x y =
+          match priorities.(y) - priorities.(x) with
+          | 0 -> x - y
+          | z -> z
+      end) in
+
+  let max_time = bound_max_time problem (* + 5*nr_instructions *) in
+  let ready = Array.make max_time InstrSet.empty in
+
+  Array.iteri (fun i preds ->
+      if i < nr_instructions && preds = []
+      then ready.(0) <- InstrSet.add i ready.(0)) predecessors;
+
+  let current_time = ref 0
+  and earliest_time i =
+    try
+      let time = ref (-1) in
+      List.iter (fun (j, latency) ->
+          if times.(j) < 0
+          then raise Exit
+          else let t = times.(j) + latency in
+               if t > !time
+               then time := t) predecessors.(i);
+      assert (!time >= 0);
+      !time
+    with Exit -> -1
+  in
+
+  let advance_time () =
+    (* Printf.printf "ADV\n"; 
+     * flush stdout; *)
+    (if !current_time < max_time-1
+     then (
+       Array.blit problem.resource_bounds 0 current_resources 0
+         (Array.length current_resources);
+       ready.(!current_time + 1) <-
+         InstrSet.union (ready.(!current_time))
+           (ready.(!current_time +1));
+       ready.(!current_time) <- InstrSet.empty));
+    incr current_time
+  in
+
+  
+  let attempt_scheduling ready usages =
+    let result = ref [] in
+    try
+      InstrSet.iter (fun i ->
+          if vector_less_equal usages.(i) current_resources
+          then
+            if !result = [] || priorities.(i) = priorities.(List.hd (!result))
+            then
+              result := i::(!result)
+            else raise Exit
+        ) ready;
+      if !result <> [] then raise Exit;
+      -1
+    with
+      Exit ->
+      let mini =  List.fold_left (fun a b ->
+                      if a = -1 || compare_pres a b > 0
+                      then b else a
+                    ) (-1) !result in
+      vector_subtract usages.(mini) current_resources;
+      mini
+  in
+  
+  while !current_time < max_time
+  do
+    if (InstrSet.is_empty ready.(!current_time))
+    then advance_time ()
+    else
+      match attempt_scheduling ready.(!current_time)
+              problem.instruction_usages with
+      | -1 -> advance_time()
+      | i -> (
+        DebugPrint.debug "ISSUED: %d\nREADY: " i;
+        InstrSet.iter (fun i -> DebugPrint.debug "%d " i)
+          ready.(!current_time);
+        DebugPrint.debug "\nSUCC: ";
+        List.iter (fun (i, l) -> DebugPrint.debug "%d " i)
+          successors.(i);
+        DebugPrint.debug "\n\n";
+        assert(times.(i) < 0);
+        times.(i) <- !current_time;
+        ready.(!current_time)
+        <- InstrSet.remove i (ready.(!current_time));
+        (List.iter (fun (r,b) ->
+             if b then
+               (match Hashtbl.find_opt counts r with
+                | None -> assert false
+                | Some (t, n) ->
+                   Hashtbl.remove counts r;
+                   if n = 1 then
+                     (Hashtbl.remove live_regs r;
+               (* available_regs.(t)
+                * <- available_regs.(t) + 1 *)))
+             else
+               let t = class_r r in
+               match Hashtbl.find_opt live_regs r with
+               | None -> (Hashtbl.add live_regs r t;
+                        (* available_regs.(t)
+                         * <- available_regs.(t) - 1 *))
+               | Some i -> ()
+           ) mentions.(i));
+        List.iter (fun (instr_to, latency) ->
+            if instr_to < nr_instructions then
+              match earliest_time instr_to with
+              | -1 -> ()
+              | to_time ->
+                 ((* DebugPrint.debug "TO TIME %d : %d\n" to_time
+                   *   (Array.length ready); *)
+                  ready.(to_time)
+                  <- InstrSet.add instr_to ready.(to_time))
+          ) successors.(i);
+        successors.(i) <- []
+      )
+  done;
+
+  try
+    let final_time = ref (-1) in
+    for i = 0 to nr_instructions - 1 do
+      (* print_int i;
+       * flush stdout; *)
+      (if times.(i) < 0 then raise Exit);
+      (if !final_time < times.(i) + 1 then final_time := times.(i) + 1)
+    done;
+    List.iter (fun (i, latency) ->
+        let target_time = latency + times.(i) in
+        if target_time > !final_time then
+          final_time := target_time) predecessors.(nr_instructions);
+    times.(nr_instructions) <- !final_time;
+    DebugPrint.debug_flag := false;
+    Some times
+  with Exit ->
+    DebugPrint.debug "reg_pres_sched failed\n";
+    DebugPrint.debug_flag := false;
+    None
+              
+;;
+
+(********************************************************************)
+
 type bundle = int list;;
 
 let rec extract_deps_to index = function
@@ -438,6 +929,12 @@ let reverse_problem problem =
   {
     max_latency = problem.max_latency;
     resource_bounds = problem.resource_bounds;
+    live_regs_entry = Registers.Regset.empty; (* PLACEHOLDER *)
+    (* Not needed for the revlist sched, and for now we wont bother
+       with creating a reverse scheduler aware of reg press *)
+    
+    typing = problem.typing;
+    reference_counting = problem.reference_counting;
     instruction_usages = Array.init (nr_instructions + 1)
       (fun i ->
         if i=0
@@ -1259,5 +1756,7 @@ let scheduler_by_name name =
   | "ilp" -> validated_scheduler cascaded_scheduler
   | "list" -> validated_scheduler list_scheduler
   | "revlist" -> validated_scheduler reverse_list_scheduler
+  | "regpres" -> validated_scheduler reg_pres_scheduler
+  | "regpres_bis" -> validated_scheduler reg_pres_scheduler_bis
   | "greedy" -> greedy_scheduler
   | s -> failwith ("unknown scheduler: " ^ s);;