From 35775c41313bd1e50d7561d6becdfd5887bf3fc1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= Date: Tue, 8 Mar 2011 09:22:02 +0100 Subject: [PATCH] C backend ported to recent API changes in Obc --- compiler/TODO.txt | 6 +++++ compiler/global/names.ml | 1 + compiler/minils/main/mls2seq.ml | 2 +- compiler/obc/c/c.ml | 19 ++++++++-------- compiler/obc/c/cgen.ml | 24 +++++++++++--------- compiler/obc/c/cmain.ml | 25 ++++++++++----------- compiler/obc/obc_utils.ml | 10 ++++----- compiler/utilities/global/compiler_utils.ml | 3 ++- 8 files changed, 51 insertions(+), 39 deletions(-) create mode 100755 compiler/TODO.txt diff --git a/compiler/TODO.txt b/compiler/TODO.txt new file mode 100755 index 0000000..a97125e --- /dev/null +++ b/compiler/TODO.txt @@ -0,0 +1,6 @@ +- Ne plus forcer l'ordre constantes puis types puis definitions de noeud. Il +faudra mettre à jour les phases du compilateur et modifier l'ast. +- Ajouter des constantes locales + +- supprimer pinst dans minils +- heptcheck diff --git a/compiler/global/names.ml b/compiler/global/names.ml index e747922..3f64dab 100644 --- a/compiler/global/names.ml +++ b/compiler/global/names.ml @@ -43,6 +43,7 @@ module QualEnv = struct end module QualSet = Set.Make (struct type t = qualname let compare = compare end) +module ModulSet = Set.Make (struct type t = modul let compare = compare end) module S = Set.Make (struct type t = string let compare = compare end) diff --git a/compiler/minils/main/mls2seq.ml b/compiler/minils/main/mls2seq.ml index d13103c..d707659 100644 --- a/compiler/minils/main/mls2seq.ml +++ b/compiler/minils/main/mls2seq.ml @@ -38,7 +38,7 @@ let write_obc_file p = close_out obc; comment "Generation of Obc code" -let targets = [ (*"c", Obc_no_params Cmain.program;*) +let targets = [ "c", Obc_no_params Cmain.program; "java", Obc Java_main.program; "obc", Obc write_obc_file; "obc_np", Obc_no_params write_obc_file; diff --git a/compiler/obc/c/c.ml b/compiler/obc/c/c.ml index a08e435..716bb3c 100644 --- a/compiler/obc/c/c.ml +++ b/compiler/obc/c/c.ml @@ -75,7 +75,6 @@ and cexpr = | Caddrof of clhs (** Take the address of a left-hand-side expression. *) | Cstructlit of string * cexpr list (** Structure literal "{ f1, f2, ... }".*) | Carraylit of cexpr list (** Array literal [\[e1, e2, ...\]]. *) - | Cmethod_call of cexpr * string * cexpr list (** Object member function call with parameters. *) and cconst = | Ccint of int (** Integer constant. *) | Ccfloat of float (** Floating-point number constant. *) @@ -156,11 +155,14 @@ let rec pp_list f sep fmt l = match l with let pp_string fmt s = fprintf fmt "%s" (cname_of_name s) -let cname_of_qn q = - if q.qual = Pervasives or q.qual = Names.local_qualname then - q.name - else - (q.qual ^ "__" ^ q.name) +let rec modul_to_cname q = match q with + | Pervasives | LocalModule -> "" + | Module m -> m ^ "__" + | QualModule { qual = q; name = n } -> + (modul_to_cname q)^n^"__" + +let cname_of_qn qn = + (modul_to_cname qn.qual) ^ qn.name let pp_qualname fmt q = pp_string fmt (cname_of_qn q) @@ -173,7 +175,6 @@ let rec pp_cty fmt cty = match cty with | Cty_ptr cty' -> fprintf fmt "%a*" pp_cty cty' | Cty_arr (n, cty') -> fprintf fmt "%a[%d]" pp_cty cty' n | Cty_void -> fprintf fmt "void" - | Cty_future cty' -> fprintf fmt "future<%a>" pp_cty cty' (** [pp_array_decl cty] returns the base type of a (multidimensionnal) array and the string of indices. *) @@ -243,8 +244,8 @@ and pp_cexpr fmt ce = match ce with | Caddrof lhs -> fprintf fmt "&%a" pp_clhs lhs | Cstructlit (s, el) -> fprintf fmt "(%a){@[%a@]}" pp_string s (pp_list1 pp_cexpr ",") el - | Carraylit el -> - fprintf fmt "((int []){@[%a@]})" (pp_list1 pp_cexpr ",") el (* TODO master : WRONG *) + | Carraylit el -> (* TODO master : WRONG *) + fprintf fmt "((int []){@[%a@]})" (pp_list1 pp_cexpr ",") el and pp_clhs fmt lhs = match lhs with | Cvar s -> pp_string fmt s diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml index 78c5e75..9938641 100644 --- a/compiler/obc/c/cgen.ml +++ b/compiler/obc/c/cgen.ml @@ -13,6 +13,7 @@ open Misc open Names open Idents open Obc +open Obc_utils open Types open Modules @@ -343,7 +344,7 @@ let rec assoc_obj instance obj_env = match obj_env with | [] -> raise Not_found | od :: t -> - if od.o_name = instance + if od.o_ident = instance then od else assoc_obj instance t @@ -364,10 +365,10 @@ let step_fun_call var_env sig_info objn out args = if sig_info.node_statefull then ( let mem = (match objn with - | Oobj o -> Cfield (Cderef (Cvar "self"), local_qn o) + | Oobj o -> Cfield (Cderef (Cvar "self"), local_qn (name o)) | Oarray (o, l) -> let l = clhs_of_lhs var_env l in - Carray (Cfield (Cderef (Cvar "self"), local_qn o), Clhs l) + Carray (Cfield (Cderef (Cvar "self"), local_qn (name o)), Clhs l) ) in args@[Caddrof out; Caddrof mem] ) else @@ -427,7 +428,7 @@ let rec create_affect_const var_env dest c = let dest = Carray (dest, Cconst (Ccint i)) in (i - 1, create_affect_const var_env dest c @ affl) in snd (List.fold_right create_affect_idx cl (List.length cl - 1, [])) - | _ -> [Caffect (dest, cexpr_of_exp var_env (mk_exp (Econst c)))] + | _ -> [Caffect (dest, cexpr_of_static_exp 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 @@ -465,9 +466,12 @@ let rec cstm_of_act var_env obj_env act = cstm_of_act_list var_env obj_env act) cl in [Cswitch (cexpr_of_exp var_env e, ccl)] + | Ablock b -> + cstm_of_act_list var_env obj_env b + (** For composition of statements, just recursively apply our translation function on sub-statements. *) - | Afor (x, i1, i2, act) -> + | Afor ({ v_ident = x; _ }, i1, i2, act) -> [Cfor(name x, int_of_static_exp i1, int_of_static_exp i2, cstm_of_act_list var_env obj_env act)] @@ -495,10 +499,10 @@ let rec cstm_of_act var_env obj_env act = (match obj.o_size with | None -> [Csexpr (Cfun_call (classn ^ "_reset", - [Caddrof (Cfield (Cderef (Cvar "self"), local_qn on))]))] + [Caddrof (Cfield (Cderef (Cvar "self"), local_qn (name on)))]))] | Some size -> let x = gen_symbol () in - let field = Cfield (Cderef (Cvar "self"), local_qn on) in + let field = Cfield (Cderef (Cvar "self"), local_qn (name on)) in let elt = [Caddrof( Carray(field, Clhs (Cvar x)) )] in [Cfor(x, 0, int_of_static_exp size, [Csexpr (Cfun_call (classn ^ "_reset", elt ))] )] @@ -595,7 +599,7 @@ let mem_decl_of_class_def cd = let ty = match od.o_size with | Some se -> Cty_arr (int_of_static_exp se, ty) | None -> ty in - (od.o_name, ty)::l + (name od.o_ident, ty)::l else l in @@ -740,8 +744,8 @@ let cfile_list_of_oprog_ty_decls name oprog = filename_types, [types_h; types_c] let global_file_header name prog = - let dependencies = S.elements (Obc_utils.Deps.deps_program prog) in - let dependencies = List.map String.uncapitalize dependencies in + let dependencies = ModulSet.elements (Obc_utils.Deps.deps_program prog) in + let dependencies = List.map modul_to_string dependencies in let (decls, defs) = List.split (List.map cdefs_and_cdecls_of_class_def prog.p_defs) in diff --git a/compiler/obc/c/cmain.ml b/compiler/obc/c/cmain.ml index ac48398..7813311 100644 --- a/compiler/obc/c/cmain.ml +++ b/compiler/obc/c/cmain.ml @@ -13,6 +13,7 @@ open Misc open Names open Idents open Obc +open Obc_utils open Types open Modules open Signature @@ -258,9 +259,8 @@ let main_skel var_list prologue body = } let mk_main name p = - match (!Compiler_options.simulation_node, !Compiler_options.assert_nodes) with - | (None, []) -> [] - | (_, n_names) -> + if !Compiler_options.simulation then ( + let n_names = !Compiler_options.assert_nodes in let find_class n = try List.find (fun cd -> cd.cd_name.name = n) p.p_defs with Not_found -> @@ -275,18 +275,16 @@ let mk_main name p = (var @ var_l, res :: res_l, step :: step_l) in List.fold_right add a_classes ([], [], []) in - let (_, var_l, res_l, step_l) = - (match !Compiler_options.simulation_node with - | None -> (n_names, var_l, res_l, step_l) - | Some n -> - let (nvar_l, res, nstep_l) = - main_def_of_class_def (find_class n) in - (n :: n_names, nvar_l @ var_l, - res :: res_l, nstep_l @ step_l)) in + let n = !Compiler_options.simulation_node in + let (nvar_l, res, nstep_l) = main_def_of_class_def (find_class n) in + let (var_l, res_l, step_l) = + (nvar_l @ var_l, res :: res_l, nstep_l @ step_l) in [("_main.c", Csource [main_skel var_l res_l step_l]); ("_main.h", Cheader ([name], []))]; -;; + ) else + [] + (******************************) @@ -297,7 +295,8 @@ let translate name prog = (global_file_header modname prog) @ (mk_main name prog) let program p = - let filename = filename_of_name (cname_of_name p.p_modname) in + let filename = + filename_of_name (cname_of_name (modul_to_string p.p_modname)) in let dirname = build_path (filename ^ "_c") in let dir = clean_dir dirname in let c_ast = translate filename p in diff --git a/compiler/obc/obc_utils.ml b/compiler/obc/obc_utils.ml index b9c2348..b701605 100644 --- a/compiler/obc/obc_utils.ml +++ b/compiler/obc/obc_utils.ml @@ -109,11 +109,12 @@ let remove_resets b = b -(* module Deps = struct - let deps_longname deps { qual = modn; } = S.add modn deps + let deps_longname deps qn = match qn.qual with + | Module _ | QualModule _ -> ModulSet.add qn.qual deps + | _ -> deps let deps_static_exp_desc funs deps sedesc = let (sedesc, deps) = Global_mapfold.static_exp_desc funs deps sedesc in @@ -162,7 +163,6 @@ struct act = deps_act; obj_dec = deps_obj_dec; } in - let (_, deps) = Obc_mapfold.program funs S.empty p in - S.remove p.p_modname (S.remove Pervasives deps) + let (_, deps) = Obc_mapfold.program funs ModulSet.empty p in + ModulSet.remove p.p_modname deps end -*) \ No newline at end of file diff --git a/compiler/utilities/global/compiler_utils.ml b/compiler/utilities/global/compiler_utils.ml index c407cb0..e496733 100644 --- a/compiler/utilities/global/compiler_utils.ml +++ b/compiler/utilities/global/compiler_utils.ml @@ -58,7 +58,8 @@ let silent_pass d enabled f p = then do_silent_pass d f p else p - +let filename_of_name n = + String.uncapitalize n let build_path suf = match !target_path with