Skip to content

Commit

Permalink
Variables temporaires dans irdata
Browse files Browse the repository at this point in the history
  • Loading branch information
@david-michel1
david-michel1 committed May 22, 2024
1 parent b9e3532 commit 75c5f42
Show file tree
Hide file tree
Showing 5 changed files with 149 additions and 72 deletions.
42 changes: 40 additions & 2 deletions examples/dgfip_c/ml_primitif/ml_driver/irdata.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,11 +33,17 @@ T_irdata * IRDATA_new_irdata(void)
return NULL;
}
irdata->saisie = NULL;
irdata->def_saisie = NULL;
irdata->calculee = NULL;
irdata->def_calculee = NULL;
irdata->base = NULL;
irdata->tmps = NULL;
irdata->ref = NULL;
irdata->def_saisie = NULL;
irdata->def_calculee = NULL;
irdata->def_base = NULL;
irdata->def_tmps = NULL;
irdata->def_ref = NULL;
irdata->info_tmps = NULL;
irdata->info_ref = NULL;
if (alloc_tab(&irdata->saisie, &irdata->def_saisie, TAILLE_SAISIE) == FALSE) {
IRDATA_delete_irdata(irdata);
return NULL;
Expand All @@ -50,6 +56,32 @@ T_irdata * IRDATA_new_irdata(void)
IRDATA_delete_irdata(irdata);
return NULL;
}
if (alloc_tab(&irdata->tmps, &irdata->def_tmps, TAILLE_TMP_VARS) == FALSE) {
IRDATA_delete_irdata(irdata);
return NULL;
}
irdata->ref = (double **)malloc(TAILLE_REFS * (sizeof (double *)));
if (irdata->ref == NULL) {
IRDATA_delete_irdata(irdata);
return NULL;
}
irdata->def_ref = (char **)malloc(TAILLE_REFS * (sizeof (char *)));
if (irdata->def_ref == NULL) {
IRDATA_delete_irdata(irdata);
return NULL;
}
irdata->info_tmps = (T_varinfo *)malloc(TAILLE_TMP_VARS * (sizeof (T_varinfo)));
if (irdata->info_tmps == NULL) {
IRDATA_delete_irdata(irdata);
return NULL;
}
irdata->info_ref = (T_varinfo **)malloc(TAILLE_REFS * (sizeof (T_varinfo *)));
if (irdata->info_ref == NULL) {
IRDATA_delete_irdata(irdata);
return NULL;
}
irdata->tmps_org = 0;
irdata->ref_org = 0;
irdata->discords = NULL;
irdata->tas_discord = NULL;
irdata->p_discord = &irdata->discords;
Expand Down Expand Up @@ -78,9 +110,15 @@ void IRDATA_delete_irdata(T_irdata *irdata)
if (irdata->saisie != NULL) free(irdata->saisie);
if (irdata->calculee != NULL) free(irdata->calculee);
if (irdata->base != NULL) free(irdata->base);
if (irdata->tmps != NULL) free(irdata->tmps);
if (irdata->ref != NULL) free(irdata->ref);
if (irdata->def_saisie != NULL) free(irdata->def_saisie);
if (irdata->def_calculee != NULL) free(irdata->def_calculee);
if (irdata->def_base != NULL) free(irdata->def_base);
if (irdata->def_tmps != NULL) free(irdata->def_tmps);
if (irdata->def_ref != NULL) free(irdata->def_ref);
if (irdata->info_tmps != NULL) free(irdata->info_tmps);
if (irdata->info_ref != NULL) free(irdata->info_ref);
IRDATA_reset_erreur(irdata);
while (irdata->tas_discord != NULL) {
*(irdata->p_discord) = irdata->tas_discord;
Expand Down
2 changes: 1 addition & 1 deletion mlang-deps
Submodule mlang-deps updated from 0014c8 to 014039
121 changes: 64 additions & 57 deletions src/mlang/backend_compilers/bir_to_dgfip_c.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -308,38 +308,38 @@ let rec generate_c_expr (e : Mir.expression Pos.marked)
let generate_m_assign (dgfip_flags : Dgfip_options.flags)
(var_indexes : Dgfip_varid.var_id_map) (var : Com.Var.t) (offset : D.offset)
(oc : Format.formatter) (se : D.expression_composition) : unit =
let pr form = Format.fprintf oc form in
let def_var = D.generate_variable ~def_flag:true var_indexes offset var in
let val_var = D.generate_variable var_indexes offset var in
let locals, def, value = D.build_expression se in
if D.is_always_true def then
Format.fprintf oc "%a%a@,@[<v 2>{@,%a@,@]}" D.format_local_declarations
locals
pr "%a%a@;@[<v 2>{@;%a@]@;}" D.format_local_declarations locals
(D.format_assign dgfip_flags var_indexes def_var)
def
(D.format_assign dgfip_flags var_indexes val_var)
value
else
Format.fprintf oc "%a%a@,@[<v 2>if(%s){@;%a@]@,}@,else %s = 0.;"
pr "%a%a@,@[<v 2>if(%s){@;%a@]@,}@,else %s = 0.;"
D.format_local_declarations locals
(D.format_assign dgfip_flags var_indexes def_var)
def def_var
(D.format_assign dgfip_flags var_indexes val_var)
value val_var;
(* If the trace flag is set, we print the value of all non-temp variables *)
if dgfip_flags.flg_trace && not (Com.Var.is_temp var) then
Format.fprintf oc "@;aff2(\"%s\", irdata, %s);"
pr "@;aff2(\"%s\", irdata, %s);"
(Pos.unmark var.Com.Var.name)
(Dgfip_varid.gen_access_pos_from_start var_indexes var)

let generate_var_def (dgfip_flags : Dgfip_options.flags)
(var_indexes : Dgfip_varid.var_id_map) (var : Com.Var.t)
(vidx_opt : Mir.expression Pos.marked option)
(vexpr : Mir.expression Pos.marked) (fmt : Format.formatter) : unit =
let pr form = Format.fprintf fmt form in
match vidx_opt with
| None ->
let se = generate_c_expr vexpr var_indexes in
if Com.Var.is_ref var then (
let pr form = Format.fprintf fmt form in
pr "@[<v 2>{";
let idx = fresh_c_local "idxPROUT" in
pr "@;int %s;" idx;
Expand All @@ -350,37 +350,37 @@ let generate_var_def (dgfip_flags : Dgfip_options.flags)
(generate_m_assign dgfip_flags var_indexes var (GetValueExpr idx))
se;
pr "@]@;}";
pr "@]@;}@;")
pr "@]@;}")
else generate_m_assign dgfip_flags var_indexes var None fmt se
| Some ei ->
Format.fprintf fmt "@[<v 2>{@,";
pr "@[<v 2>{@,";
let idx_val = fresh_c_local "mpp_idx" in
let idx_def = idx_val ^ "_d" in
let locals_idx, def_idx, value_idx =
D.build_expression @@ generate_c_expr ei var_indexes
in
Format.fprintf fmt "char %s;@;long %s;@;%a%a@;%a" idx_def idx_val
pr "char %s;@;long %s;@;%a%a@;%a" idx_def idx_val
D.format_local_declarations locals_idx
(D.format_assign dgfip_flags var_indexes idx_def)
def_idx
(D.format_assign dgfip_flags var_indexes idx_val)
value_idx;
let size = Dgfip_varid.gen_size var_indexes var in
Format.fprintf fmt "@[<hov 2>if(%s && 0 <= %s && %s < %s){@,%a@]@,}"
idx_def idx_val idx_val size
pr "@[<v 2>if(%s && 0 <= %s && %s < %s){@,%a@]@,}" idx_def idx_val idx_val
size
(generate_m_assign dgfip_flags var_indexes var (GetValueExpr idx_val))
(generate_c_expr vexpr var_indexes);
Format.fprintf fmt "@]@,}"
pr "@]@,}"

