WIP: Generate the body of run_timers

This commit is contained in:
jeltz 2020-12-25 22:23:25 +01:00
parent 58e6a951e4
commit 5346c720d2
Signed by: jeltz
GPG key ID: 800882B66C0C3326
4 changed files with 32 additions and 25 deletions

View file

@ -100,6 +100,9 @@ let qualname_of_string s =
| [] -> (* Misc.internal_error "Names" *)raise Exit
| n::q_l -> { qual = modul_of_string_list q_l; name = n }
let qn_append q suffix =
{ qual = q.qual; name = q.name ^ suffix }
let modul_of_string s =
let q_l = Misc.split_string s "." in
modul_of_string_list (List.rev q_l)

24
compiler/obc/c/async.ml Normal file
View file

@ -0,0 +1,24 @@
open Obc
open C
open Idents
open Names
let async_global_var_name od = "g_async__" ^ (name od.o_ident)
let filter_async_objs cd =
List.filter
(fun od ->
match od.o_ack with
| Some _ -> true
| None -> false)
cd.cd_objs
let async_global_objs_defs cd =
List.map
(fun od ->
let name = async_global_var_name od in
let ty = Cty_id (qn_append od.o_class "_async") in
Cvardef (name, ty))
(filter_async_objs cd)

View file

@ -2,6 +2,7 @@ open Names
open Types
open C
open Obc
open Async
open Async_backend
module AvrBackend : AsyncBackend =
@ -9,9 +10,6 @@ struct
type clock =
| Timer_ms of int
let qn_append q suffix =
{ qual = q.qual; name = q.name ^ suffix }
(* FIXME(Arduino): don't do a shallow copy *)
(* FIXME(Arduino): add a mutex… *)
let gen_copy_func cd suffix =
@ -55,7 +53,9 @@ struct
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 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

View file

@ -34,6 +34,7 @@ open Idents
open Obc
open Obc_utils
open Types
open Async
open Async_avr
open Modules
@ -504,8 +505,6 @@ let step_fun_call vr var_env sig_info objn out args async =
| Some async -> args @ [Caddrof out; Caddrof async]
| None -> args @ [Caddrof out]
let async_global_var_name od = "g_async__" ^ (name od.o_ident)
(** Generate the statement to call [objn].
[outvl] is a list of lhs where to put the results.
[args] is the list of expressions to use as arguments.
@ -703,9 +702,6 @@ let global_name = ref "";;
(** {2 step() and reset() functions generation} *)
let qn_append q suffix =
{ qual = q.qual; name = q.name ^ suffix }
(** Builds the argument list of step function*)
let step_fun_args n md add_mem =
let args = inputlist_of_ovarlist md.m_inputs in
@ -938,22 +934,6 @@ let reset_fun_def_of_class_def cd =
}
}
let filter_async_objs cd =
List.filter
(fun od ->
match od.o_ack with
| Some _ -> true
| None -> false)
cd.cd_objs
let async_global_objs_defs cd =
List.map
(fun od ->
let name = async_global_var_name od in
let ty = Cty_id (qn_append od.o_class "_async") in
Cvardef (name, ty))
(filter_async_objs cd)
(** [cdecl_and_cfun_of_class_def cd] translates the class definition [cd] to
a C program. *)
let cdefs_and_cdecls_of_class_def cd =