You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
111 lines
2.9 KiB
OCaml
111 lines
2.9 KiB
OCaml
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 *)
|
|
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 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 ms_of_ack = function
|
|
| Timer_ms ms -> ms
|
|
|
|
let incr_mod name modulo =
|
|
let one_const = Cconst (Ccint 1) in
|
|
let modulo_const = Cconst (Ccint modulo) in
|
|
let incr = Cbop ("+", Cvar name, one_const) in
|
|
Caffect (CLvar name, Cbop ("%", incr, modulo_const))
|
|
|
|
let call_step_async tick_var (od, ack) =
|
|
let step = (cname_of_qn od.o_class) ^ "_async_step" in
|
|
let global = async_global_var_name od in
|
|
let call = Csexpr (Cfun_call (step, [Caddrof (Cvar global)])) in
|
|
let zero = Cconst (Ccint 0) in
|
|
let timer = Cconst (Ccint (ms_of_ack ack)) in
|
|
let cond = Cbop ("==", Cbop ("%", tick_var, timer), zero) in
|
|
Cif (cond, [call], [])
|
|
|
|
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 lcm_timer = fold_lcm timers in
|
|
let steps =
|
|
List.map (call_step_async (Cvar "tick")) trans
|
|
in
|
|
let incr = incr_mod "tick" lcm_timer in
|
|
steps @ [incr]
|
|
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
|
|
|
|
let main_init = [Csexpr (Cfun_call ("init_timer1", []))]
|
|
|
|
end
|