let rec generate_stmt (dgfip_flags : Dgfip_options.flags)
(program : Mir.program) (var_indexes : Dgfip_varid.var_id_map)
(oc : Format.formatter) (stmt : Mir.m_instruction) =
match Pos.unmark stmt with
| Affectation (SingleFormula (m_var, vidx_opt, vexpr), _) ->
Format.fprintf oc "@[<v 2>{@,";
Format.fprintf oc "@[<v 2>{@;";
generate_var_def dgfip_flags var_indexes (Pos.unmark m_var) vidx_opt vexpr
oc;
Format.fprintf oc "@]@,}"
Format.fprintf oc "@]@;}"
| Affectation _ -> assert false
| IfThenElse (cond, iftrue, iffalse) ->
Format.fprintf oc "@[<v 2>{@,";
Expand All @@ -389,29 +389,29 @@ let rec generate_stmt (dgfip_flags : Dgfip_options.flags)
let locals, def, value =
D.build_expression @@ generate_c_expr cond var_indexes
in
Format.fprintf oc "char %s;@;double %s;@;%a%a@;%a" cond_def cond_val
Format.fprintf oc "char %s;@;double %s;@;%a%a@;%a@;" cond_def cond_val
D.format_local_declarations locals
(D.format_assign dgfip_flags var_indexes cond_def)
def
(D.format_assign dgfip_flags var_indexes cond_val)
value;
Format.fprintf oc "@[<hov 2>if(%s && %s){@,%a@]@,}" cond_def cond_val
Format.fprintf oc "@[<v 2>if(%s && %s) {@,%a@]@,}" cond_def cond_val
(generate_stmts dgfip_flags program var_indexes)
iftrue;
if iffalse <> [] then
Format.fprintf oc "@[<hov 2>else if(%s){@,%a@]@,}" cond_def
Format.fprintf oc "@[<v 2>else if(%s){@,%a@]@,}" cond_def
(generate_stmts dgfip_flags program var_indexes)
iffalse;
Format.fprintf oc "@]@,}"
| VerifBlock stmts ->
let goto_label = fresh_c_local "verif_block" in
let pr fmt = Format.fprintf oc fmt in
pr "@[<v 2>{@\n";
pr " if (setjmp(irdata->jmp_bloq) != 0) {@\n";
pr " goto %s;@\n" goto_label;
pr " }@\n";
pr "%a@\n" (generate_stmts dgfip_flags program var_indexes) stmts;
pr "%s:;@]@\n}@\n" goto_label
pr "@[<v 2>{@;";
pr " if (setjmp(irdata->jmp_bloq) != 0) {@;";
pr " goto %s;@;" goto_label;
pr " }@;";
pr "%a@;" (generate_stmts dgfip_flags program var_indexes) stmts;
pr "%s:;@]@;}" goto_label
| ComputeTarget (f, _) -> Format.fprintf oc "%s(irdata);" f
| Print (std, args) ->
let print_std, pr_ctx =
Expand Down Expand Up @@ -594,45 +594,52 @@ let generate_target_prototype (add_semicolon : bool) (oc : Format.formatter)
Format.fprintf oc "struct S_discord * %s(T_irdata* irdata)%s" function_name
(if add_semicolon then ";" else "")

