From 41fccc66fb4867d6a5f752b4431aedc7e9dbcbbf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gwena=EBl=20Delaval?= Date: Wed, 1 Aug 2012 17:08:58 +0200 Subject: [PATCH] Bugs corrections - callgraph: add idents used for instantiated nodes - cgen : added Idents.enter_node - cmain : removed error when simulated node does not exist (existence of simulated node was tested for every program, comprising loaded ones) --- compiler/global/idents.ml | 13 ++++++++++ compiler/global/idents.mli | 2 ++ compiler/main/mls2seq.ml | 2 +- compiler/minils/transformations/callgraph.ml | 2 ++ compiler/obc/c/cgen.ml | 1 + compiler/obc/c/cmain.ml | 25 +++++++++++++------- 6 files changed, 35 insertions(+), 10 deletions(-) diff --git a/compiler/global/idents.ml b/compiler/global/idents.ml index 6899488..a946fb3 100644 --- a/compiler/global/idents.ml +++ b/compiler/global/idents.ml @@ -123,10 +123,22 @@ struct (** This function should be called every time we enter a node *) let enter_node n = + (* TODO : see copy_node; same problem *) (if not (QualEnv.mem n !node_env) then node_env := QualEnv.add n (ref NamesSet.empty) !node_env); used_names := QualEnv.find n !node_env + (** Copy environment of node of name [n] to new node name [n'] *) + let copy_node n n' = + (* TODO : do something smarter than create empty used names set *) + (* this happen when an object file is loaded: the used names set + of loaded nodes is not properly set *) + if not (QualEnv.mem n !node_env) + then node_env := QualEnv.add n (ref NamesSet.empty) !node_env; + assert (not (QualEnv.mem n' !node_env)); + let used_names = !(QualEnv.find n !node_env) in + node_env := QualEnv.add n' (ref used_names) !node_env + (** @return a unique string for each identifier. Idents corresponding to variables defined in the source file have the same name unless there is a collision. *) @@ -172,5 +184,6 @@ let ident_of_name ?(reset=false) s = let source_name id = id.source let name id = UniqueNames.name id let enter_node n = UniqueNames.enter_node n +let copy_node = UniqueNames.copy_node let print_ident ff id = Format.fprintf ff "%s" (name id) diff --git a/compiler/global/idents.mli b/compiler/global/idents.mli index 01eab6a..8d37f14 100644 --- a/compiler/global/idents.mli +++ b/compiler/global/idents.mli @@ -67,6 +67,8 @@ val is_reset : ident -> bool (** /!\ [enter_node qualname] should be called every time we enter a node with name [qualname]. *) val enter_node : Names.qualname -> unit +val copy_node : Names.qualname -> Names.qualname -> unit + (** Maps taking an identifier as a key. *) module Env : sig diff --git a/compiler/main/mls2seq.ml b/compiler/main/mls2seq.ml index 9e08f24..91ed228 100644 --- a/compiler/main/mls2seq.ml +++ b/compiler/main/mls2seq.ml @@ -60,7 +60,7 @@ let mk_target ?(interface=IMinils ignore) ?(load_conf = no_conf) name pt = (** Writes a .epo file for program [p]. *) let write_object_file p = - let filename = (Names.modul_to_string p.Minils.p_modname)^".epo" in + let filename = (String.uncapitalize (Names.modul_to_string p.Minils.p_modname)) ^".epo" in let epoc = open_out_bin filename in output_value epoc p; close_out epoc; diff --git a/compiler/minils/transformations/callgraph.ml b/compiler/minils/transformations/callgraph.ml index cf6cf39..30eb751 100644 --- a/compiler/minils/transformations/callgraph.ml +++ b/compiler/minils/transformations/callgraph.ml @@ -27,6 +27,7 @@ (* *) (***********************************************************************) open Names +open Idents open Types open Misc open Location @@ -129,6 +130,7 @@ struct "_params_" params in let new_ln = Modules.fresh_value_in "callgraph" (n^param_string^"_") q in + Idents.copy_node ln new_ln; nodes_names := M.add (ln, params) new_ln !nodes_names (** Adds an instance of a node. *) diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml index 1b2ff53..bc3cf30 100644 --- a/compiler/obc/c/cgen.ml +++ b/compiler/obc/c/cgen.ml @@ -752,6 +752,7 @@ let cdefs_and_cdecls_of_class_def cd = (** We keep the state of our class in a structure, holding both internal variables and the state of other nodes. For a class named ["cname"], the structure will be called ["cname_mem"]. *) + Idents.enter_node cd.cd_name; let step_m = find_step_method cd in let memory_struct_decl = mem_decl_of_class_def cd in let out_struct_decl = out_decl_of_class_def cd in diff --git a/compiler/obc/c/cmain.ml b/compiler/obc/c/cmain.ml index b2105d7..66f28e6 100644 --- a/compiler/obc/c/cmain.ml +++ b/compiler/obc/c/cmain.ml @@ -364,12 +364,17 @@ let mk_main name p = let classes = program_classes p in let n_names = !Compiler_options.assert_nodes in let find_class n = - try List.find (fun cd -> cd.cd_name.name = n) classes - with Not_found -> - Format.eprintf "Unknown node %s.@." n; - exit 1 in + List.find (fun cd -> cd.cd_name.name = n) classes + in - let a_classes = List.map find_class n_names in + let a_classes = + List.fold_left + (fun acc n -> + try + find_class n :: acc + with Not_found -> acc) + [] + n_names in let (var_l, res_l, step_l) = let add cd (var_l, res_l, step_l) = @@ -378,10 +383,12 @@ let mk_main name p = List.fold_right add a_classes ([], [], []) in let n = !Compiler_options.simulation_node in - let (mem, nvar_l, res, nstep_l) = main_def_of_class_def (find_class n) in - let defs = match mem with None -> [] | Some m -> [m] in - let (var_l, res_l, step_l) = - (nvar_l @ var_l, res @ res_l, nstep_l @ step_l) in + let (defs, var_l, res_l, step_l) = + try + let (mem, nvar_l, res, nstep_l) = main_def_of_class_def (find_class n) in + let defs = match mem with None -> [] | Some m -> [m] in + (defs, nvar_l @ var_l, res @ res_l, nstep_l @ step_l) + with Not_found -> ([],var_l,res_l,step_l) in [("_main.c", Csource (defs @ [main_skel var_l res_l step_l])); ("_main.h", Cheader ([name], []))];