jeltz
/
heptagon
1
0
Fork 0
Code Issues Pull Requests Releases Activity

Remove MstepAsync and add stub function for calls

Browse Source
async
jeltz 3 years ago
parent 73db32c6be
commit 9687050f25
Signed by: jeltz
GPG Key ID: 800882B66C0C3326
6 changed files with 212 additions and 169 deletions
Show Stats Download Patch File Download Diff File

6
compiler/main/mls2obc.ml
Unescape Escape View File

@ -601,11 +601,7 @@ and mk_node_call map call_context app loc (name_list : Obc.pattern list) args ty
| Minils.Easync _ -> []
| _ -> assert false
in
let m = match app.Minils.a_op with
| Minils.Easync _ -> MstepAsync
| _ -> Mstep
in
let s = [Acall (name_list, o, m, args)] in
let s = [Acall (name_list, o, Mstep, args)] in
[], si, [obj], s
| _ -> assert false

357
compiler/obc/c/cgen.ml
Unescape Escape View File

@ -77,23 +77,39 @@ struct
raise Errors.Error
end
(* This type describes how of step functions' bodies must access
* their inputs. *)
type step_input =
{ struct_expr : cexpr option;
inputs : var_dec list }
let cvar_step_input var si =
let is_input = List.mem var (List.map (fun v -> v.v_ident) si.inputs) in
match si.struct_expr with
| Some sexp when is_input -> Cfield (sexp, local_qn (name var))
| _ -> Cvar (name var)
let mk_step_input inputs =
{ struct_expr = None; inputs = inputs }
type vars_rewriter =
{ vr_vars : IdentSet.t;
vr_rewrite : ident -> cexpr }
let vr_match vr var = IdentSet.mem var vr.vr_vars
let vr_direct vars =
{ vr_vars = vars;
vr_rewrite = fun var -> Cvar (name var) }
let vr_field st_expr vars =
{ vr_vars = vars;
vr_rewrite = fun var -> Cfield (st_expr, local_qn (name var)) }
let vr_rewrite vr var =
if vr_match vr var then
vr.vr_rewrite var
else
Cvar (name var)
let vr_compose a b =
let rewrite var =
let vr = if vr_match a var then a else b in
vr_rewrite vr var
in
{ vr_rewrite = rewrite;
vr_vars = IdentSet.union a.vr_vars b.vr_vars }
let mk_step_input_packed sexp inputs =
{ struct_expr = Some sexp; inputs = inputs }
let ident_set_of_var_decs vds =
List.fold_left
(fun set vd -> IdentSet.add vd.v_ident set)
IdentSet.empty
vds
let struct_name ty =
match ty with
@ -321,18 +337,18 @@ let rec cexpr_of_static_exp se =
| Stuple _ -> Misc.internal_error "cgen: static tuple"
(** [cexpr_of_exp exp] translates the Obj action [exp] to a C expression. *)
and cexpr_of_exp si out out_env var_env exp =
and cexpr_of_exp vr var_env exp =
match exp.e_desc with
| Eextvalue w -> cexpr_of_ext_value si out out_env var_env w
| Eextvalue w -> cexpr_of_ext_value vr var_env w
(* Operators *)
| Eop(op, exps) -> cop_of_op si out out_env var_env op exps
| Eop(op, exps) -> cop_of_op vr var_env op exps
(* Structure literals. *)
| Estruct (tyn, fl) ->
let cexpr = cexpr_of_exp si out out_env var_env in
let cexpr = cexpr_of_exp vr var_env in
let cexps_assoc = List.rev_map (fun (f, e) -> f, cexpr e) fl in
cexpr_of_struct tyn cexps_assoc
| Earray e_list ->
Carraylit (cexprs_of_exps si out out_env var_env e_list)
Carraylit (cexprs_of_exps vr var_env e_list)
and cexpr_of_struct tyn cexps_assoc =
let cexps = List.fold_left
@ -341,8 +357,8 @@ and cexpr_of_struct tyn cexps_assoc =
(* Reverse `cexps' here because of the previous use of `List.fold_left'. *)
Cstructlit (cname_of_qn tyn, List.rev cexps)
and cexprs_of_exps si out out_env var_env exps =
List.map (cexpr_of_exp si out out_env var_env) exps
and cexprs_of_exps vr var_env exps =
List.map (cexpr_of_exp vr var_env) exps
and cop_of_op_aux op_name cexps = match op_name with
| { qual = Pervasives; name = op } ->
@ -366,22 +382,15 @@ and cop_of_op_aux op_name cexps = match op_name with
Cfun_call("fprintf", file::s::args)
| { name = op } -> Cfun_call(op,cexps)
and cop_of_op si out out_env var_env op_name exps =
let cexps = cexprs_of_exps si out out_env var_env exps in
and cop_of_op vr var_env op_name exps =
let cexps = cexprs_of_exps vr var_env exps in
cop_of_op_aux op_name cexps
and clhs_of_pattern si out out_env var_env l = match l.pat_desc with
and clhs_of_pattern vr var_env l = match l.pat_desc with
(* Each Obc variable corresponds to a real local C variable. *)
| Lvar v ->
let n = name v in
let n_lhs =
if IdentSet.mem v out_env
then CLfield (clhs_of_cexpr out, local_qn n)
(* FIXME(Arduino): This is almost certainly useless, as inputs can't
* be lhs. *)
else clhs_of_cexpr (cvar_step_input v si)
in
let n_lhs = clhs_of_cexpr (vr_rewrite vr v) in
if List.mem_assoc n var_env then
let ty = assoc_type n var_env in
(match ty with
@ -393,24 +402,19 @@ and clhs_of_pattern si out out_env var_env l = match l.pat_desc with
(* Dereference our [self] struct holding the node's memory. *)
| Lmem v -> CLfield (CLderef (CLvar "self"), local_qn (name v))
(* Field access. /!\ Indexed Obj expression should be a valid lhs! *)
| Lfield (l, fn) -> CLfield(clhs_of_pattern si out out_env var_env l, fn)
| Lfield (l, fn) -> CLfield(clhs_of_pattern vr var_env l, fn)
| Larray (l, idx) ->
CLarray(clhs_of_pattern si out out_env var_env l,
cexpr_of_exp si out out_env var_env idx)
CLarray(clhs_of_pattern vr var_env l,
cexpr_of_exp vr var_env idx)
and clhs_list_of_pattern_list si out out_env var_env lhss =
List.map (clhs_of_pattern si out out_env var_env) lhss
and clhs_list_of_pattern_list vr var_env lhss =
List.map (clhs_of_pattern vr var_env) lhss
and cexpr_of_pattern si out out_env var_env l = match l.pat_desc with
and cexpr_of_pattern vr var_env l = match l.pat_desc with
(* Each Obc variable corresponds to a real local C variable. *)
| Lvar v ->
let n = name v in
let n_lhs =
if IdentSet.mem v out_env
then Cfield (out, local_qn n)
else Cvar n
in
let n_lhs = vr_rewrite vr v in
if List.mem_assoc n var_env then
let ty = assoc_type n var_env in
(match ty with
@ -422,22 +426,17 @@ and cexpr_of_pattern si out out_env var_env l = match l.pat_desc with
(* Dereference our [self] struct holding the node's memory. *)
| Lmem v -> Cfield (Cderef (Cvar "self"), local_qn (name v))
(* Field access. /!\ Indexed Obj expression should be a valid lhs! *)
| Lfield (l, fn) -> Cfield(cexpr_of_pattern si out out_env var_env l, fn)
| Lfield (l, fn) -> Cfield(cexpr_of_pattern vr var_env l, fn)
| Larray (l, idx) ->
Carray(cexpr_of_pattern si out out_env var_env l,
cexpr_of_exp si out out_env var_env idx)
Carray(cexpr_of_pattern vr var_env l,
cexpr_of_exp vr var_env idx)
and cexpr_of_ext_value si out out_env var_env w = match w.w_desc with
and cexpr_of_ext_value vr var_env w = match w.w_desc with
| Wconst c -> cexpr_of_static_exp c
(* Each Obc variable corresponds to a plain local C variable. *)
| Wvar v ->
let n = name v in
let n_lhs =
if IdentSet.mem v out_env
then Cfield (out, local_qn n)
else cvar_step_input v si
in
let n_lhs = vr_rewrite vr v in
if List.mem_assoc n var_env then
let ty = assoc_type n var_env in
(match ty with
@ -448,10 +447,10 @@ and cexpr_of_ext_value si out out_env var_env w = match w.w_desc with
(* Dereference our [self] struct holding the node's memory. *)
| Wmem v -> Cfield (Cderef (Cvar "self"), local_qn (name v))
(* Field access. /!\ Indexed Obj expression should be a valid lhs! *)
| Wfield (l, fn) -> Cfield(cexpr_of_ext_value si out out_env var_env l, fn)
| Wfield (l, fn) -> Cfield(cexpr_of_ext_value vr var_env l, fn)
| Warray (l, idx) ->
Carray(cexpr_of_ext_value si out out_env var_env l,
cexpr_of_exp si out out_env var_env idx)
Carray(cexpr_of_ext_value vr var_env l,
cexpr_of_exp vr var_env idx)
let rec assoc_obj instance obj_env =
match obj_env with
@ -474,7 +473,7 @@ let out_var_name_of_objn o =
(** Creates the list of arguments to call a node. [targeting] is the targeting
of the called node, [mem] represents the node context and [args] the
argument list.*)
let step_fun_call si out_v out_env var_env sig_info objn out args =
let step_fun_call vr var_env sig_info objn out args =
let rec add_targeting l ads = match l, ads with
| [], [] -> []
| e::l, ad::ads ->
@ -493,7 +492,7 @@ let step_fun_call si out_v out_env var_env sig_info objn out args =
let rec mk_idx pl = match pl with
| [] -> f
| p::pl ->
Carray (mk_idx pl, cexpr_of_pattern si out_v out_env var_env p)
Carray (mk_idx pl, cexpr_of_pattern vr var_env p)
in
mk_idx l
) in
@ -505,24 +504,30 @@ let step_fun_call si out_v out_env var_env sig_info objn out args =
[outvl] is a list of lhs where to put the results.
[args] is the list of expressions to use as arguments.
[mem] is the lhs where is stored the node's context.*)
let generate_function_call si out_v out_env var_env obj_env outvl objn args =
let generate_function_call vr var_env obj_env outvl objn args =
(* Class name for the object to step. *)
let classln = assoc_cn objn obj_env in
let classn = cname_of_qn classln in
let sig_info = find_value classln in
let out = Cvar (out_var_name_of_objn classn) in
let od = assoc_obj (obj_ref_name objn) obj_env in
let fun_call =
if is_op classln then
cop_of_op_aux classln args
else
(* The step function takes scalar arguments and its own internal memory
holding structure. *)
(* The step function takes scalar arguments and its own internal
memory holding structure. *)
let args =
step_fun_call si out_v out_env var_env sig_info objn out args
step_fun_call vr var_env sig_info objn out args
in
(* Our C expression for the function call. *)
Cfun_call (classn ^ "_step", args)
(* TODO(Arduino):
1. pack arguments in local variable
2. "send" arguments to global variable
3. "retrieve" outputs from global variable
*)
in
(* Act according to the length of our list. Step functions with
@ -540,7 +545,7 @@ let generate_function_call si out_v out_env var_env obj_env outvl objn args =
let ty = assoc_type_lhs outv var_env in
create_affect_stm outv (Cfield (out, local_qn out_name)) ty
in
(Csexpr fun_call)::(List.flatten (map2 create_affect outvl out_sig))
(Csexpr fun_call) :: (List.flatten (map2 create_affect outvl out_sig))
(** Create the statement dest = c where c = v^n^m... *)
let rec create_affect_const var_env (dest : clhs) c =
@ -578,23 +583,23 @@ let rec create_affect_const var_env (dest : clhs) c =
(** [cstm_of_act obj_env mods act] translates the Obj action [act] to a list of
C statements, using the association list [obj_env] to map object names to
class names. *)
let rec cstm_of_act si out out_env var_env obj_env act =
let rec cstm_of_act vr var_env obj_env act =
match act with
(* Cosmetic : cases on boolean values are converted to if statements. *)
| Acase (c, [({name = "true"}, te); ({ name = "false" }, fe)])
| Acase (c, [({name = "false"}, fe); ({ name = "true"}, te)]) ->
let cc = cexpr_of_exp si out out_env var_env c in
let cte = cstm_of_act_list si out out_env var_env obj_env te in
let cfe = cstm_of_act_list si out out_env var_env obj_env fe in
let cc = cexpr_of_exp vr var_env c in
let cte = cstm_of_act_list vr var_env obj_env te in
let cfe = cstm_of_act_list vr var_env obj_env fe in
[Cif (cc, cte, cfe)]
| Acase (c, [({name = "true"}, te)]) ->
let cc = cexpr_of_exp si out out_env var_env c in
let cte = cstm_of_act_list si out out_env var_env obj_env te in
let cc = cexpr_of_exp vr var_env c in
let cte = cstm_of_act_list vr var_env obj_env te in
let cfe = [] in
[Cif (cc, cte, cfe)]
| Acase (c, [({name = "false"}, fe)]) ->
let cc = Cuop ("!", (cexpr_of_exp si out out_env var_env c)) in
let cte = cstm_of_act_list si out out_env var_env obj_env fe in
let cc = Cuop ("!", (cexpr_of_exp vr var_env c)) in
let cte = cstm_of_act_list vr var_env obj_env fe in
let cfe = [] in
[Cif (cc, cte, cfe)]
@ -608,36 +613,36 @@ let rec cstm_of_act si out out_env var_env obj_env act =
let ccl =
List.map
(fun (c,act) -> cname_of_qn c,
cstm_of_act_list si out out_env var_env obj_env act) cl in
[Cswitch (cexpr_of_exp si out out_env var_env e, ccl)]
cstm_of_act_list vr var_env obj_env act) cl in
[Cswitch (cexpr_of_exp vr var_env e, ccl)]
| Ablock b ->
cstm_of_act_list si out out_env var_env obj_env b
cstm_of_act_list vr var_env obj_env b
(* For composition of statements, just recursively apply our
translation function on sub-statements. *)
| Afor ({ v_ident = x }, i1, i2, act) ->
[Cfor(name x, cexpr_of_exp si out out_env var_env i1,
cexpr_of_exp si out out_env var_env i2,
cstm_of_act_list si out out_env var_env obj_env act)]
[Cfor(name x, cexpr_of_exp vr var_env i1,
cexpr_of_exp vr var_env i2,
cstm_of_act_list vr var_env obj_env act)]
(* Translate constant assignment *)
| Aassgn (vn, { e_desc = Eextvalue { w_desc = Wconst c }; }) ->
let vn = clhs_of_pattern si out out_env var_env vn in
let vn = clhs_of_pattern vr var_env vn in
create_affect_const var_env vn c
(* Purely syntactic translation from an Obc local variable to a C
local one, with recursive translation of the rhs expression. *)
| Aassgn (vn, e) ->
let vn = clhs_of_pattern si out out_env var_env vn in
let vn = clhs_of_pattern vr var_env vn in
let ty = assoc_type_lhs vn var_env in
let ce = cexpr_of_exp si out out_env var_env e in
let ce = cexpr_of_exp vr var_env e in
create_affect_stm vn ce ty
(* Our Aop marks an operator invocation that will perform side effects. Just
translate to a simple C statement. *)
| Aop (op_name, args) ->
[Csexpr (cop_of_op si out out_env var_env op_name args)]
[Csexpr (cop_of_op vr var_env op_name args)]
(* Reinitialization of an object variable, extracting the reset
function's name from our environment [obj_env]. *)
@ -657,7 +662,7 @@ let rec cstm_of_act si out out_env var_env obj_env act =
[Csexpr (Cfun_call (classn ^ "_reset", [Caddrof field]))]
| p::pl ->
mk_loop pl
(Carray (field, cexpr_of_pattern si out out_env var_env p))
(Carray (field, cexpr_of_pattern vr var_env p))
in
mk_loop pl field
)
@ -666,20 +671,18 @@ let rec cstm_of_act si out out_env var_env obj_env act =
local structure to hold the results, before allocating to our
variables. *)
| Acall (outvl, objn, Mstep, el) ->
let args = cexprs_of_exps si out out_env var_env el in
let outvl = clhs_list_of_pattern_list si out out_env var_env outvl in
generate_function_call si out out_env var_env obj_env outvl objn args
| Acall (outv1, objn, MstepAsync, e1) ->
(* 1. Atomic copy of the inputs *)
(* 2. Atomic copy of the outputs *)
assert false
let args = cexprs_of_exps vr var_env el in
let outvl = clhs_list_of_pattern_list vr var_env outvl in
generate_function_call vr var_env obj_env outvl objn args
and cstm_of_act_list si out out_env var_env obj_env b =
and cstm_of_act_list vr var_env obj_env b =
let l = List.map cvar_of_vd b.b_locals in
let var_env = l @ var_env in
let cstm = List.flatten
(List.map (cstm_of_act si out out_env var_env obj_env) b.b_body)
(List.map (cstm_of_act vr var_env obj_env) b.b_body)
in
match l with
| [] -> cstm
@ -697,24 +700,17 @@ 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 pack_inputs =
let args =
if pack_inputs then
(* TODO(Arduino): add const qualifier *)
[("_in", Cty_ptr (Cty_id (qn_append n "_in")))]
else
inputlist_of_ovarlist md.m_inputs
in
let step_fun_args n md add_mem =
let args = inputlist_of_ovarlist md.m_inputs in
let out_arg = [("_out", Cty_ptr (Cty_id (qn_append n "_out")))] in
let context_arg =
if is_stateful n then
if is_stateful n && add_mem then
[("self", Cty_ptr (Cty_id (qn_append n "_mem")))]
else
[]
in
args @ out_arg @ context_arg
(** [fun_def_of_step_fun name obj_env mods sf] returns a C function definition
[name ^ "_out"] corresponding to the Obc step function [sf]. The object name
<-> class name mapping [obj_env] is needed to translate internal steps and
@ -725,7 +721,7 @@ let fun_def_of_step_fun n obj_env mem objs md =
let fun_name = (cname_of_qn n) ^ "_step" in
(* Its arguments, translating Obc types to C types and adding our internal
memory structure. *)
let args = step_fun_args n md false in
let args = step_fun_args n md true in
(* Out vars for function calls *)
let out_vars =
@ -737,15 +733,12 @@ let fun_def_of_step_fun n obj_env mem objs md =
(* The body *)
let mems = List.map cvar_of_vd (mem@md.m_outputs) in
let var_env = args @ mems @ out_vars in
let out_env =
List.fold_left
(fun out_env vd -> IdentSet.add vd.v_ident out_env)
IdentSet.empty
md.m_outputs
let vr = vr_compose
(vr_field (Cderef (Cvar "_out")) (ident_set_of_var_decs md.m_outputs))
(vr_direct (ident_set_of_var_decs md.m_inputs))
in
let si = mk_step_input md.m_inputs in
let body =
cstm_of_act_list si (Cderef (Cvar "_out")) out_env var_env obj_env md.m_body
cstm_of_act_list vr var_env obj_env md.m_body
in
Cfundef {
@ -758,12 +751,42 @@ let fun_def_of_step_fun n obj_env mem objs md =
}
}
let async_fun_def_of_step_fun n obj_env mem objs md copy_in_name
copy_out_name =
let async_ty n =
Cty_ptr (Cty_id (qn_append n "_async"))
let async_field_ptr name =
Caddrof (Cfield (Cderef (Cvar "_async"), local_qn name))
let fun_stub_def_of_step_fun n md copy_in copy_out =
let fun_name = (cname_of_qn n) ^ "_step_async_stub" in
let args = (step_fun_args n md false) @ [("_async", async_ty n)] in
let out_vars = [("_in", Cty_id (qn_append n "_in"))] in
let prologue = List.flatten (List.map
(fun (src_name, ty) ->
let src = Cvar src_name in
let dest = CLfield (CLvar "_in", local_qn src_name) in
create_affect_stm dest src ty)
(inputlist_of_ovarlist md.m_inputs))
in
let body = [
Csexpr (Cfun_call (copy_in, [async_field_ptr "in"; Cvar "_in"]));
Csexpr (Cfun_call (copy_out, [Cvar "_out"; async_field_ptr "out"]))
] in
Cfundef {
C.f_name = fun_name;
f_retty = Cty_void;
f_args = args;
f_body = {
var_decls = out_vars;
block_body = prologue @ body
}
}
let async_fun_def_of_step_fun n obj_env mem objs md copy_in copy_out =
let fun_name = (cname_of_qn n) ^ "_async_step" in
(* Its arguments, translating Obc types to C types and adding our internal
memory structure. *)
let args = step_fun_args n md true in
let args = [("_async", async_ty n)] in
(* Out vars for function calls *)
let out_vars =
@ -779,28 +802,37 @@ let async_fun_def_of_step_fun n obj_env mem objs md copy_in_name
["_in"; "_out"]
in
(* TODO(Arduino): Refactor with non-async version *)
(* FIXME(Arduino): it is probably easier to access to self directly from
_async struct pointer, but the string "self" is hardcoded in a large
number of places… *)
let out_vars =
("self", Cty_ptr (Cty_id (qn_append n "_mem"))) :: out_vars
in
(* The body *)
let mems = List.map cvar_of_vd (mem@md.m_outputs) in
let var_env = args @ mems @ out_vars in
let out_env =
List.fold_left
(fun out_env vd -> IdentSet.add vd.v_ident out_env)
IdentSet.empty
md.m_outputs
in
let local_in = Cvar "_local_in" in
let local_out = Cvar "_local_out" in
let async_field_ptr name =
Caddrof (Cfield (Cderef (Cvar "_async"), local_qn name))
in
let si = mk_step_input_packed local_in md.m_inputs in
let l_in = Cvar "_local_in" in
let l_out = Cvar "_local_out" in
let copy_in = Cfun_call (copy_in_name, [Caddrof local_in; Cvar "_in"]) in
(* FIXME(Arduino): rename input & output variables *)
let body =
cstm_of_act_list si local_out out_env var_env obj_env md.m_body
let vr = vr_compose
(vr_field l_out (ident_set_of_var_decs md.m_outputs))
(vr_field l_in (ident_set_of_var_decs md.m_inputs))
in
let copy_out = Cfun_call (copy_out_name, [Cvar "_out"; Caddrof local_out]) in
let prologue = [
Caffect (CLvar "self", async_field_ptr "self");
Csexpr (Cfun_call (copy_in, [Caddrof l_in; async_field_ptr "in"]))
] in
let body = cstm_of_act_list vr var_env obj_env md.m_body in
let epilogue = [
Csexpr (Cfun_call (copy_out, [async_field_ptr "out"; Caddrof l_out]))
] in
Cfundef {
C.f_name = fun_name;
@ -808,7 +840,7 @@ let async_fun_def_of_step_fun n obj_env mem objs md copy_in_name
f_args = args;
f_body = {
var_decls = out_vars;
block_body = (Csexpr copy_in) :: body @ [Csexpr copy_out]
block_body = prologue @ body @ epilogue
}
}
@ -853,16 +885,27 @@ let out_decl_of_class_def cd =
let out_fields = List.map cvar_of_vd step_m.m_outputs in
[Cdecl_struct ((cname_of_qn cd.cd_name) ^ "_out", out_fields)]
let async_decl_of_class_def cd =
let struct_field suffix name =
let qn = qn_append cd.cd_name suffix in
(name, Cty_id qn)
in
let fields = [
struct_field "_in" "in";
struct_field "_out" "out";
struct_field "_mem" "self"
] in
[Cdecl_struct ((cname_of_qn cd.cd_name) ^ "_async", fields)]
(** [reset_fun_def_of_class_def cd] returns the defintion of the C function
tasked to reset the class [cd]. *)
let reset_fun_def_of_class_def cd =
let body =
if cd.cd_stateful then
let var_env = List.map cvar_of_vd cd.cd_mems in
let si = mk_step_input [] in
let vr = vr_direct IdentSet.empty in
let reset = find_reset_method cd in
cstm_of_act_list si (Cderef (Cvar "_out")) IdentSet.empty var_env
cd.cd_objs reset.m_body
cstm_of_act_list vr var_env cd.cd_objs reset.m_body
else
[]
in
@ -888,32 +931,34 @@ let cdefs_and_cdecls_of_class_def cd =
let memory_struct_decl = mem_decl_of_class_def cd in
let in_struct_decl = in_decl_of_class_def cd in
let out_struct_decl = out_decl_of_class_def cd in
let step_fun_def = fun_def_of_step_fun cd.cd_name
cd.cd_objs cd.cd_mems cd.cd_objs step_m in
let async_struct_decl = async_decl_of_class_def cd in
let step = fun_def_of_step_fun cd.cd_name cd.cd_objs cd.cd_mems
cd.cd_objs step_m in
(* TODO(Arduino): let the user choose the backend they want *)
let copy_in_def = AvrBackend.gen_copy_func_in cd in
let copy_out_def = AvrBackend.gen_copy_func_out cd in
let async_step_fun_def = async_fun_def_of_step_fun cd.cd_name
cd.cd_objs cd.cd_mems cd.cd_objs step_m (cdef_name copy_in_def)
(cdef_name copy_out_def) in
let copy_in = AvrBackend.gen_copy_func_in cd in
let copy_out = AvrBackend.gen_copy_func_out cd in
let async_stub =
fun_stub_def_of_step_fun cd.cd_name step_m
(cdef_name copy_in) (cdef_name copy_out)
in
let async_step =
async_fun_def_of_step_fun cd.cd_name cd.cd_objs cd.cd_mems
cd.cd_objs step_m (cdef_name copy_in) (cdef_name copy_out)
in
(* C function for resetting our memory structure. *)
let reset_fun_def = reset_fun_def_of_class_def cd in
let res_fun_decl = cdecl_of_cfundef reset_fun_def in
let step_fun_decl = cdecl_of_cfundef step_fun_def in
let async_step_fun_decl = cdecl_of_cfundef async_step_fun_def in
let copy_in_decl = cdecl_of_cfundef copy_in_def in
let copy_out_decl = cdecl_of_cfundef copy_out_def in
let (decls, defs) =
let reset = reset_fun_def_of_class_def cd in
let defs =
if is_stateful cd.cd_name then
([res_fun_decl; step_fun_decl; copy_in_decl; copy_out_decl;
async_step_fun_decl],
[reset_fun_def; step_fun_def; copy_in_def; copy_out_def;
async_step_fun_def])
[reset; step; copy_in; copy_out; async_stub; async_step]
else
([step_fun_decl], [step_fun_def]) in
[step]
in
let decls = List.map cdecl_of_cfundef defs in
memory_struct_decl @ in_struct_decl @ out_struct_decl @ decls,
defs
memory_struct_decl @ in_struct_decl @ out_struct_decl @ async_struct_decl
@ decls, defs
(** {2 Type translation} *)

1
compiler/obc/java/obc2java.ml
Unescape Escape View File

@ -356,7 +356,6 @@ let rec act_list param_env act_l acts =
in
let copies = Misc.mapi copy_return_to_var p_l in
assgn::(copies@acts)
| Obc.Acall (_, _, MstepAsync, _) -> assert false
| Obc.Acall (_, obj, Mreset, _) ->
let acall = Emethod_call (obj_ref param_env obj, "reset", []) in
Aexp acall::acts

2
compiler/obc/java/obc2java14.ml
Unescape Escape View File

@ -356,8 +356,6 @@ let rec act_list param_env act_l acts =
in
let copies = Misc.mapi copy_return_to_var p_l in
assgn::(copies@acts)
(* TODO(Arduino): Java is not supported (yet?) *)
| Obc.Acall (_, _, MstepAsync, _) -> assert false
| Obc.Acall (_, obj, Mreset, _) ->
let acall = Emethod_call (obj_ref param_env obj, "reset", []) in
Aexp acall::acts

1
compiler/obc/obc.ml
Unescape Escape View File

@ -92,7 +92,6 @@ type obj_ref =
type method_name =
| Mreset
| Mstep
| MstepAsync
type act =
| Aassgn of pattern * exp

14
compiler/obc/obc_printer.ml
Unescape Escape View File

@ -41,6 +41,12 @@ let print_vd ff vd =
print_type ff vd.v_type;
fprintf ff "@]"
let print_ack ff ack =
fprintf ff "@[%s@,%a@]"
ack.ack_name
(print_list_r print_static_exp "("","")")
ack.ack_params
let print_obj ff o =
fprintf ff "@[<v>"; print_ident ff o.o_ident;
fprintf ff " : "; print_qualname ff o.o_class;
@ -48,6 +54,9 @@ let print_obj ff o =
(match o.o_size with
| Some se -> fprintf ff "%a" (print_list_r print_static_exp "[" "][" "]") se
| None -> ());
(match o.o_ack with
| Some ack -> fprintf ff " @[async[%a]@]" print_ack ack
| None -> ());
fprintf ff "@]"
let rec print_lhs ff e =
@ -113,8 +122,6 @@ let print_obj_call ff = function
let print_method_name ff = function
| Mstep -> fprintf ff "step"
| Mreset -> fprintf ff "reset"
| MstepAsync -> fprintf ff "step_async"
let rec print_act ff a =
let print_lhs_tuple ff var_list = match var_list with
@ -166,7 +173,6 @@ and print_tag_act_list ff tag_act_list =
let print_method_name ff = function
| Mreset -> fprintf ff "reset"
| Mstep -> fprintf ff "step"
| MstepAsync -> fprintf ff "step_async"
let print_arg_list ff var_list =
fprintf ff "(@[%a@])" (print_list_r print_vd "" "," "") var_list
@ -200,7 +206,7 @@ let print_class_def ff
end;
if objs <> [] then begin
fprintf ff "@[<hov 4>obj ";
print_list print_obj "" ";" "" ff objs;
print_list print_obj "" "; " "" ff objs;
fprintf ff ";@]@,"
end;
if mem <> [] || objs <> [] then fprintf ff "@,";

Write Preview
Loading…
Cancel
Save