fixing

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

4 files changed, 139 insertions, 53 deletions

diff --git a/scheduling/InstructionScheduler.ml b/scheduling/InstructionScheduler.ml
index 08349f60..19bfaeb0 100644
--- a/scheduling/InstructionScheduler.ml
+++ b/scheduling/InstructionScheduler.ml
@@ -36,7 +36,7 @@ type problem = {
   live_regs_entry : Registers.Regset.t;
   typing : RTLtyping.regenv;
   reference_counting : ((Registers.reg, int * int) Hashtbl.t
-                       * (Registers.reg list array)) option;
+                       * ((Registers.reg * bool) list array)) option;
   instruction_usages : int array array;
   latency_constraints : latency_constraint list;
   };;
@@ -363,15 +363,37 @@ let reg_pres_scheduler (problem : problem) : solution option =
   let regs_thresholds = Array.init nr_types_regs
                           (fun i -> 5) 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)
+                   <- 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 pressures = [| [| |] |] 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
   
@@ -396,7 +418,14 @@ let reg_pres_scheduler (problem : problem) : solution option =
       let iter = MSet.iter
 
       let compare_regs i x y =
-        match pressures.(y).(i) - pressures.(x).(i) with
+        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)
@@ -404,10 +433,13 @@ let reg_pres_scheduler (problem : problem) : solution option =
 
       (** 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 if !result = -1 || (compare_regs t !result i > 0)
                  then result := i) ready;
         !result
     end
@@ -451,13 +483,28 @@ let reg_pres_scheduler (problem : problem) : solution option =
     let result = ref (-1) in
     try
       Array.iteri (fun i avlregs ->
+          print_string "avlregs: ";
+          print_int i;
+          print_string " ";
+          print_int avlregs;
+          print_newline ();
+          flush stdout;
           if avlregs <= regs_thresholds.(i)
           then (
             let maybe = InstrSet.sched_CSR i ready usages in
-            (* print_int maybe;
-             * print_newline ();
-             * flush stdout; *)
-            if maybe > 0 && pressures.(maybe).(i) < 0 then
+            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;
                raise Exit))) available_regs;
@@ -470,7 +517,23 @@ let reg_pres_scheduler (problem : problem) : solution option =
       -1
     with Exit ->
           if !result <> -1 then
-            vector_subtract pressures.(!result) available_regs;
+            (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
+                         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.(!result));
           !result in
   
   while !current_time < max_time
diff --git a/scheduling/InstructionScheduler.mli b/scheduling/InstructionScheduler.mli
index 9b6f7a3c..b5a5463b 100644
--- a/scheduling/InstructionScheduler.mli
+++ b/scheduling/InstructionScheduler.mli
@@ -30,7 +30,7 @@ type problem = {
     (** Register type map. *)
     
     reference_counting : ((Registers.reg, int * int) Hashtbl.t
-                       * (Registers.reg list array)) option;
+                       * ((Registers.reg * bool) list array)) option;
     (** See RTLpathScheduleraux.reference_counting. *)
     
     instruction_usages: int array array;
diff --git a/scheduling/RTLpathScheduleraux.ml b/scheduling/RTLpathScheduleraux.ml
index 02e0c769..9c3ff689 100644
--- a/scheduling/RTLpathScheduleraux.ml
+++ b/scheduling/RTLpathScheduleraux.ml
@@ -76,12 +76,17 @@ end
  ** [(r,(t, n)], where [r] is a pseudo-register (Registers.reg),
  ** [t] is its class (according to [typing]), and [n] the number of
  ** times it's referenced as an argument in instructions of [seqa] ;
- ** and an arrray containg the argument regset of each instruction *)
+ ** and an arrray containg the list of regs referenced by each
+ ** instruction, with a boolean to know whether it's as arg or dest *)
 let reference_counting (seqa : (instruction * Regset.t) array)
       (out_regs : Registers.Regset.t) (typing : RTLtyping.regenv) :
-      (Registers.reg, int * int) Hashtbl.t * Registers.reg list array =
+      (Registers.reg, int * int) Hashtbl.t *
+        (Registers.reg * bool) list  array =
   let retl = Hashtbl.create 42 in
   let retr = Array.make (Array.length seqa) [] in
