diff --git a/.github/workflows/binary-releases.yml b/.github/workflows/binary-releases.yml index 773935862..34eee6812 100644 --- a/.github/workflows/binary-releases.yml +++ b/.github/workflows/binary-releases.yml @@ -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: | diff --git a/makefiles/variables.mk b/makefiles/variables.mk index f67fd4338..95e498b01 100644 --- a/makefiles/variables.mk +++ b/makefiles/variables.mk @@ -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= diff --git a/src/mlang/backend_compilers/bir_to_dgfip_c.ml b/src/mlang/backend_compilers/bir_to_dgfip_c.ml index ee9aed24e..98ab4e7bd 100644 --- a/src/mlang/backend_compilers/bir_to_dgfip_c.ml +++ b/src/mlang/backend_compilers/bir_to_dgfip_c.ml @@ -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) @@ -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 "@;@[{"; - 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 "@;@[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 "@;@[{"; - 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 "@;@[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 "@;@[{"; + 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 + "@;\ + @[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 "@;@[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 "@;@[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 "@;@[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 "@;@[if (%s) {" print_def; - pr "@;print_double(%s, %s, %s, %d, %d);" print_std pr_ctx - print_val min max; - pr "@]@;@[} 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 "@;@[if (%s) {" print_def; + pr "@;print_double(%s, %s, %s, %d, %d);" print_std pr_ctx + print_val min max; + pr "@]@;@[} else {"; + pr "@;print_string(%s, %s, \"indefini\");" print_std pr_ctx; + pr "@]@;}") + args + in + pr "@;@[{"; + 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 @@ -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);"; @@ -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 "@;@[{"; @@ -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 "@;@[while(%s < %s) {" cpt_j nb_events_sav; let ref_def = VID.gen_def None var in (* !!! *) @@ -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 "@;@[{"; 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;"; @@ -1830,7 +1871,7 @@ let generate_cible_tmp_decls (oc : Format.formatter) (tf : Mir.target) = if tf.target_sz_tmps > 0 then ( pr "@;@[{"; pr "@;int i;"; - pr "@;T_varinfo *info;"; + (* pr "@;T_varinfo *info;"; *) pr "@;@[@[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;"; diff --git a/src/mlang/backend_compilers/decoupledExpr.ml b/src/mlang/backend_compilers/decoupledExpr.ml index 7cbcfaa9c..485739a44 100644 --- a/src/mlang/backend_compilers/decoupledExpr.ml +++ b/src/mlang/backend_compilers/decoupledExpr.ml @@ -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@;@[%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 "@[%s =@ %a;@]" var (format_dexpr dgfip_flags) e let format_set_vars (dgfip_flags : Dgfip_options.flags) fmt (set_vars : (dflag * string * t) list) = diff --git a/src/mlang/backend_compilers/dgfip_compir_files.ml b/src/mlang/backend_compilers/dgfip_compir_files.ml index 0967de8bf..cbe0efa58 100644 --- a/src/mlang/backend_compilers/dgfip_compir_files.ml +++ b/src/mlang/backend_compilers/dgfip_compir_files.ml @@ -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 @@ -750,7 +750,7 @@ 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 @@ -758,7 +758,7 @@ let gen_table_call fmt flags vars_debug (cprog : Mir.program) = 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) @@ -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) = @@ -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 = diff --git a/src/mlang/backend_compilers/dgfip_gen_files.ml b/src/mlang/backend_compilers/dgfip_gen_files.ml index 1085a1626..e27da118d 100644 --- a/src/mlang/backend_compilers/dgfip_gen_files.ml +++ b/src/mlang/backend_compilers/dgfip_gen_files.ml @@ -63,7 +63,7 @@ let gen_table_varinfo vars cat Com.CatVar.{ id_int; id_str; attributs; _ } stats StrMap.iter (fun _ av -> Pp.fpr fmt ", %d" (Pos.unmark av)) attrs; Pp.fpr fmt " },\n") vars; - Pp.fpr fmt " NULL\n};\n\n"; + Pp.fpr fmt " {NULL}\n};\n\n"; close_out oc; let nb = IntMap.cardinal vars in let attr_set = @@ -86,7 +86,7 @@ let gen_table_tmp_varinfo (cprog : Mir.program) fmt = " { \"%s\", \"\", %d, %d, %d, ID_TMP_VARS, EST_TEMPORAIRE },\n" name idx tab_idx size) vars; - Pp.fpr fmt " NULL\n};\n\n" + Pp.fpr fmt " {NULL}\n};\n\n" let gen_table_tab_varinfo (cprog : Mir.program) fmt = let table_map = cprog.program_stats.table_map in @@ -187,7 +187,7 @@ let gen_table_varinfos (cprog : Mir.program) flags = Pp.fpr fmt " { \"%s\", %s },\n" name var_addr in StrMap.iter iter var_map; - Pp.fpr fmt " NULL\n};\n\n"); + Pp.fpr fmt " {NULL}\n};\n\n"); gen_table_tmp_varinfo cprog fmt; gen_table_tab_varinfo cprog fmt; close_out oc; @@ -599,7 +599,7 @@ extern void add_erreur(T_irdata *irdata, T_erreur *erreur, char *code); #ifdef ANCIEN extern void free_erreur(void); #else -extern void free_erreur(T_irdata *irdata); +extern void free_erreur(T_irdata*); #endif /* ANCIEN */ #define fabs(a) (((a) < 0.0) ? -(a) : (a)) @@ -1235,6 +1235,9 @@ void print_string(FILE *std, T_print_context *pr_ctx, char *str) { } } +char isnan(double); +char isinf(double); + void print_double(FILE *std, T_print_context *pr_ctx, double f, int pmin, int pmax) { print_indent(NULL, pr_ctx); if (pmin < 0) { @@ -2067,7 +2070,6 @@ char lis_tabaccess( char *res_def, double *res_val ) { T_varinfo *info = lis_tabaccess_varinfo(irdata, idx_tab, idx_def, idx_val); - int idx = 0; if (info == NULL) { *res_val = 0.0; if ( @@ -2109,7 +2111,6 @@ void ecris_tabaccess( /* !!! */ void pr_var(T_print_context *pr_ctx, T_irdata *irdata, int var_space, char *nom) { T_varinfo *info = NULL; - T_var_space *vsp; char res_def = 0; double res_val = 0.0; @@ -2118,7 +2119,6 @@ void pr_var(T_print_context *pr_ctx, T_irdata *irdata, int var_space, char *nom) if (info == NULL) { fprintf(pr_ctx->std, "inconnu"); } else { - vsp = get_var_space(irdata, var_space); lis_varinfo(irdata, var_space, info, &res_def, &res_val); if (res_def == 0) { fprintf(pr_ctx->std, "indefini"); @@ -2360,7 +2360,6 @@ void aff_val( "T_varinfo *event_field_%s_var(T_irdata *irdata, char idx_def, \ double idx_val) {\n" f; - pr " T_varinfo *info = NULL;\n"; pr " int idx = (int)floor(idx_val);\n"; pr " if (idx_def != 1 || idx < 0 || irdata->nb_events <= idx) {\n"; pr " return NULL;\n";