Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .github/workflows/binary-releases.yml
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ jobs:
uses: ocaml/setup-ocaml@v2
with:
# Version of the OCaml compiler to initialise
ocaml-compiler: 4.11.2
ocaml-compiler: 4.13.1

- name: Install dependencies
run: |
Expand Down
2 changes: 1 addition & 1 deletion makefiles/variables.mk
Original file line number Diff line number Diff line change
Expand Up @@ -70,7 +70,7 @@ endif

# Options pour le compilateur C
# Attention, très long à compiler avec GCC en O2/O3
COMMON_CFLAGS?=-std=c89 -pedantic
COMMON_CFLAGS?=-std=c89 -pedantic -Wall -Wno-unused-label
ifeq ($(CC), clang)
COMPILER_SPECIFIC_CFLAGS=-O2
# COMPILER_SPECIFIC_CFLAGS=
Expand Down
197 changes: 119 additions & 78 deletions src/mlang/backend_compilers/bir_to_dgfip_c.ml
Original file line number Diff line number Diff line change
Expand Up @@ -845,7 +845,9 @@ let generate_m_assign (p : Mir.program) (dgfip_flags : Dgfip_options.flags)
let generate_var_def (p : Mir.program) (dgfip_flags : Dgfip_options.flags)
(m_sp_opt : Com.var_space) (var : Com.Var.t)
(vexpr : Mir.expression Pos.marked) (oc : Format.formatter) : unit =
generate_m_assign p dgfip_flags m_sp_opt var oc vexpr
match Pos.unmark vexpr with
| Var (VarAccess (space, v)) when space = m_sp_opt && v = var -> ()
| _ -> generate_m_assign p dgfip_flags m_sp_opt var oc vexpr