+  (* retr.(i) : (r, b) -> (r', b') -> ...
+     where b = true if seen as arg, false if seen as dest
+   *)
   List.iter (fun reg ->
       Hashtbl.add retl
         reg (Machregsaux.class_of_type (typing reg), 1)
@@ -92,35 +97,53 @@ let reference_counting (seqa : (instruction * Regset.t) array)
     | None -> Hashtbl.add retl reg (Machregsaux.class_of_type
                                     (typing reg), 1)
   in
+  let map_true = List.map (fun r -> r, true) in
   Array.iteri (fun i  (ins, _) ->
       match ins with
-      | Iop(_,args,_,_) | Iload(_,_,_,args,_,_)
+      | Iop(_,args,dest,_) | Iload(_,_,_,args,dest,_) ->
+         List.iter (add_reg) args;
+         retr.(i) <- (dest, false)::(map_true args)
       | Icond(_,args,_,_,_) ->
          List.iter (add_reg) args;
-         retr.(i) <- args
+         retr.(i) <- map_true args
       | Istore(_,_,args,src,_) ->
          List.iter (add_reg) args;
          add_reg src;
-         retr.(i) <- src::args
-      | Icall(_,fn,args,_,_) | Itailcall(_,fn,args) ->
+         retr.(i) <- (src, true)::(map_true args)
+      | Icall(_,fn,args,dest,_) ->
+         List.iter (add_reg) args;
+         retr.(i) <- (match fn with
+                     | Datatypes.Coq_inl reg ->
+                        add_reg reg;
+                        (dest,false)::(reg, true)::(map_true args)
+                     | _ -> (dest,false)::(map_true args))
+
+        | Itailcall(_,fn,args) ->
          List.iter (add_reg) args;
          retr.(i) <- (match fn with
                      | Datatypes.Coq_inl reg ->
                         add_reg reg;
-                        reg::args
-                     | _ -> args)
-      | Ibuiltin(_,args,_,_) ->
+                        (reg, true)::(map_true args)
+                     | _ -> map_true args)
+      | Ibuiltin(_,args,dest,_) ->
          let rec bar = function
            | AST.BA r -> add_reg r;
-                        retr.(i) <- r::retr.(i)
+                        retr.(i) <- (r, true)::retr.(i)
            | AST.BA_splitlong  (hi, lo) | AST.BA_addptr (hi, lo) ->
               bar hi; bar lo
            | _ -> ()
          in
-         List.iter (bar) args
+         List.iter (bar) args;
+         let rec bad = function
+           | AST.BR r -> retr.(i) <- (r, false)::retr.(i)
+           | AST.BR_splitlong (hi, lo) ->
+              bad hi; bad lo
+           | _ -> ()
+         in
+         bad dest;
       | Ijumptable (reg,_) | Ireturn (Some reg) ->
          add_reg reg;
-         retr.(i) <- [reg]
+         retr.(i) <- [reg, true]
       | _ -> ()
     ) seqa;
   retl, retr
diff --git a/test/nardino/scheduling/spille_forw.c b/test/nardino/scheduling/spille_forw.c
index 770dfce5..db88588b 100644
--- a/test/nardino/scheduling/spille_forw.c
+++ b/test/nardino/scheduling/spille_forw.c
@@ -91,36 +91,36 @@ int f(int n, float * arr) {
 	float a30 = (float) n+29;
 	float b30 = 2.*a30;
 	c += a30;
-	arr[0] = a1;
-	arr[1] = a2;
-	arr[2] = a3;
-	arr[3] = a4;
-	arr[4] = a5;
-	arr[5] = a6;
-	arr[6] = a7;
-	arr[7] = a8;
-	arr[8] = a9;
-	arr[9] = a10;
-	arr[10] = a11;
-	arr[11] = a12;
-	arr[12] = a13;
-	arr[13] = a14;
-	arr[14] = a15;
-	arr[15] = a16;
-	arr[16] = a17;
-	arr[17] = a18;
-	arr[18] = a19;
-	arr[19] = a20;
-	arr[20] = a21;
-	arr[21] = a22;
-	arr[22] = a23;
-	arr[23] = a24;
-	arr[24] = a25;
-	arr[25] = a26;
-	arr[26] = a27;
-	arr[27] = a28;
-	arr[28] = a29;
-	arr[29] = a30;
+	/* arr[0] = a1; */
+	/* arr[1] = a2; */
+	/* arr[2] = a3; */
+	/* arr[3] = a4; */
+	/* arr[4] = a5; */
+	/* arr[5] = a6; */
+	/* arr[6] = a7; */
+	/* arr[7] = a8; */
+	/* arr[8] = a9; */
+	/* arr[9] = a10; */
+	/* arr[10] = a11; */
+	/* arr[11] = a12; */
+	/* arr[12] = a13; */
+	/* arr[13] = a14; */
+	/* arr[14] = a15; */
+	/* arr[15] = a16; */
+	/* arr[16] = a17; */
+	/* arr[17] = a18; */
+	/* arr[18] = a19; */
+	/* arr[19] = a20; */
+	/* arr[20] = a21; */
+	/* arr[21] = a22; */
+	/* arr[22] = a23; */
+	/* arr[23] = a24; */
+	/* arr[24] = a25; */
+	/* arr[25] = a26; */
+	/* arr[26] = a27; */
+	/* arr[27] = a28; */
+	/* arr[28] = a29; */
+	/* arr[29] = a30; */
 	return c +
 		b1+
 		b2+