let generate_var_tmp_decls (oc : Format.formatter)
(tmp_vars : (Com.Var.t * Pos.t * int option) StrMap.t) =
StrMap.iter
(fun vn (_, _, size) ->
let sz = match size with Some i -> i | None -> 1 in
Format.fprintf oc "char %s_def[%d];@,double %s_val[%d];@," vn sz vn sz)
tmp_vars;
if not (StrMap.is_empty tmp_vars) then Format.fprintf oc "@,";
StrMap.iter
(fun vn (_, _, size) ->
match size with
| Some 1 | None ->
Format.fprintf oc "%s_def[0] = 0;@,%s_val[0] = 0.0;@," vn vn
| Some i ->
Format.fprintf oc "@[<v 2>{@;";
Format.fprintf oc "int i;@;";
Format.fprintf oc "for (i = 0; i < %d; i++) {@;" i;
Format.fprintf oc "%s_def[i] = 0;@,%s_val[i] = 0.0;@," vn vn;
Format.fprintf oc "@]@;}@;";
Format.fprintf oc "@]@;}@;")
tmp_vars;
if not (StrMap.is_empty tmp_vars) then Format.fprintf oc "@,"
let generate_var_tmp_decls (oc : Format.formatter) (tf : Mir.target_data) =
let pr fmt = Format.fprintf oc fmt in
if tf.target_sz_tmps > 0 then (
pr "@[<v 2>{";
pr "@;int i;";
pr "@;T_varinfo *info;";
pr "@;@[<v 2>for (i = 0; i < %d; i++) {" tf.target_sz_tmps;
pr "@;irdata->def_tmps[irdata->tmps_org + i] = 0;";
pr "@;irdata->tmps[irdata->tmps_org + i] = 0.0;";
pr "@]@;}";
pr "@;irdata->tmps_org = irdata->tmps_org + %d;" tf.target_sz_tmps;
StrMap.iter
(fun vn (var, _, sz_opt) ->
let loc_str =
Format.sprintf "irdata->tmps_org + (%d)" (Com.Var.loc_int var)
in
pr "@;info = &(irdata->info_tmps[%s]);" loc_str;
pr "@;info->name = \"%s\";" vn;
pr "@;info->alias = \"\";";
pr "@;info->idx = %s;" loc_str;
(match sz_opt with
| None -> pr "@;info->size = 1;"
| Some i -> pr "@;info->size = %d;" i);
pr "@;info->cat = ID_TMP_VARS;")
tf.target_tmp_vars;
pr "@]@;}");
if tf.target_nb_refs > 0 then
pr "@;irdata->ref_org = irdata->ref_org + %d;" tf.target_nb_refs;
pr "@;"

let generate_target (dgfip_flags : Dgfip_options.flags) (program : Mir.program)
(var_indexes : Dgfip_varid.var_id_map) (oc : Format.formatter) (f : string)
=
let Mir.{ target_tmp_vars; target_prog; _ } =
Mir.TargetMap.find f program.program_targets
in
Format.fprintf oc "@[<v 2>%a{@,%a%s@\n%a%s@\n%s@]@,}@,"
(generate_target_prototype false)
f generate_var_tmp_decls target_tmp_vars
(if dgfip_flags.flg_trace then "aff1(\"debut " ^ f ^ "\\n\") ;" else "")
(generate_stmts dgfip_flags program var_indexes)
target_prog
(if dgfip_flags.flg_trace then "aff1(\"fin " ^ f ^ "\\n\") ;" else "")
{|
return irdata->discords;
|}
let pr fmt = Format.fprintf oc fmt in
let tf = Mir.TargetMap.find f program.program_targets in
pr "@[<v 2>%a{@;" (generate_target_prototype false) f;
pr "%a@;" generate_var_tmp_decls tf;
if dgfip_flags.flg_trace then pr "aff1(\"debut %s\\n\");@;" f;
pr "%a@;" (generate_stmts dgfip_flags program var_indexes) tf.target_prog;
if dgfip_flags.flg_trace then pr "aff1(\"fin %s\\n\");@;" f;
pr "@;";
if tf.target_nb_refs > 0 then
pr "irdata->ref_org = irdata->ref_org - %d;@;" tf.target_nb_refs;
if tf.target_sz_tmps > 0 then
pr "irdata->tmps_org = irdata->tmps_org - %d;@;" tf.target_sz_tmps;
pr "return irdata->discords;@]@;}@\n@\n"

