Extract timers from obj_dec.o_ack
This commit is contained in:
parent
9b44a7a7ab
commit
1ba3284031
3 changed files with 49 additions and 4 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue