From 81ad14ab7b1d395bd004d23babc4c1386e0382a5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9onard=20G=C3=A9rard?= <leonard.gerard@ens.fr>
Date: Thu, 20 Oct 2011 16:52:50 +0200
Subject: [PATCH] changed interf_schedule to use clocks correctly

---
 compiler/global/clocks.ml                     |  7 +++
 .../minils/transformations/schedule_interf.ml | 53 +++++++------------
 2 files changed, 25 insertions(+), 35 deletions(-)

diff --git a/compiler/global/clocks.ml b/compiler/global/clocks.ml
index cf43a74..523d33a 100644
--- a/compiler/global/clocks.ml
+++ b/compiler/global/clocks.ml
@@ -130,5 +130,12 @@ let rec last_clock ct = match ct with
   | Ck ck -> ck
   | Cprod l -> last_clock (Misc.last_element l)
 
+(** returns whether [ck1] and [ck2] are leafs of the same clock node :
+  E.g. .... on C1(x) and .... on C2(x) are. *)
+let same_control ck1 ck2 = match ck_repr ck1, ck_repr ck2 with
+  | Cbase, Cbase -> true
+  | Con(_,_,x1), Con(_,_,x2) -> x1 = x2 
+  | Cvar {contents = Cindex i1}, Cvar {contents = Cindex i2} -> i1 = i2
+  | _ -> false
 
 
diff --git a/compiler/minils/transformations/schedule_interf.ml b/compiler/minils/transformations/schedule_interf.ml
index 7b59b4f..6c6c311 100644
--- a/compiler/minils/transformations/schedule_interf.ml
+++ b/compiler/minils/transformations/schedule_interf.ml
@@ -6,11 +6,6 @@ open Mls_utils
 open Misc
 open Sgraph
 
-module EqMap =
-  Map.Make (
-    struct type t = eq
-           let compare = compare
-    end)
 
 let eq_clock eq =
   eq.eq_rhs.e_base_ck
@@ -20,24 +15,7 @@ struct
   open Interference_graph
   open Interference
 
-  (** Returns the minimum of the values in the map.
-      Picks an equation with the clock ck if possible. *)
-  let min_map ck m =
-    let one_min k d (v,eq,same_ck) =
-      match eq with
-        | None -> (d, Some k, eq_clock k = ck)
-        | Some eq ->
-          if d < v then
-            (d, Some k, eq_clock eq = ck)
-          else if d = v & not same_ck & eq_clock eq = ck then
-            (v, Some k, true)
-          else
-            (v, Some eq, same_ck)
-    in
-    let _, eq, _ = EqMap.fold one_min m (0, None, false) in
-      match eq with
-        | None -> assert false
-        | Some eq -> eq
+
 
   (** Remove from the elements the elements whose value is zero or negative. *)
   let remove_null m =
@@ -58,16 +36,6 @@ struct
     in
       IvarSet.fold is_killed (all_ivars_set (InterfRead.read eq)) 0
 
-  (** Compute the cost of all the equations in rem_eqs using var_uses.
-      So far, it uses only the number of killed and defined variables. *)
-  let compute_costs env rem_eqs =
-    let cost eq =
-      let nb_killed_vars = killed_vars eq env in
-      let nb_def_vars = IvarSet.cardinal (all_ivars_set (InterfRead.def eq)) in
-        nb_def_vars - nb_killed_vars
-    in
-      List.fold_left (fun m eq -> EqMap.add eq (cost eq) m) EqMap.empty rem_eqs
-
   (** Initialize the costs data structure. *)
   let init_cost uses inputs =
     let env = IvarSet.fold (add_uses uses) !World.memories IvarEnv.empty in
@@ -84,8 +52,23 @@ struct
 
   (** Returns the next equation, chosen from the list of equations rem_eqs *)
   let next_equation rem_eqs ck env =
-    let eq_cost = compute_costs env rem_eqs in
-      min_map ck eq_cost
+    let cost eq =
+      let nb_killed_vars = killed_vars eq env in
+      let nb_def_vars = IvarSet.cardinal (all_ivars_set (InterfRead.def eq)) in
+        nb_def_vars - nb_killed_vars
+    in
+    let eqs_wcost = List.map (fun eq -> (eq, cost eq)) rem_eqs in
+    let compare_eqs_wcost (_,c1) (_,c2) = compare c1 c2 in
+    let sorted_eqs_wcost = List.stable_sort compare_eqs_wcost eqs_wcost in
+    let rec min_same_ck sorted_eqs = match sorted_eqs with
+      | [] -> Misc.internal_error "no next equation to schedule"
+      | [(eq,_)] -> eq
+      | (eq1,c1)::(eq2,c2)::l ->
+        if (c2 > c1) || (Clocks.same_control (eq_clock eq1) ck)
+        then eq1 (* choosen since either the last with min cost or min and right clock *)
+        else min_same_ck ((eq2,c2)::l)
+    in
+    min_same_ck sorted_eqs_wcost
 end
 
 (** Returns the list of 'free' nodes in the dependency graph (nodes without