From 9687050f2542f794dac72c99a9c31f647afbc1c0 Mon Sep 17 00:00:00 2001 From: Tom Barthe Date: Thu, 24 Dec 2020 05:28:47 +0100 Subject: [PATCH] Remove MstepAsync and add stub function for calls --- compiler/main/mls2obc.ml | 6 +- compiler/obc/c/cgen.ml | 357 ++++++++++++++++++-------------- compiler/obc/java/obc2java.ml | 1 - compiler/obc/java/obc2java14.ml | 2 - compiler/obc/obc.ml | 1 - compiler/obc/obc_printer.ml | 14 +- 6 files changed, 212 insertions(+), 169 deletions(-) diff --git a/compiler/main/mls2obc.ml b/compiler/main/mls2obc.ml index 8b6494e..bfa47a5 100644 --- a/compiler/main/mls2obc.ml +++ b/compiler/main/mls2obc.ml @@ -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 diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml index 953a934..0ab7b67 100644 --- a/compiler/obc/c/cgen.ml +++ b/compiler/obc/c/cgen.ml @@ -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} *) diff --git a/compiler/obc/java/obc2java.ml b/compiler/obc/java/obc2java.ml index a2cba51..f3e08a4 100644 --- a/compiler/obc/java/obc2java.ml +++ b/compiler/obc/java/obc2java.ml @@ -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 diff --git a/compiler/obc/java/obc2java14.ml b/compiler/obc/java/obc2java14.ml index 98a8e84..a56dace 100644 --- a/compiler/obc/java/obc2java14.ml +++ b/compiler/obc/java/obc2java14.ml @@ -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 diff --git a/compiler/obc/obc.ml b/compiler/obc/obc.ml index bbf4fe5..042f3b5 100644 --- a/compiler/obc/obc.ml +++ b/compiler/obc/obc.ml @@ -92,7 +92,6 @@ type obj_ref = type method_name = | Mreset | Mstep - | MstepAsync type act = | Aassgn of pattern * exp diff --git a/compiler/obc/obc_printer.ml b/compiler/obc/obc_printer.ml index 208e708..ebfb319 100644 --- a/compiler/obc/obc_printer.ml +++ b/compiler/obc/obc_printer.ml @@ -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 "@["; 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 "@[obj "; - print_list print_obj "" ";" "" ff objs; + print_list print_obj "" "; " "" ff objs; fprintf ff ";@]@," end; if mem <> [] || objs <> [] then fprintf ff "@,";