2020-12-25 22:23:25 +01:00
|
|
|
open Obc
|
|
|
|
open C
|
2020-12-30 02:03:06 +01:00
|
|
|
open Modules
|
2020-12-25 22:23:25 +01:00
|
|
|
open Idents
|
|
|
|
open Names
|
2020-12-30 02:03:06 +01:00
|
|
|
open Signature
|
2020-12-25 22:23:25 +01:00
|
|
|
|
|
|
|
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
|
|
|
|
|
2020-12-26 04:28:39 +01:00
|
|
|
let async_global_objs_vars cd =
|
2020-12-25 22:23:25 +01:00
|
|
|
List.map
|
|
|
|
(fun od ->
|
|
|
|
let name = async_global_var_name od in
|
|
|
|
let ty = Cty_id (qn_append od.o_class "_async") in
|
2020-12-26 04:28:39 +01:00
|
|
|
name, ty)
|
2020-12-25 22:23:25 +01:00
|
|
|
(filter_async_objs cd)
|
|
|
|
|
2020-12-26 04:28:39 +01:00
|
|
|
let async_global_objs_defs cd =
|
|
|
|
List.map
|
|
|
|
(fun (name, ty) -> Cvardef (name, ty))
|
|
|
|
(async_global_objs_vars cd)
|
|
|
|
|
|
|
|
let async_global_objs_decls cd =
|
|
|
|
List.map
|
|
|
|
(fun (name, ty) -> Cdecl_extern (name, ty))
|
|
|
|
(async_global_objs_vars cd)
|
2020-12-25 22:23:25 +01:00
|
|
|
|
2020-12-30 02:03:06 +01:00
|
|
|
let od_is_stateful od =
|
|
|
|
let sig_info = find_value od.o_class in
|
|
|
|
sig_info.node_stateful
|
|
|
|
|
2020-12-30 01:28:36 +01:00
|
|
|
let async_reset cd =
|
2020-12-30 02:03:06 +01:00
|
|
|
let async_objs = filter_async_objs cd in
|
|
|
|
let stateful = List.filter od_is_stateful async_objs in
|
2020-12-30 01:28:36 +01:00
|
|
|
List.map
|
|
|
|
(fun od ->
|
|
|
|
let global = Cvar (async_global_var_name od) in
|
2020-12-30 02:03:06 +01:00
|
|
|
let field = Cfield (global, local_qn "self") in
|
2020-12-30 01:28:36 +01:00
|
|
|
let reset = cname_of_qn od.o_class ^ "_reset" in
|
|
|
|
Csexpr (Cfun_call (reset, [Caddrof field])))
|
2020-12-30 02:03:06 +01:00
|
|
|
stateful
|
2020-12-30 01:28:36 +01:00
|
|
|
|