|
|
|
@ -49,6 +49,8 @@ struct
|
|
|
|
|
|
|
|
|
|
let fold_lcm l = List.fold_left lcm (List.hd l) (List.tl l)
|
|
|
|
|
|
|
|
|
|
let fold_gcd l = List.fold_left gcd (List.hd l) (List.tl l)
|
|
|
|
|
|
|
|
|
|
let ms_of_ack = function
|
|
|
|
|
| Timer_ms ms -> ms
|
|
|
|
|
|
|
|
|
@ -58,34 +60,37 @@ struct
|
|
|
|
|
let incr = Cbop ("+", Cvar name, one_const) in
|
|
|
|
|
Caffect (CLvar name, Cbop ("%", incr, modulo_const))
|
|
|
|
|
|
|
|
|
|
let call_step_async tick_var (od, ack) =
|
|
|
|
|
let call_step_async tick_var base (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 timer = Cconst (Ccint (ms_of_ack ack / base)) in
|
|
|
|
|
let cond = Cbop ("==", Cbop ("%", tick_var, timer), zero) in
|
|
|
|
|
Cif (cond, [call], [])
|
|
|
|
|
|
|
|
|
|
let decls_and_defs objs =
|
|
|
|
|
let trans = List.map
|
|
|
|
|
let translate_objs objs =
|
|
|
|
|
List.map
|
|
|
|
|
(fun od ->
|
|
|
|
|
let ack = Option.get od.o_ack in
|
|
|
|
|
(od, translate_ack ack))
|
|
|
|
|
objs
|
|
|
|
|
in
|
|
|
|
|
|
|
|
|
|
let decls_and_defs objs =
|
|
|
|
|
let trans = translate_objs objs in
|
|
|
|
|
let timers = List.map
|
|
|
|
|
(fun (_, ack) -> match ack with Timer_ms ms -> ms)
|
|
|
|
|
(fun (_, ack) -> ms_of_ack ack)
|
|
|
|
|
trans
|
|
|
|
|
in
|
|
|
|
|
let body = match timers with
|
|
|
|
|
| [] -> []
|
|
|
|
|
| _ ->
|
|
|
|
|
let gcd_timer = fold_gcd timers in
|
|
|
|
|
let lcm_timer = fold_lcm timers in
|
|
|
|
|
let steps =
|
|
|
|
|
List.map (call_step_async (Cvar "tick")) trans
|
|
|
|
|
List.map (call_step_async (Cvar "tick") gcd_timer) trans
|
|
|
|
|
in
|
|
|
|
|
let incr = incr_mod "tick" lcm_timer in
|
|
|
|
|
let incr = incr_mod "tick" (lcm_timer / gcd_timer) in
|
|
|
|
|
steps @ [incr]
|
|
|
|
|
in
|
|
|
|
|
(* run_timers is declared in avr.h (because of the ISR macro which
|
|
|
|
@ -105,6 +110,16 @@ struct
|
|
|
|
|
] in
|
|
|
|
|
[], defs
|
|
|
|
|
|
|
|
|
|
let main_init = [Csexpr (Cfun_call ("init_timer1", []))]
|
|
|
|
|
let main_init objs =
|
|
|
|
|
let trans = translate_objs objs in
|
|
|
|
|
let timers = List.map
|
|
|
|
|
(fun (_, ack) -> ms_of_ack ack)
|
|
|
|
|
trans
|
|
|
|
|
in
|
|
|
|
|
match timers with
|
|
|
|
|
| [] -> []
|
|
|
|
|
| _ ->
|
|
|
|
|
let value = fold_gcd timers in
|
|
|
|
|
[Csexpr (Cfun_call ("init_timer1", [Cconst (Ccint value)]))]
|
|
|
|
|
|
|
|
|
|
end
|
|
|
|
|