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

Fixed generation of C code

Browse source
This commit is contained in:
Cédric Pasteur 2010-07-13 16:23:26 +02:00
parent 73bd2d080e
commit 5440a073d6
1 changed files with 22 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
compiler/obc/c/cgen.ml
View file

@ -247,6 +247,22 @@ let address_of e =
with _ -> with _ ->
e e
let rec cexpr_of_static_exp se =
match se.se_desc with
| Sint i -> Cconst (Ccint i)
| Sfloat f -> Cconst (Ccfloat f)
| Sbool b -> Cconst (Ctag (if b then "TRUE" else "FALSE"))
| Sconstructor c -> Cconst (Ctag (shortname c))
| Sarray_power(n,c) ->
let cc = cexpr_of_static_exp c in
Carraylit (repeat_list cc (int_of_static_exp n))
| Svar ln ->
(try
let { info = cd } = find_const ln in
cexpr_of_static_exp (Static.simplify NamesEnv.empty cd.c_value)
with Not_found -> assert false)
| Sop _ -> cexpr_of_static_exp (Static.simplify NamesEnv.empty se)
(** [cexpr_of_exp exp] translates the Obj action [exp] to a C expression. *) (** [cexpr_of_exp exp] translates the Obj action [exp] to a C expression. *)
let rec cexpr_of_exp var_env exp = let rec cexpr_of_exp var_env exp =
match exp.e_desc with match exp.e_desc with
@ -255,15 +271,7 @@ let rec cexpr_of_exp var_env exp =
Clhs (clhs_of_exp var_env exp) Clhs (clhs_of_exp var_env exp)
(** Constants, the easiest translation. *) (** Constants, the easiest translation. *)
| Econst lit -> | Econst lit ->
(match lit.se_desc with cexpr_of_static_exp lit
| Sint i -> Cconst (Ccint i)
| Sfloat f -> Cconst (Ccfloat f)
| Sbool b -> Cconst (Ctag (if b then "TRUE" else "FALSE"))
| Sconstructor c -> Cconst (Ctag (shortname c))
| Sarray_power(n,c) ->
let cc = cexpr_of_exp var_env (mk_exp (Econst c)) in
Carraylit (repeat_list cc (int_of_static_exp n))
)
(** Operators *) (** Operators *)
| Eop(op, exps) -> | Eop(op, exps) ->
cop_of_op var_env op exps cop_of_op var_env op exps
@ -495,11 +503,11 @@ let global_name = ref "";;
(** Builds the argument list of step function*) (** Builds the argument list of step function*)
let step_fun_args n md = let step_fun_args n mems md =
let args = cvarlist_of_ovarlist md.m_inputs in let args = cvarlist_of_ovarlist md.m_inputs in
let out_arg = [("out", Cty_ptr (Cty_id (n ^ "_out")))] in let out_arg = [("out", Cty_ptr (Cty_id (n ^ "_out")))] in
let context_arg = let context_arg =
if is_statefull (longname n) then if not (is_empty mems) then
[("self", Cty_ptr (Cty_id (n ^ "_mem")))] [("self", Cty_ptr (Cty_id (n ^ "_mem")))]
else else
[] []
@ -517,7 +525,7 @@ let fun_def_of_step_fun name obj_env mem objs md =
let fun_name = name ^ "_step" in let fun_name = name ^ "_step" in
(** Its arguments, translating Obc types to C types and adding our internal (** Its arguments, translating Obc types to C types and adding our internal
memory structure. *) memory structure. *)
let args = step_fun_args name md in let args = step_fun_args name mem md in
(** Its normal local variables. *) (** Its normal local variables. *)
let local_vars = List.map cvar_of_vd md.m_locals in let local_vars = List.map cvar_of_vd md.m_locals in
@ -564,7 +572,7 @@ let mem_decl_of_class_def cd =
else else
l l
in in
if is_statefull (longname cd.cd_name) then ( if not (is_empty cd.cd_mems) then (
(** Fields corresponding to normal memory variables. *) (** Fields corresponding to normal memory variables. *)
let mem_fields = List.map cvar_of_vd cd.cd_mems in let mem_fields = List.map cvar_of_vd cd.cd_mems in
(** Fields corresponding to object variables. *) (** Fields corresponding to object variables. *)
@ -614,7 +622,7 @@ let cdefs_and_cdecls_of_class_def cd =
let res_fun_decl = cdecl_of_cfundef reset_fun_def in let res_fun_decl = cdecl_of_cfundef reset_fun_def in
let step_fun_decl = cdecl_of_cfundef step_fun_def in let step_fun_decl = cdecl_of_cfundef step_fun_def in
let fun_defs = let fun_defs =
if is_statefull (longname cd.cd_name) then if not (is_empty cd.cd_mems) then
([res_fun_decl; step_fun_decl], [reset_fun_def; step_fun_def]) ([res_fun_decl; step_fun_decl], [reset_fun_def; step_fun_def])
else else
([step_fun_decl], [step_fun_def]) in ([step_fun_decl], [step_fun_def]) in