From 1ba3284031449c766a4a5a31d929de56f9c177b3 Mon Sep 17 00:00:00 2001
From: Tom Barthe <tom.barthe@ens-paris-saclay.fr>
Date: Fri, 25 Dec 2020 19:16:17 +0100
Subject: [PATCH] Extract timers from obj_dec.o_ack

---
 compiler/obc/c/async_avr.ml      | 46 ++++++++++++++++++++++++++++++--
 compiler/obc/c/async_backend.mli |  2 +-
 compiler/obc/c/cgen.ml           |  5 +++-
 3 files changed, 49 insertions(+), 4 deletions(-)

diff --git a/compiler/obc/c/async_avr.ml b/compiler/obc/c/async_avr.ml
index 0f37fa9..22c32a6 100644
--- a/compiler/obc/c/async_avr.ml
+++ b/compiler/obc/c/async_avr.ml
@@ -1,10 +1,14 @@
 open Names
+open Types
 open C
 open Obc
 open Async_backend
 
 module AvrBackend : AsyncBackend =
 struct
+  type clock =
+    | Timer_ms of int
+
   let qn_append q suffix =
     { qual = q.qual; name = q.name ^ suffix }
 
@@ -33,7 +37,45 @@ struct
 
   let includes = ["avr"]
 
-  let decls_and_defs classes =
+  let translate_ack { ack_name = name; ack_params = params } =
+    match params with
+      | [{se_desc = Sint ms}] when name = "timer_ms" -> Timer_ms ms
+      | _ -> assert false
+
+  let rec gcd a = function
+    | 0 -> abs a
+    | b -> gcd b (a mod b)
+
+  let fold_gcd l = List.fold_left gcd (List.hd l) (List.tl l)
+
+  let lcm a b = match a, b with
+    | 0, _ | _, 0 -> 0
+    | _ -> abs (a * b) / (gcd a b)
+
+  let fold_lcm l = List.fold_left lcm (List.hd l) (List.tl l)
+
+  let call_step_async base tick_var (od, ack) =
+    Csexpr (Cfun_call ("toto", []))
+
+  let decls_and_defs objs =
+    let trans = List.map
+      (fun od ->
+        let ack = Option.get od.o_ack in
+        (od, translate_ack ack))
+      objs
+    in
+    let timers = List.map
+      (fun (_, ack) -> match ack with Timer_ms ms -> ms)
+      trans
+    in
+    let body = match timers with
+      | [] -> []
+      | _ ->
+         let base_timer = fold_gcd timers in
+         let max_timer = fold_lcm timers in
+         let tick = "mod_ticks" in
+         List.map (call_step_async base_timer (Cvar tick)) trans
+    in
     (* run_timers is declared in avr.h (because of the ISR macro which
      * I don't know how to generate here) *)
     let defs = [
@@ -43,7 +85,7 @@ struct
         f_args = [];
         f_body = {
           var_decls = [];
-          block_body = []
+          block_body = body
         }
       }
     ] in
diff --git a/compiler/obc/c/async_backend.mli b/compiler/obc/c/async_backend.mli
index 8639efc..10d09f9 100644
--- a/compiler/obc/c/async_backend.mli
+++ b/compiler/obc/c/async_backend.mli
@@ -6,5 +6,5 @@ sig
   val gen_copy_func_in : class_def -> cdef
   val gen_copy_func_out : class_def -> cdef
   val includes : string list
-  val decls_and_defs : class_def list -> cdecl list * cdef list
+  val decls_and_defs : obj_dec list -> cdecl list * cdef list
 end
diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml
index 43086e2..c91f73c 100644
--- a/compiler/obc/c/cgen.ml
+++ b/compiler/obc/c/cgen.ml
@@ -1083,9 +1083,12 @@ let global_file_header name prog =
   let dependencies_types = AvrBackend.includes @ dependencies_types in
 
   let classes = program_classes prog in
+  let async_objs = List.flatten
+    (List.map filter_async_objs classes)
+  in
   let decls_and_defs = List.map cdefs_and_cdecls_of_class_def classes in
   let decls_and_defs =
-    (AvrBackend.decls_and_defs classes) :: decls_and_defs
+    (AvrBackend.decls_and_defs async_objs) :: decls_and_defs
   in
   let (decls, defs) = List.split decls_and_defs in
   let decls = List.concat decls