let generate_var_def_tab (p : Mir.program) (dgfip_flags : Dgfip_options.flags)
(m_sp_opt : Com.var_space) (var : Com.Var.t) (vidx : Mir.m_expression)
Expand Down Expand Up @@ -1064,82 +1066,122 @@ let rec generate_stmt (env : env) (dgfip_flags : Dgfip_options.flags)
let print = fresh_c_local "print" in
let print_def = print ^ "_def" in
let print_val = print ^ "_val" in
pr "@;@[<v 2>{";
pr "@;char %s;@;double %s;@;int %s;" print_def print_val print;
List.iter
(fun (arg : Com.Var.t Com.print_arg Pos.marked) ->
match Pos.unmark arg with
| PrintString s ->
pr "@;print_string(%s, %s, \"%s\");" print_std pr_ctx
(str_escape s)
| PrintAccess (info, m_a) -> (
let pr_sp m_sp_opt v_opt =
let vsd_id =
match v_opt with
| Some v -> VID.gen_var_space_id m_sp_opt v
| None -> "irdata->var_space"
in
let vsd = Pp.spr "irdata->var_spaces[%s]" vsd_id in
pr "@;@[<v 2>if (%s.is_default == 0) {" vsd;
pr "@;print_string(%s, %s, %s.name);" print_std pr_ctx vsd;
pr "@;print_string(%s, %s, \".\");" print_std pr_ctx;
pr "@]@;}@;"
in
match Pos.unmark m_a with
| VarAccess (m_sp_opt, v) ->
pr_sp m_sp_opt (Some v);
let ptr = VID.gen_info_ptr v in
let fld =
match info with Com.Name -> "name" | Com.Alias -> "alias"
(* The [print*] variables only are needed in a few cases. *)
let print_var_is_needed = ref false in
let print_def_val_are_needed = ref false in
(* Iterating on the arguments and saving the associated printers in a
list to check as we build it if we will need the print_var; in which
case, we set the previous reference to true. *)
let printers =
List.map
(fun (arg : Com.Var.t Com.print_arg Pos.marked) ->
match Pos.unmark arg with
| PrintString s ->
fun () ->
pr "@;print_string(%s, %s, \"%s\");" print_std pr_ctx
(str_escape s)
| PrintAccess (info, m_a) -> (
let pr_sp m_sp_opt v_opt =
let vsd_id =
match v_opt with
| Some v -> VID.gen_var_space_id m_sp_opt v
| None -> "irdata->var_space"
in
pr "@;print_string(%s, %s, %s->%s);" print_std pr_ctx ptr fld
| TabAccess (m_sp_opt, v, m_idx) ->
pr_sp m_sp_opt (Some v);
pr "@;@[<v 2>{";
pr "T_varinfo *info;";
let idx_tab = Com.Var.loc_tab_idx v in
let vsd = Pp.spr "irdata->var_spaces[%s]" vsd_id in
pr "@;@[<v 2>if (%s.is_default == 0) {" vsd;
pr "@;print_string(%s, %s, %s.name);" print_std pr_ctx vsd;
pr "@;print_string(%s, %s, \".\");" print_std pr_ctx;
pr "@]@;}@;"
in
match Pos.unmark m_a with
| VarAccess (m_sp_opt, v) ->
fun () ->
pr_sp m_sp_opt (Some v);
let ptr = VID.gen_info_ptr v in
let fld =
match info with
| Com.Name -> "name"
| Com.Alias -> "alias"
in
pr "@;print_string(%s, %s, %s->%s);" print_std pr_ctx ptr
fld
| TabAccess (m_sp_opt, v, m_idx) ->
print_def_val_are_needed := true;
fun () ->
pr_sp m_sp_opt (Some v);
pr "@;@[<v 2>{";
pr "T_varinfo *info;";
let idx_tab = Com.Var.loc_tab_idx v in
generate_expr_with_res_in p dgfip_flags oc print_def
print_val m_idx;
pr "info = lis_tabaccess_varinfo(irdata, %d, %s, %s);"
idx_tab print_def print_val;
let fld =
match info with
| Com.Name -> "name"
| Com.Alias -> "alias"
in
pr
"@;\
print_string(%s, %s, (info == NULL ? \"\" : \
info->%s));"
print_std pr_ctx fld;
pr "@]@;}"
| FieldAccess (m_sp_opt, e, f, _) ->
let fld =
match info with
| Com.Name -> "name"
| Com.Alias -> "alias"
in
let ef =
StrMap.find (Pos.unmark f) p.program_event_fields
in
print_var_is_needed := ef.is_var;
print_def_val_are_needed := ef.is_var;
fun () ->
pr_sp m_sp_opt None;
if ef.is_var then (
generate_expr_with_res_in p dgfip_flags oc print_def
print_val e;
pr "@;%s = (int)%s;" print print_val;
pr
"@;\
@[<v 2>if (%s && 0 <= %s && %s < irdata->nb_events) \
{"
print_def print print;
pr
"@;\
print_string(%s, %s, \
irdata->events[%s]->field_%s_var->%s);"
print_std pr_ctx print (Pos.unmark f) fld;
pr "@]@;}"))
| PrintIndent e ->
print_def_val_are_needed := true;
fun () ->
generate_expr_with_res_in p dgfip_flags oc print_def print_val
m_idx;
pr "info = lis_tabaccess_varinfo(irdata, %d, %s, %s);" idx_tab
print_def print_val;
let fld =
match info with Com.Name -> "name" | Com.Alias -> "alias"
in
pr "@;print_string(%s, %s, (info == NULL ? \"\" : info->%s));"
print_std pr_ctx fld;
e;
pr "@;@[<v 2>if (%s) {" print_def;
pr "@;set_print_indent(%s, %s, %s);" print_std pr_ctx
print_val;
pr "@]@;}"
| FieldAccess (m_sp_opt, e, f, _) ->
pr_sp m_sp_opt None;
let fld =
match info with Com.Name -> "name" | Com.Alias -> "alias"
in
let ef = StrMap.find (Pos.unmark f) p.program_event_fields in
if ef.is_var then (
generate_expr_with_res_in p dgfip_flags oc print_def
print_val e;
pr "@;%s = (int)%s;" print print_val;
pr "@;@[<v 2>if (%s && 0 <= %s && %s < irdata->nb_events) {"
print_def print print;
pr
"@;\
print_string(%s, %s, \
irdata->events[%s]->field_%s_var->%s);"
print_std pr_ctx print (Pos.unmark f) fld;
pr "@]@;}"))
| PrintIndent e ->
generate_expr_with_res_in p dgfip_flags oc print_def print_val e;
pr "@;@[<v 2>if (%s) {" print_def;
pr "@;set_print_indent(%s, %s, %s);" print_std pr_ctx print_val;
pr "@]@;}"
| PrintExpr (e, min, max) ->
generate_expr_with_res_in p dgfip_flags oc print_def print_val e;
pr "@;@[<v 2>if (%s) {" print_def;
pr "@;print_double(%s, %s, %s, %d, %d);" print_std pr_ctx
print_val min max;
pr "@]@;@[<v 2>} else {";
pr "@;print_string(%s, %s, \"indefini\");" print_std pr_ctx;
pr "@]@;}")
args;
| PrintExpr (e, min, max) ->
print_def_val_are_needed := true;
fun () ->
generate_expr_with_res_in p dgfip_flags oc print_def print_val
e;
pr "@;@[<v 2>if (%s) {" print_def;
pr "@;print_double(%s, %s, %s, %d, %d);" print_std pr_ctx
print_val min max;
pr "@]@;@[<v 2>} else {";
pr "@;print_string(%s, %s, \"indefini\");" print_std pr_ctx;
pr "@]@;}")
args
in
pr "@;@[<v 2>{";
if !print_def_val_are_needed then
pr "@;char %s;@;double %s;" print_def print_val;
if !print_var_is_needed then pr "@;int %s;" print;
List.iter (fun f -> f ()) printers;
pr "@]@;}"
| ComputeTarget (Pos.Mark (tn, _), targs, m_sp_opt) ->
let target = StrMap.find tn p.program_targets in
Expand Down Expand Up @@ -1378,7 +1420,6 @@ let rec generate_stmt (env : env) (dgfip_flags : Dgfip_options.flags)
let nb_events_sav = fresh_c_local "nb_events_sav" in
let nb_add = fresh_c_local "nb_add" in
let cpt_i = fresh_c_local "i" in
let cpt_j = fresh_c_local "j" in
let evt = fresh_c_local "evt" in
let pp_sanitize () =
pr "@;free(irdata->events);";
Expand All @@ -1392,7 +1433,6 @@ let rec generate_stmt (env : env) (dgfip_flags : Dgfip_options.flags)
pr "@;int %s = 0;" nb_add;
pr "@;T_event **%s = NULL;" events_tmp;
pr "@;int %s = 0;" cpt_i;
pr "@;int %s = 0;" cpt_j;
(match add with
| Some expr ->
pr "@;@[<v 2>{";
Expand Down Expand Up @@ -1433,6 +1473,8 @@ let rec generate_stmt (env : env) (dgfip_flags : Dgfip_options.flags)
nb_events_sav);
(match filter with
| Some (var, expr) ->
let cpt_j = fresh_c_local "j" in
pr "@;int %s = 0;" cpt_j;
pr "@;@[<v 2>while(%s < %s) {" cpt_j nb_events_sav;
let ref_def = VID.gen_def None var in
(* !!! *)
Expand Down Expand Up @@ -1725,7 +1767,6 @@ let generate_function_tmp_decls (oc : Format.formatter) (tf : Mir.target) =
let nb_args = List.length tf.target_args in
pr "@;@[<v 2>{";
pr "@;int i;";
pr "@;T_varinfo *info;";
pr "@;irdata->tmps[irdata->tmps_org].def = 0;";
pr "@;irdata->tmps[irdata->tmps_org].val = 0.0;";
pr "@;irdata->tmps[irdata->tmps_org].info = NULL;";
Expand Down Expand Up @@ -1830,7 +1871,7 @@ let generate_cible_tmp_decls (oc : Format.formatter) (tf : Mir.target) =
if tf.target_sz_tmps > 0 then (
pr "@;@[<v 2>{";
pr "@;int i;";
pr "@;T_varinfo *info;";
(* pr "@;T_varinfo *info;"; *)
pr "@;@[<v 2>@[<hov 2>for (i = 0;@ i < %d;@ i++) {@]" tf.target_sz_tmps;
pr "@;irdata->tmps[irdata->tmps_org + i].def = 0;";
pr "@;irdata->tmps[irdata->tmps_org + i].val = 0.0;";
Expand Down
8 changes: 5 additions & 3 deletions src/mlang/backend_compilers/decoupledExpr.ml
Original file line number Diff line number Diff line change
Expand Up @@ -523,9 +523,11 @@ let format_local_vars_defs (dgfip_flags : Dgfip_options.flags) fmt

let format_assign (dgfip_flags : Dgfip_options.flags) (var : string) fmt
((e, _kind, lv) : t) =
Format.fprintf fmt "%a@;@[<hov 2>%s =@ %a;@]"
(format_local_vars_defs dgfip_flags)
lv var (format_dexpr dgfip_flags) e
Format.fprintf fmt "%a@;" (format_local_vars_defs dgfip_flags) lv;
match e with
| (Ddirect (Dinstr v) | Dinstr v) when v = var -> () (* var = var *)
| _ ->
Format.fprintf fmt "@[<hov 2>%s =@ %a;@]" var (format_dexpr dgfip_flags) e

let format_set_vars (dgfip_flags : Dgfip_options.flags) fmt
(set_vars : (dflag * string * t) list) =
Expand Down
10 changes: 5 additions & 5 deletions src/mlang/backend_compilers/dgfip_compir_files.ml
Original file line number Diff line number Diff line change
Expand Up @@ -477,7 +477,7 @@ let gen_table fmt is_ebcdic vars req_type opt =
gen_var fmt req_type opt ~idx:0 ~name:"" ~tvar:Computed ~is_output:false
~typ_opt:None ~attributes:StrMap.empty ~desc:"" ~alias_opt:None;
*)
Format.fprintf fmt " NULL};\n"
Format.fprintf fmt " {NULL}};\n"

let gen_desc fmt is_ebcdic vars ~alias_only =
let vars = sort_vars_by_name is_ebcdic vars in
Expand Down Expand Up @@ -750,15 +750,15 @@ let gen_table_call fmt flags vars_debug (cprog : Mir.program) =
IntMap.iter
(fun id rn -> Format.fprintf fmt " { %d, %s },\n" id rn)
cprog.program_rules;
Format.fprintf fmt " 0};\n\n";
Format.fprintf fmt " {0}};\n\n";

Format.fprintf fmt "T_desc_err desc_err[NB_ERR + 1] = {\n";
StrMap.iter
(fun _ (e : Com.Error.t) ->
let en = Pos.unmark e.name in
Format.fprintf fmt " { \"%s\", &erreur_%s },\n" en en)
cprog.program_errors;
Format.fprintf fmt " NULL};\n\n");
Format.fprintf fmt " {NULL}};\n\n");

StrMap.iter
(fun _ tn -> Format.fprintf fmt "extern T_discord *%s(T_irdata *);\n" tn)
Expand All @@ -768,7 +768,7 @@ let gen_table_call fmt flags vars_debug (cprog : Mir.program) =
StrMap.iter
(fun cn tn -> Format.fprintf fmt " { \"%s\", %s },\n" cn tn)
cprog.program_chainings;
Format.fprintf fmt " NULL};\n"
Format.fprintf fmt " {NULL}};\n"

(* Print the table of verification functions (tablev.c) *)
let gen_table_verif fmt flags (cprog : Mir.program) =
Expand All @@ -788,7 +788,7 @@ let gen_table_verif fmt flags (cprog : Mir.program) =
IntMap.iter
(fun id tn -> Format.fprintf fmt " { %d, %s },\n" id tn)
cprog.program_verifs;
Format.fprintf fmt " 0};\n\n")
Format.fprintf fmt " {0}};\n\n")

(* Count variables in a specific category *)
let count vars req_type =
Expand Down
Loading
Loading