Fixed interference of fast memories

A fast memory should be considered alive during
the whole step function when its clock is false.

compiler/global/clocks.ml

@@ -164,11 +164,12 @@ let rec first_ck ct = match ct with
   | Cprod [] -> assert false
   | Cprod (ct::_) -> first_ck ct
 
+let rec list_of_samplers acc ck = match ck with
+  | Cbase | Cvar { contents = Cindex _ } -> acc
+  | Con(ck, c, x) -> list_of_samplers ((c, x)::acc) ck
+  | Cvar { contents = Clink ck } -> list_of_samplers acc ck
+
 let are_disjoint ck1 ck2 =
-  let rec list_of_samplers acc ck = match ck with
-    | Cbase | Cvar _ -> acc
-    | Con(ck, c, x) -> list_of_samplers ((c, x)::acc) ck
-  in
   let rec disjoint_samplers s_ck1 s_ck2 = match s_ck1, s_ck2 with
     | [], _ -> false
     | _ , [] -> false
@@ -179,3 +180,16 @@ let are_disjoint ck1 ck2 =
           c1 <> c2 || disjoint_samplers s_ck1 s_ck2
   in
   disjoint_samplers (list_of_samplers [] ck1) (list_of_samplers [] ck2)
+
+(* returns whether ck1 is included in ck2. *)
+let is_subclock ck1 ck2 =
+  let rec sub_samplers s_ck1 s_ck2 = match s_ck1, s_ck2 with
+    | _, [] -> true
+    | [], _ -> false
+    | (c1, x1)::s_ck1, (c2, x2)::s_ck2 ->
+      if Idents.ident_compare x1 x2 <> 0 then
+        false
+      else
+        c1 = c2 && sub_samplers s_ck1 s_ck2
+  in
+  sub_samplers (list_of_samplers [] ck1) (list_of_samplers [] ck2)

compiler/minils/analysis/interference.ml

@@ -54,6 +54,15 @@ module VarEnv = struct
       add x (IvarSet.add iv (find x env)) env
     else
       add x (IvarSet.singleton iv) env
+
+  let remove_except_mem x env =
+    if mem x env then (
+      let s = IvarSet.filter is_mem_ivar (find x env) in
+      if IvarSet.is_empty s then
+        remove x env
+      else
+        add x s env
+    ) else env
 end
 
 let print_debug fmt =
@@ -214,7 +223,7 @@ module World = struct
       Misc.internal_error "interference"
 
   let rec ivar_type iv = match iv with
-    | Ivar x ->
+    | Ivar x | Imem x ->
         let vd = vd_from_ident x in
           vd.v_type
     | Ifield(_, f) ->
@@ -333,6 +342,11 @@ let all_ivars_list ivs =
   in
   List.fold_left add_one [] ivs
 
+let is_fast_memory x =
+  match ck_repr (World.ivar_clock (Imem x)) with
+    | Cbase -> false
+    | _ -> true
+
 (* TODO: variables with no use ?? *)
 let compute_live_vars eqs =
   let aux (alive_vars, res) eq =
@@ -342,7 +356,7 @@ let compute_live_vars eqs =
     let alive_vars = List.fold_left VarEnv.add_ivar alive_vars read_ivars in
     (* remove vars defined in this equation *)
     let alive_vars =
-      List.fold_left (fun alive_vars id -> VarEnv.remove id alive_vars) alive_vars def_ivars
+      List.fold_left (fun alive_vars id -> VarEnv.remove_except_mem id alive_vars) alive_vars def_ivars
     in
     print_debug "%a@," Mls_printer.print_eq eq;
     print_debug_var_env "alive" alive_vars;
@@ -350,7 +364,12 @@ let compute_live_vars eqs =
     let res = (eq, alive_vars_list)::res in
     alive_vars, res
   in
