Skip to content

Commit

Permalink
varinfos.c pour BATCH (#253)
Browse files Browse the repository at this point in the history
  • Loading branch information
david-michel1 authored Feb 13, 2025
2 parents 2a05aeb + 4be2aab commit 915eae7
Show file tree
Hide file tree
Showing 2 changed files with 57 additions and 47 deletions.
40 changes: 19 additions & 21 deletions src/mlang/backend_compilers/dgfip_compir_files.ml
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,12 @@
You should have received a copy of the GNU General Public License along with
this program. If not, see <https://www.gnu.org/licenses/>. *)

let open_file filename =
let folder = Filename.dirname !Cli.output_file in
let oc = open_out (Filename.concat folder filename) in
let fmt = Format.formatter_of_out_channel oc in
(oc, fmt)

(* Various flags used to control wicch data to put in each variable array *)
type gen_opt = {
with_verif : bool;
Expand Down Expand Up @@ -1021,43 +1027,36 @@ extern struct S_erreur *tabErreurs[];
|};
Format.fprintf fmt "#endif /* _COMPIR_H_ */\n"
let open_file filename =
let oc = open_out filename in
let fmt = Format.formatter_of_out_channel oc in
(oc, fmt)
(* Generate the auxiliary files AND return the map of variables names to TGV
ids *)
let generate_compir_files flags (cprog : Mir.program) : unit =
let folder = Filename.dirname !Cli.output_file in
let vars = get_vars cprog Dgfip_options.(flags.flg_tri_ebcdic) in
let oc, fmt = open_file (Filename.concat folder "compir_restitue.c") in
let oc, fmt = open_file "compir_restitue.c" in
gen_table_output fmt flags vars;
close_out oc;
let oc, fmt = open_file (Filename.concat folder "compir_contexte.c") in
let oc, fmt = open_file "compir_contexte.c" in
gen_table_context fmt flags vars;
close_out oc;
let oc, fmt = open_file (Filename.concat folder "compir_famille.c") in
let oc, fmt = open_file "compir_famille.c" in
gen_table_family fmt flags vars;
close_out oc;
let oc, fmt = open_file (Filename.concat folder "compir_revenu.c") in
let oc, fmt = open_file "compir_revenu.c" in
gen_table_income fmt flags vars;
close_out oc;
let oc, fmt = open_file (Filename.concat folder "compir_revcor.c") in
let oc, fmt = open_file "compir_revcor.c" in
gen_table_corrincome fmt flags vars;
close_out oc;
let oc, fmt = open_file (Filename.concat folder "compir_variatio.c") in
let oc, fmt = open_file "compir_variatio.c" in
gen_table_variation fmt flags vars;
close_out oc;
let oc, fmt = open_file (Filename.concat folder "compir_penalite.c") in
let oc, fmt = open_file "compir_penalite.c" in
gen_table_penality fmt flags vars;
close_out oc;
Expand All @@ -1067,8 +1066,7 @@ let generate_compir_files flags (cprog : Mir.program) : unit =
if flags.nb_debug_c > 0 then
List.fold_left
(fun i vars ->
let file = Printf.sprintf "compir_tableg%02d.c" i in
let oc, fmt = open_file (Filename.concat folder file) in
let oc, fmt = open_file (Printf.sprintf "compir_tableg%02d.c" i) in
if flags.flg_debug then gen_table_debug fmt flags vars i
else
Format.fprintf fmt
Expand All @@ -1079,22 +1077,22 @@ let generate_compir_files flags (cprog : Mir.program) : unit =
else 0
in
let oc, fmt = open_file (Filename.concat folder "compir_desc.h") in
let oc, fmt = open_file "compir_desc.h" in
gen_desc fmt Dgfip_options.(flags.flg_tri_ebcdic) vars ~alias_only:true;
close_out oc;
let oc, fmt = open_file (Filename.concat folder "compir_desc_inv.h") in
let oc, fmt = open_file "compir_desc_inv.h" in
gen_desc fmt Dgfip_options.(flags.flg_tri_ebcdic) vars ~alias_only:false;
close_out oc;
let oc, fmt = open_file (Filename.concat folder "compir_tableg.c") in
let oc, fmt = open_file "compir_tableg.c" in
gen_table_call fmt flags vars_debug cprog;
close_out oc;
let oc, fmt = open_file (Filename.concat folder "compir_tablev.c") in
let oc, fmt = open_file "compir_tablev.c" in
gen_table_verif fmt flags cprog;
close_out oc;
let oc, fmt = open_file (Filename.concat folder "compir.h") in
let oc, fmt = open_file "compir.h" in
gen_compir_h fmt flags vars vars_debug_split;
close_out oc
64 changes: 38 additions & 26 deletions src/mlang/backend_compilers/dgfip_gen_files.ml
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,20 @@
You should have received a copy of the GNU General Public License along with
this program. If not, see <https://www.gnu.org/licenses/>. *)

let gen_table_varinfo fmt vars cat Com.CatVar.{ id_int; id_str; attributs; _ }
let open_file filename =
let folder = Filename.dirname !Cli.output_file in
let oc = open_out (Filename.concat folder filename) in
let fmt = Format.formatter_of_out_channel oc in
(oc, fmt)

let gen_table_varinfo vars cat Com.CatVar.{ id_int; id_str; attributs; _ }
(stats, var_map) =
let oc, fmt = open_file (Pp.spr "varinfo_%s.c" id_str) in
Format.fprintf fmt {|/****** LICENCE CECIL *****/

#include "mlang.h"

|};
Format.fprintf fmt "T_varinfo_%s varinfo_%s[NB_%s + 1] = {\n" id_str id_str
id_str;
let nb, var_map =
Expand Down Expand Up @@ -54,12 +66,20 @@ let gen_table_varinfo fmt vars cat Com.CatVar.{ id_int; id_str; attributs; _ }
vars (0, var_map)
in
Format.fprintf fmt " NULL\n};\n\n";
close_out oc;
let attr_set =
StrMap.fold (fun an _ res -> StrSet.add an res) attributs StrSet.empty
in
(Com.CatVar.Map.add cat (id_str, id_int, nb, attr_set) stats, var_map)

let gen_table_varinfos fmt (cprog : Mir.program) =
let gen_table_varinfos (cprog : Mir.program) flags =
let stats_varinfos, var_map =
Com.CatVar.Map.fold
(gen_table_varinfo cprog.program_vars)
cprog.program_var_categories
(Com.CatVar.Map.empty, StrMap.empty)
in
let oc, fmt = open_file "varinfos.c" in
Format.fprintf fmt {|/****** LICENCE CECIL *****/

#include "mlang.h"
Expand Down Expand Up @@ -96,15 +116,14 @@ let gen_table_varinfos fmt (cprog : Mir.program) =
Format.fprintf fmt " return 0.0;\n";
Format.fprintf fmt "}\n\n")
attrs;
let stats_varinfos, var_map =
Com.CatVar.Map.fold
(gen_table_varinfo fmt cprog.program_vars)
cprog.program_var_categories
(Com.CatVar.Map.empty, StrMap.empty)
in
Format.fprintf fmt "T_varinfo_map varinfo[NB_variable + NB_saisie + 1] = {\n";
StrMap.iter (Format.fprintf fmt " { \"%s\", %s },\n") var_map;
Format.fprintf fmt " NULL\n};\n\n";
if flags.Dgfip_options.flg_gcos then
Format.fprintf fmt "T_varinfo_map varinfo[1] = {NULL};\n\n"
else (
Format.fprintf fmt
"T_varinfo_map varinfo[NB_variable + NB_saisie + 1] = {\n";
StrMap.iter (Format.fprintf fmt " { \"%s\", %s },\n") var_map;
Format.fprintf fmt " NULL\n};\n\n");
close_out oc;
stats_varinfos

let gen_decl_varinfos fmt (cprog : Mir.program) stats =
Expand Down Expand Up @@ -237,7 +256,9 @@ let gen_conf_h fmt (cprog : Mir.program) flags =
if flags.flg_iliad then Format.fprintf fmt "#define FLG_ILIAD\n";
if flags.flg_pro then Format.fprintf fmt "#define FLG_PRO\n";
if flags.flg_cfir then Format.fprintf fmt "#define FLG_CFIR\n";
if flags.flg_gcos then Format.fprintf fmt "#define FLG_GCOS\n";
if flags.flg_gcos then (
Format.fprintf fmt "#define FLG_GCOS\n";
Format.fprintf fmt "#define BATCH\n");
if flags.flg_tri_ebcdic then Format.fprintf fmt "#define FLG_TRI_EBCDIC\n";
(* flag is not used *)
if flags.flg_short then
Expand Down Expand Up @@ -1570,32 +1591,23 @@ void pr_err_var(T_irdata *irdata, char *nom) {
}
|}

let open_file filename =
let oc = open_out filename in
let fmt = Format.formatter_of_out_channel oc in
(oc, fmt)

let generate_auxiliary_files flags (cprog : Mir.program) : unit =
let folder = Filename.dirname !Cli.output_file in

Dgfip_compir_files.generate_compir_files flags cprog;

let oc, fmt = open_file (Filename.concat folder "varinfos.c") in
let stats_varinfos = gen_table_varinfos fmt cprog in
close_out oc;
let stats_varinfos = gen_table_varinfos cprog flags in

let oc, fmt = open_file (Filename.concat folder "erreurs.c") in
let oc, fmt = open_file "erreurs.c" in
gen_erreurs_c fmt flags cprog;
close_out oc;

let oc, fmt = open_file (Filename.concat folder "conf.h") in
let oc, fmt = open_file "conf.h" in
gen_conf_h fmt cprog flags;
close_out oc;

let oc, fmt = open_file (Filename.concat folder "mlang.h") in
let oc, fmt = open_file "mlang.h" in
gen_mlang_h fmt cprog flags stats_varinfos;
close_out oc;

let oc, fmt = open_file (Filename.concat folder "mlang.c") in
let oc, fmt = open_file "mlang.c" in
gen_mlang_c fmt flags;
close_out oc

0 comments on commit 915eae7

Please sign in to comment.