Extract timers from obj_dec.o_ack

This commit is contained in:
jeltz 2020-12-25 19:16:17 +01:00
parent 9b44a7a7ab
commit 1ba3284031
Signed by: jeltz
GPG key ID: 800882B66C0C3326
3 changed files with 49 additions and 4 deletions

View file

@ -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

View file

@ -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

View file

@ -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