-  let _, res =  List.fold_left aux (VarEnv.empty, []) (List.rev eqs) in
+  let add_mem x env =
+    if is_fast_memory x then VarEnv.add_ivar env (Imem x) else env
+  in
+  (* Adds all ivars representing memories *)
+  let env = IdentSet.fold add_mem !World.memories VarEnv.empty in
+  let _, res =  List.fold_left aux (env, []) (List.rev eqs) in
     res
 
 (** [should_interfere x y] returns whether variables x and y
@@ -361,22 +380,33 @@ let should_interfere (ivx, ivy) =
   if Global_compare.type_compare tyx tyy <> 0 then
     false
   else (
-   let x_is_mem = World.is_memory (var_ident_of_ivar ivx) in
-   let x_is_when = is_when_ivar ivx in
-   let y_is_mem = World.is_memory (var_ident_of_ivar ivy) in
-   let y_is_when = is_when_ivar ivy in
-   let ckx = World.ivar_clock ivx in
-   let cky = World.ivar_clock ivy in
-   let are_copies = have_same_value_from_ivar ivx ivy in
-   (* a register with a slow clock is still alive even when it is not activated.
-      However, if we read a fast register on a slow rhythm,
-      we can share it with other variables on disjoint slow rhythms as we know
-      that the value of the register will
-      be done at the end of the step. *)
-   let disjoint_clocks =
-     not ((x_is_mem && not x_is_when) || (y_is_mem && not y_is_when)) && Clocks.are_disjoint ckx cky
-   in
-      not (disjoint_clocks or are_copies)
+    match ivx, ivy with
+      | Imem _, Imem _ ->
+        let ckx = World.ivar_clock ivx in
+        let cky = World.ivar_clock ivy in
+        Global_compare.clock_compare ckx cky <> 0
+      | Imem x, iv | iv, Imem x ->
+        let ckx = World.ivar_clock (Imem x) in
+        let ck = World.ivar_clock iv in
+        not (Clocks.is_subclock ck ckx)
+      | _, _ ->
+        let x_is_mem = World.is_memory (var_ident_of_ivar ivx) in
+        let x_is_when = is_when_ivar ivx in
+        let y_is_mem = World.is_memory (var_ident_of_ivar ivy) in
+        let y_is_when = is_when_ivar ivy in
+        let ckx = World.ivar_clock ivx in
+        let cky = World.ivar_clock ivy in
+        let are_copies = have_same_value_from_ivar ivx ivy in
+        (* a register with a slow clock is still alive even when it is not activated.
+           However, if we read a fast register on a slow rhythm,
+           we can share it with other variables on disjoint slow rhythms as we know
+           that the value of the register will
+           be done at the end of the step. *)
+        let disjoint_clocks =
+          not ((x_is_mem && not x_is_when) ||
+                  (y_is_mem && not y_is_when)) && Clocks.are_disjoint ckx cky
+        in
+        not (disjoint_clocks or are_copies)
   )
 
 let should_interfere = Misc.memoize_couple should_interfere
@@ -397,7 +427,13 @@ let init_interference_graph () =
   in
   let env = Env.fold
     (fun _ vd env -> add_ivar env (Ivar vd.v_ident) vd.v_type) !World.vds TyEnv.empty in
-    World.igs := TyEnv.fold (fun ty l acc -> (mk_graph l ty)::acc) env []
+  (* add special nodes for fast memories *)
+  let env =
+    IdentSet.fold
+      (fun x env -> if is_fast_memory x then add_tyenv env (Imem x) else env)
+      !World.memories env
+  in
+  World.igs := TyEnv.fold (fun ty l acc -> (mk_graph l ty)::acc) env []
 
 
 (** Adds interferences between all the variables in
@@ -599,6 +635,12 @@ let add_init_return_eq f =
     (mk_exp Cbase Tinvalid Ltop (tuple_from_dec_and_mem_list f.n_output)) in
     (eq_init::f.n_equs)@[eq_return]
 
+(** Coalesce Imem x and Ivar x *)
+let coalesce_mems () =
+  let coalesce_mem x =
+    if is_fast_memory x then coalesce_from_ivar (Imem x) (Ivar x)
+  in
+  IdentSet.iter coalesce_mem !World.memories
 
 let build_interf_graph f =
   World.init f;
@@ -616,6 +658,8 @@ let build_interf_graph f =
     add_interferences live_vars;
     (* Add interferences between records implied by IField values*)
     add_records_field_interferences ();
+    (* Coalesce all Imem x and Ivar x *)
+    coalesce_mems ();
     (* Splill inputs that are not modified *)
     spill_inputs f;
     (* Spill outputs and memories that are not arrays or struts*)

compiler/obc/transformations/memalloc_apply.ml

@@ -53,7 +53,7 @@ let rec ivar_of_ext_value w = match w.w_desc with
 
 let rec repr_from_ivar env iv =
   match iv with
-    | Ivar x ->
+    | Ivar x | Imem x ->
       (try
          let lhs = Env.find x env in lhs.pat_desc
        with
@@ -66,7 +66,7 @@ let rec repr_from_ivar env iv =
 
 let rec choose_record_field env l = match l with
   | [iv] -> repr_from_ivar env iv
-  | (Ivar _)::l -> choose_record_field env l
+  | (Ivar _)::l | (Imem _)::l -> choose_record_field env l
   | (Ifield(iv,f))::_ -> repr_from_ivar env (Ifield(iv,f))
   | (Iwhen _ )::_ -> assert false
   | [] -> assert false

compiler/utilities/minils/interference2dot.ml

@@ -53,6 +53,7 @@ module DotG = struct
       match iv with
         | Ivar id -> Idents.name id
         | Ifield(ivar, f) -> (ivar_name ivar)^"_"^(Names.shortname f)
+        | Imem id -> "mem("^Idents.name id^")"
         | Iwhen _ -> assert false
     in
       Misc.sanitize_string (ivar_name (List.hd !(V.label v)))

compiler/utilities/minils/interference_graph.ml

@@ -40,6 +40,7 @@ type ivar =
     | Ivar of Idents.var_ident
     | Ifield of ivar * Names.field_name
     | Iwhen of ivar * Clocks.ck
+    | Imem of Idents.var_ident
 
 let rec ivar_compare iv1 iv2 = match iv1, iv2 with
   | Ivar x1, Ivar x2 -> Idents.ident_compare x1 x2
@@ -49,11 +50,17 @@ let rec ivar_compare iv1 iv2 = match iv1, iv2 with
   | Ifield (iiv1, f1), Ifield (iiv2, f2) ->
       let cr = Pervasives.compare f1 f2 in
       if cr <> 0 then cr else ivar_compare iiv1 iiv2
+  | Imem x1, Imem x2 -> Idents.ident_compare x1 x2
 
   | Ivar _, _ -> 1
+
   | Iwhen _, Ivar _ -> -1
   | Iwhen _, _ -> 1
-  | Ifield _, _ -> -1
+
+  | Ifield _, (Ivar _ | Iwhen _) -> -1
+  | Ifield _, _ -> 1
+
+  | Imem _, _ -> -1
 
 module IvarEnv =
     Map.Make (struct
@@ -71,6 +78,7 @@ let rec print_ivar ff iv = match iv with
   | Ivar n -> print_ident ff n
   | Ifield(iv,f) -> fprintf ff "%a.%a" print_ivar iv print_qualname f
   | Iwhen(iv, ck) -> fprintf ff "%a::%a" print_ivar iv print_ck ck
+  | Imem n -> fprintf ff "mem(%a)" print_ident n
 
 let print_ivar_list ff l =
   fprintf ff "@[<2>%a@]" (print_list_r print_ivar "("","")") l
@@ -79,6 +87,7 @@ let rec var_ident_of_ivar iv = match iv with
   | Iwhen (iv, _) -> var_ident_of_ivar iv
   | Ifield (iv, _) -> var_ident_of_ivar iv
   | Ivar x -> x
+  | Imem x -> x
 
 let rec remove_iwhen iv = match iv with
   | Iwhen (iv, _) -> remove_iwhen iv
@@ -92,6 +101,9 @@ let remove_inner_iwhen iv = match iv with
 let is_when_ivar iv = match iv with
   | Iwhen _ -> true
   | _ -> false
+let is_mem_ivar iv = match iv with
+  | Imem _ -> true
+  | _ -> false
 
 module VertexValue = struct
   type t = ivar list ref