let generate_targets (dgfip_flags : Dgfip_options.flags) (program : Mir.program)
(filemap : (out_channel * Format.formatter) StrMap.t)
Expand Down
40 changes: 32 additions & 8 deletions src/mlang/backend_compilers/dgfip_gen_files.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -933,10 +933,14 @@ let gen_decl_varinfos fmt (cprog : Mir.program) stats =
Format.fprintf fmt "#define NB_%s %d\n" id_str nb)
stats;
Format.fprintf fmt "\n";
Com.CatVar.Map.iter
(fun _ (id_str, id_int, _, _) ->
Format.fprintf fmt "#define ID_%s %d\n" id_str id_int)
stats;
let id_tmp =
Com.CatVar.Map.fold
(fun _ (id_str, id_int, _, _) id_tmp ->
Format.fprintf fmt "#define ID_%s %d\n" id_str id_int;
max (id_int + 1) id_tmp)
stats (-1)
in
Format.fprintf fmt "#define ID_TMP_VARS %d\n" id_tmp;

let attrs =
Com.CatVar.Map.fold
Expand Down Expand Up @@ -1451,9 +1455,17 @@ struct S_irdata
double *saisie;
double *calculee;
double *base;
double *tmps;
double **ref;
char *def_saisie;
char *def_calculee;
char *def_base;
char *def_tmps;
char **def_ref;
T_varinfo *info_tmps;
T_varinfo **info_ref;
int tmps_org;
int ref_org;
T_discord *discords;
T_discord *tas_discord;
T_discord **p_discord;
Expand Down Expand Up @@ -1481,9 +1493,15 @@ typedef struct S_irdata T_irdata;
#define S_ irdata->saisie
#define C_ irdata->calculee
#define B_ irdata->base
#define T_ irdata->tmps
#define R_ irdata->ref
#define DS_ irdata->def_saisie
#define DC_ irdata->def_calculee
#define DB_ irdata->def_base
#define DT_ irdata->def_tmps
#define DR_ irdata->def_ref
#define IT_ irdata->info_tmps
#define IR_ irdata->info_ref
#define EST_SAISIE 0x0000
#define EST_CALCULEE 0x4000
Expand Down Expand Up @@ -1525,7 +1543,7 @@ extern int modulo_def(int, int);
extern double modulo(double, double);
|}
let gen_lib fmt flags vars rules verifs chainings errors =
let gen_lib fmt (cprog : Mir.program) flags vars rules verifs chainings errors =
let taille_saisie = count vars (Input None) in
let taille_calculee = count vars (Computed (Some Computed)) in
let taille_base = count vars (Computed (Some Base)) in
Expand All @@ -1545,6 +1563,12 @@ let gen_lib fmt flags vars rules verifs chainings errors =
|}
taille_saisie taille_calculee taille_base taille_totale nb_ench;
Format.fprintf fmt {|#define TAILLE_TMP_VARS %d
#define TAILLE_REFS %d
|}
cprog.program_stats.sz_all_tmps cprog.program_stats.nb_all_refs;
Format.fprintf fmt
{|#define ANOMALIE 1
#define DISCORDANCE 2
Expand Down Expand Up @@ -1637,14 +1661,14 @@ let gen_mlang_h fmt cprog flags vars stats_varinfos rules verifs chainings
pr "\n";
gen_annee fmt flags;
pr "\n";
gen_decl_varinfos fmt cprog stats_varinfos;
pr "\n";
gen_const fmt;
pr "\n";
(* The debug functions need T_irdata to be defined so we put them after *)
gen_dbg fmt;
pr "\n";
gen_decl_varinfos fmt cprog stats_varinfos;
pr "\n";
gen_lib fmt flags vars rules verifs chainings errors;
gen_lib fmt cprog flags vars rules verifs chainings errors;
pr "\n";
gen_decl_targets fmt cprog;
pr "\n";
Expand Down
Loading

0 comments on commit 75c5f42

Please sign in to comment.