heptagon/compiler/obc/c/async_avr.ml

open Names
open Types
open C
open Obc
open Async
open Async_backend

module AvrBackend : AsyncBackend =
struct
  type clock =
    | Timer_ms of int

  (* FIXME(Arduino): don't do a shallow copy *)
  (* FIXME(Arduino): add a mutex… *)
  let gen_copy_func cd suffix =
    let func_name = (cname_of_qn cd.cd_name) ^ "_copy" ^ suffix in
    (* TODO(Arduino): add const qualifier *)
    let arg_ty = Cty_ptr (Cty_id (qn_append cd.cd_name suffix)) in
    let sizeof = Cfun_call ("sizeof", [Cderef (Cvar "src")]) in
    let memcpy =
      Cfun_call ("atomic_memcpy", [Cvar "dest"; Cvar "src"; sizeof])
    in
    Cfundef {
      C.f_name = func_name;
      f_retty = Cty_void;
      f_args = [("dest", arg_ty); ("src", arg_ty)];
      f_body = {
       var_decls = [];
       block_body = [Csexpr memcpy] }
    }

  let gen_copy_func_in cd = gen_copy_func cd "_in"

  let gen_copy_func_out cd = gen_copy_func cd "_out"

  let includes = ["avr"]

  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) =
    let step = (cname_of_qn od.o_class) ^ "_async_step" in
    let global = async_global_var_name od in
    Csexpr (Cfun_call (step, [Caddrof (Cvar global)]))

  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 tick = "mod_ticks" in
    let body = match timers with
      | [] -> []
      | _ ->
         let base_timer = fold_gcd timers in
         let max_timer = fold_lcm timers 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 = [
      Cfundef {
        C.f_name = "run_timers";
        f_retty = Cty_void;
        f_args = [];
        f_body = {
          var_decls = [
            mk_vardecl_val ~static:true tick Cty_int (Cconst (Ccint 0))
          ];
          block_body = body
        }
      }
    ] in
    [], defs

end