1 files changed, 106 insertions, 40 deletions

diff --git a/scheduling/InstructionScheduler.ml b/scheduling/InstructionScheduler.ml
index 08164293..8d8c4267 100644
--- a/scheduling/InstructionScheduler.ml
+++ b/scheduling/InstructionScheduler.ml
@@ -35,6 +35,7 @@ type problem = {
   resource_bounds : int array;
   live_regs_entry : Registers.Regset.t;
   typing : RTLtyping.regenv;
+  pressure_deltas : int array array;
   instruction_usages : int array array;
   latency_constraints : latency_constraint list;
   };;
@@ -348,60 +349,124 @@ let reg_pres_scheduler (problem : problem) : solution option =
 
   let available_regs = Array.copy Machregsaux.nr_regs in
 
+  let nr_types_regs = Array.length available_regs in
+
+  let regs_thresholds = Array.init nr_types_regs
+                          (fun i -> 5) in
+  (* placeholder value *)
+
   List.iter (fun r -> let classe = Machregsaux.class_of_type
                                   (problem.typing r) in
                    available_regs.(classe)
                    <- available_regs.(classe) - 1)
     (Registers.Regset.elements live_regs_entry);
 
-  let nr_types_regs = Array.length available_regs in
   
-  (* wait di we have access to instructions here? No, we have to add
-  al this to constraints *)
-  (* let pressures =
-   *   Array.init (nr_instructions) (fun i ->
-   *       Array.init (nr_types_regs) (fun t ->
-   *           match i with
-   *           | Inop -> 0
-   *           | Iop (_, args, dest, _)
-   *           | Iload(_, _, _, args, dest, _) ->
-   *              if
-   *         )) *)
+  let pressures = problem.pressure_deltas in
   
   let priorities = critical_paths successors in
+  
+  let current_resources = Array.copy problem.resource_bounds in
 
-  let module InstrSetCSP =
-    Set.Make (struct
-        type t=int
-        let compare x y =
-          match priorities.(y) - priorities.(x) with
-          | 0 -> x - y
-          | z -> z
-      end) in
-
-  (* TODO: find a way to efficiently find an instruction which
-  decreases register pressure *)
-  (* idea: *)
-  (* let module InstrSetCSR =
-   *   Set.Make (struct
-   *       type t = int
-   *       let compare x y =
-   *         match pressures.(y) - pressures.(x) with
-   *         | 0 -> (match priorities.(y) - priorities.(x) with
-   *                | 0 -> x - y
-   *                | z -> z)
-   *         | z -> z
-   *     end) in *)
-  (* where pressure.(x) is the delta of register pressure for
-  instruction x. Pb: different register types. Need to think about
-  it. Have one module for each register type, that's used when this
-  particular type reach a high pressure? *)
+  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 mem = MSet.mem
+      let add = MSet.add
+      let remove = MSet.remove
+      let union = MSet.union
+      let inter = MSet.inter
+      let iter = MSet.iter
+
+      let compare_regs i x y =
+        match pressures.(y).(i) - pressures.(x).(i) 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 =
+        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
+
+  (* [compare i] is comp function for finding instruction with
+  lowest reg pres delta for reg class i *)
 
   let max_time = bound_max_time problem in
-  let ready = Array.make max_time InstrSetCSP.empty 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
+  
+  let attempt_scheduling ready usages =
+    let result = ref (-1) in
+    try
+      Array.iteri (fun i avlregs ->
+          if avlregs <= regs_thresholds.(i)
+          then (
+            let maybe = InstrSet.sched_CSR i ready usages in
+            (if pressures.(maybe).(i) < 0 then
+              (vector_subtract usages.(maybe) current_resources;
+               result := maybe));
+            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));
+      -1
+    with Exit -> !result in
+  
   (* silence warning, enable compilation while working *)
-  let _ = successors, predecessors, times, ready, nr_types_regs in
+  let _ = successors, predecessors, times, ready, compare,
+          earliest_time, advance_time, nr_types_regs in
   (* PLACEHOLDER *)
   None
 
@@ -515,6 +580,7 @@ let reverse_problem problem =
        with creating a reverse scheduler aware of reg press *)
     
     typing = problem.typing;
+    pressure_deltas = [| [| |] |] ;
     instruction_usages = Array.init (nr_instructions + 1)
       (fun i ->
         if i=0