Skip to content

Commit

Permalink
Gestion des références dans le backend C
Browse files Browse the repository at this point in the history
  • Loading branch information
david-michel1 committed May 27, 2024
1 parent 04eb3a7 commit b15fb8e
Show file tree
Hide file tree
Showing 4 changed files with 152 additions and 134 deletions.
158 changes: 79 additions & 79 deletions src/mlang/backend_compilers/bir_to_dgfip_c.ml
Original file line number Diff line number Diff line change
Expand Up @@ -263,11 +263,7 @@ let rec generate_c_expr (e : Mir.expression Pos.marked)
| Var var ->
{ def_test = D.m_var var None Def; value_comp = D.m_var var None Val }
| Attribut (var, a) ->
let ptr =
match Mir.VariableMap.find (Pos.unmark var) var_indexes with
| Dgfip_varid.VarRef (t, _, _) -> t
| _ -> assert false
in
let ptr = Dgfip_varid.gen_ref_info var_indexes (Pos.unmark var) in
let def_test =
D.dinstr
(Format.sprintf "attribut_%s_def((T_varinfo *)%s)" (Pos.unmark a) ptr)
Expand All @@ -278,11 +274,7 @@ let rec generate_c_expr (e : Mir.expression Pos.marked)
in
D.build_transitive_composition { def_test; value_comp }
| Size var ->
let ptr =
match Mir.VariableMap.find (Pos.unmark var) var_indexes with
| Dgfip_varid.VarRef (t, _, _) -> t
| _ -> assert false
in
let ptr = Dgfip_varid.gen_ref_info var_indexes (Pos.unmark var) in
let def_test = D.dinstr "1.0" in
let value_comp = D.dinstr (Format.sprintf "(%s->size)" ptr) in
D.build_transitive_composition { def_test; value_comp }
Expand Down Expand Up @@ -428,20 +420,14 @@ let rec generate_stmt (dgfip_flags : Dgfip_options.flags)
| PrintString s ->
Format.fprintf oc "print_string(%s, %s, \"%s\");@;" print_std
pr_ctx (str_escape s)
| PrintName (var, _) -> begin
match Mir.VariableMap.find var var_indexes with
| Dgfip_varid.VarRef (t, _, _) ->
Format.fprintf oc "print_string(%s, %s, %s->name);@;"
print_std pr_ctx t
| _ -> assert false
end
| PrintAlias (var, _) -> begin
match Mir.VariableMap.find var var_indexes with
| Dgfip_varid.VarRef (t, _, _) ->
Format.fprintf oc "print_string(%s, %s, %s->alias);@;"
print_std pr_ctx t
| _ -> assert false
end
| PrintName (var, _) ->
let ptr = Dgfip_varid.gen_ref_info var_indexes var in
Format.fprintf oc "print_string(%s, %s, %s->name);@;" print_std
pr_ctx ptr
| PrintAlias (var, _) ->
let ptr = Dgfip_varid.gen_ref_info var_indexes var in
Format.fprintf oc "print_string(%s, %s, %s->alias);@;" print_std
pr_ctx ptr
| PrintIndent e ->
let locals, def, value =
D.build_expression @@ generate_c_expr e var_indexes
Expand Down Expand Up @@ -475,50 +461,58 @@ let rec generate_stmt (dgfip_flags : Dgfip_options.flags)
args;
Format.fprintf oc "@]@;}@;"
| Iterate (m_var, vcs, expr, stmts) ->
let pr fmt = Format.fprintf oc fmt in
let var = Pos.unmark m_var in
let it_name = fresh_c_local "iterate" in
Com.CatVar.Map.iter
(fun vc _ ->
let vcd = Com.CatVar.Map.find vc program.program_var_categories in
let ref_idx = Com.Var.loc_int var in
let ref_tab = Dgfip_varid.gen_tab (Some vcd.loc) in
let var_indexes =
Mir.VariableMap.add var
(Dgfip_varid.VarRef
("tab_" ^ it_name, Some vcd.loc, Com.Var.loc_int var))
var_indexes
Mir.VariableMap.add var (Dgfip_varid.VarRef ref_idx) var_indexes
in
Format.fprintf oc "@[<v 2>{@;";
Format.fprintf oc
"T_varinfo_%s *tab_%s = varinfo_%s;@;int nb_%s = 0;@;" vcd.id_str
it_name vcd.id_str it_name;
Format.fprintf oc "@[<v 2>while (nb_%s < NB_%s) {@;" it_name
vcd.id_str;
let ref_info = Dgfip_varid.gen_ref_info var_indexes var in
let ref_def = Dgfip_varid.gen_ref_def var_indexes var in
let ref_val = Dgfip_varid.gen_ref_val var_indexes var in
let cond_val = "cond_" ^ it_name in
let cond_def = cond_val ^ "_d" in
let locals, def, value =
D.build_expression @@ generate_c_expr expr var_indexes
in
Format.fprintf oc "char %s;@;double %s;@;@[<v 2>{@;%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
(generate_stmts dgfip_flags program var_indexes)
stmts;
Format.fprintf oc "tab_%s++;@;nb_%s++;@;" it_name it_name;
Format.fprintf oc "@]}@;";
Format.fprintf oc "@]}@;")
pr "@[<v 2>{@;";
pr "T_varinfo_%s *tab_%s = varinfo_%s;@;" vcd.id_str it_name
vcd.id_str;
pr "int nb_%s = 0;@;" it_name;
pr "@[<v 2>while (nb_%s < NB_%s) {@;" it_name vcd.id_str;
pr "char %s;@;" cond_def;
pr "double %s;@;" cond_val;
pr "%s = (T_varinfo *)tab_%s;@;" ref_info it_name;
pr "%s = &(D%s[%s->idx]);@;" ref_def ref_tab ref_info;
pr "%s = &(%s[%s->idx]);@;" ref_val ref_tab ref_info;
pr "@[<v 2>{@;";
pr "%a" D.format_local_declarations locals;
pr "%a@;" (D.format_assign dgfip_flags var_indexes cond_def) def;
pr "%a" (D.format_assign dgfip_flags var_indexes cond_val) value;
pr "@]@;";
pr "}@;";
pr "@[<hov 2>if(%s && %s){@;" cond_def cond_val;
pr "%a@]@;" (generate_stmts dgfip_flags program var_indexes) stmts;
pr "}@;";
pr "tab_%s++;@;" it_name;
pr "nb_%s++;" it_name;
pr "@]@;}";
pr "@]@;}@;")
vcs
| Restore (vars, var_params, stmts) ->
Format.fprintf oc "@[<v 2>{@;";
let pr fmt = Format.fprintf oc fmt in
pr "@[<v 2>{@;";
let rest_name = fresh_c_local "restore" in
Format.fprintf oc "T_env_sauvegarde *%s = NULL;@;" rest_name;
pr "T_env_sauvegarde *%s = NULL;@;" rest_name;
List.iter
(fun m_v ->
let v = Pos.unmark m_v in
Format.fprintf oc "env_sauvegarder(&%s, %s, %s, %s);@;" rest_name
pr "env_sauvegarder(&%s, %s, %s, %s);@;" rest_name
(Dgfip_varid.gen_access_def_pointer var_indexes v)
(Dgfip_varid.gen_access_pointer var_indexes v)
(Dgfip_varid.gen_size var_indexes v))
Expand All @@ -530,46 +524,51 @@ let rec generate_stmt (dgfip_flags : Dgfip_options.flags)
Com.CatVar.Map.iter
(fun vc _ ->
let vcd = Com.CatVar.Map.find vc program.program_var_categories in
let ref_idx = Com.Var.loc_int var in
let ref_tab = Dgfip_varid.gen_tab (Some vcd.loc) in
let var_indexes =
Mir.VariableMap.add var
(Dgfip_varid.VarRef
("tab_" ^ it_name, Some vcd.loc, Com.Var.loc_int var))
var_indexes
Mir.VariableMap.add var (Dgfip_varid.VarRef ref_idx) var_indexes
in
Format.fprintf oc "@[<v 2>{@;";
Format.fprintf oc
"T_varinfo_%s *tab_%s = varinfo_%s;@;int nb_%s = 0;@;"
vcd.id_str it_name vcd.id_str it_name;
Format.fprintf oc "@[<v 2>while (nb_%s < NB_%s) {@;" it_name
vcd.id_str;
let ref_info = Dgfip_varid.gen_ref_info var_indexes var in
let ref_def = Dgfip_varid.gen_ref_def var_indexes var in
let ref_val = Dgfip_varid.gen_ref_val var_indexes var in
let cond_val = "cond_" ^ it_name in
let cond_def = cond_val ^ "_d" in
let locals, def, value =
D.build_expression @@ generate_c_expr expr var_indexes
in
Format.fprintf oc
"char %s;@;double %s;@;@[<v 2>{@;%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){@;" cond_def cond_val;
Format.fprintf oc "env_sauvegarder(&%s, %s, %s, %s);@;" rest_name
pr "@[<v 2>{@;";
pr "T_varinfo_%s *tab_%s = varinfo_%s;@;" vcd.id_str it_name
vcd.id_str;
pr "int nb_%s = 0;@;" it_name;
pr "@[<v 2>while (nb_%s < NB_%s) {@;" it_name vcd.id_str;
pr "char %s;@;" cond_def;
pr "double %s;@;" cond_val;
pr "%s = (T_varinfo *)tab_%s;@;" ref_info it_name;
pr "%s = &(D%s[%s->idx]);@;" ref_def ref_tab ref_info;
pr "%s = &(%s[%s->idx]);@;" ref_val ref_tab ref_info;
pr "@[<v 2>{@;";
pr "%a" D.format_local_declarations locals;
pr "%a@;" (D.format_assign dgfip_flags var_indexes cond_def) def;
pr "%a" (D.format_assign dgfip_flags var_indexes cond_val) value;
pr "@]@;";
pr "}@;";
pr "@[<hov 2>if(%s && %s){@;" cond_def cond_val;
pr "env_sauvegarder(&%s, %s, %s, %s);" rest_name
(Dgfip_varid.gen_access_def_pointer var_indexes var)
(Dgfip_varid.gen_access_pointer var_indexes var)
(Dgfip_varid.gen_size var_indexes var);
Format.fprintf oc "@]@;}@;";
Format.fprintf oc "tab_%s++;@;nb_%s++;@;" it_name it_name;
Format.fprintf oc "@]}@;";
Format.fprintf oc "@]}@;")
pr "@]@;";
pr "}@;";
pr "tab_%s++;@;" it_name;
pr "nb_%s++;" it_name;
pr "@]@;}";
pr "@]@;}@;")
vcs)
var_params;
Format.fprintf oc "%a@;"
(generate_stmts dgfip_flags program var_indexes)
stmts;
Format.fprintf oc "env_restaurer(&%s);@;" rest_name;
Format.fprintf oc "@]}@;"
pr "%a@;" (generate_stmts dgfip_flags program var_indexes) stmts;
pr "env_restaurer(&%s);@;" rest_name;
pr "@]}@;"
| RaiseError (m_err, var_opt) ->
let err = Pos.unmark m_err in
let err_name = Pos.unmark err.Com.Error.name in
Expand Down Expand Up @@ -619,7 +618,8 @@ let generate_var_tmp_decls (oc : Format.formatter) (tf : Mir.target_data) =
(match sz_opt with
| None -> pr "@;info->size = 1;"
| Some i -> pr "@;info->size = %d;" i);
pr "@;info->cat = ID_TMP_VARS;")
pr "@;info->cat = ID_TMP_VARS;";
pr "@;info->loc_cat = EST_TEMPORAIRE;")
tf.target_tmp_vars;
pr "@]@;}");
if tf.target_nb_refs > 0 then
Expand Down
24 changes: 16 additions & 8 deletions src/mlang/backend_compilers/dgfip_gen_files.ml
Original file line number Diff line number Diff line change
Expand Up @@ -776,9 +776,15 @@ let gen_table_varinfo fmt var_dict cat
StrMap.fold
(fun _ (var, idx, size) nb ->
if Com.CatVar.compare (Com.Var.cat var) cat = 0 then (
Format.fprintf fmt " { \"%s\", \"%s\", %d, %d, %d"
let loc_cat =
match (Com.Var.loc_tgv var).loc_cat with
| Com.CatVar.LocComputed -> "EST_CALCULEE"
| Com.CatVar.LocBase -> "EST_BASE"
| Com.CatVar.LocInput -> "EST_SAISIE"
in
Format.fprintf fmt " { \"%s\", \"%s\", %d, %d, %d, %s"
(Pos.unmark var.Com.Var.name)
(Com.Var.alias_str var) idx size id_int;
(Com.Var.alias_str var) idx size id_int loc_cat;
StrMap.iter
(fun _ av -> Format.fprintf fmt ", %d" (Pos.unmark av))
(Com.Var.attrs var);
Expand Down Expand Up @@ -867,6 +873,7 @@ let gen_decl_varinfos fmt (cprog : Mir.program) stats =
int idx;
int size;
int cat;
int loc_cat;
} T_varinfo;

|};
Expand All @@ -879,6 +886,7 @@ let gen_decl_varinfos fmt (cprog : Mir.program) stats =
int idx;
int size;
int cat;
int loc_cat;
|}
id_str;
StrSet.iter (fun an -> Format.fprintf fmt " int attr_%s;\n" an) attr_set;
Expand Down Expand Up @@ -1460,15 +1468,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 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 DT_ irdata->def_tmps*/
/*#define DR_ irdata->def_ref*/
/*#define IT_ irdata->info_tmps*/
/*#define IR_ irdata->info_ref*/
#define EST_SAISIE 0x00000
#define EST_CALCULEE 0x04000
Expand Down
40 changes: 25 additions & 15 deletions src/mlang/backend_compilers/dgfip_varid.ml
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ type var_id =
| VarInput of int
| VarBase of int
| VarComputed of int
| VarRef of string * Com.CatVar.loc option * int
| VarRef of int

(* Map from variables to their TGV ID *)
type var_id_map = var_id Mir.VariableMap.t
Expand All @@ -30,11 +30,22 @@ let gen_tab = function
| Some Com.CatVar.LocInput -> "S_"
| None -> assert false

let gen_loc_type = function
| Some Com.CatVar.LocComputed -> "EST_CALCULEE"
| Some Com.CatVar.LocBase -> "EST_BASE"
| Some Com.CatVar.LocInput -> "EST_SAISIE"
| None -> assert false
let gen_ref tab i = Printf.sprintf "irdata->%sref[irdata->ref_org + (%d)]" tab i

let gen_ref_info vm (v : Com.Var.t) =
match Mir.VariableMap.find v vm with
| VarRef i -> gen_ref "info_" i
| _ -> assert false

let gen_ref_def vm (v : Com.Var.t) =
match Mir.VariableMap.find v vm with
| VarRef i -> gen_ref "def_" i
| _ -> assert false

let gen_ref_val vm (v : Com.Var.t) =
match Mir.VariableMap.find v vm with
| VarRef i -> gen_ref "" i
| _ -> assert false

let gen_access_def vm (v : Com.Var.t) offset =
let vn = Pos.unmark v.name in
Expand All @@ -46,8 +57,7 @@ let gen_access_def vm (v : Com.Var.t) offset =
| VarInput i -> Printf.sprintf "DS_[%d/*%s*/%s]" i vn offset
| VarBase i -> Printf.sprintf "DB_[%d/*%s*/%s]" i vn offset
| VarComputed i -> Printf.sprintf "DC_[%d/*%s*/%s]" i vn offset
| VarRef (t, l, _) ->
Printf.sprintf "D%s[%s->idx/*%s*/%s]" (gen_tab l) t vn offset
| VarRef i -> Printf.sprintf "*(%s/*%s*/%s)" (gen_ref "def_" i) vn offset

let gen_access_val vm (v : Com.Var.t) offset =
let vn = Pos.unmark v.name in
Expand All @@ -59,8 +69,7 @@ let gen_access_val vm (v : Com.Var.t) offset =
| VarInput i -> Printf.sprintf "S_[%d/*%s*/%s]" i vn offset
| VarBase i -> Printf.sprintf "B_[%d/*%s*/%s]" i vn offset
| VarComputed i -> Printf.sprintf "C_[%d/*%s*/%s]" i vn offset
| VarRef (t, l, _) ->
Printf.sprintf "%s[%s->idx/*%s*/%s]" (gen_tab l) t vn offset
| VarRef i -> Printf.sprintf "*(%s/*%s*/%s)" (gen_ref "" i) vn offset

let gen_access_pointer vm (v : Com.Var.t) =
let vn = Pos.unmark v.name in
Expand All @@ -72,7 +81,7 @@ let gen_access_pointer vm (v : Com.Var.t) =
| VarInput i -> Printf.sprintf "(S_ + %d/*%s*/)" i vn
| VarBase i -> Printf.sprintf "(B_ + %d/*%s*/)" i vn
| VarComputed i -> Printf.sprintf "(C_ + %d/*%s*/)" i vn
| VarRef (t, l, _) -> Printf.sprintf "(%s + %s->idx/*%s*/)" (gen_tab l) t vn
| VarRef i -> Printf.sprintf "(%s/*%s*/)" (gen_ref "" i) vn

let gen_access_def_pointer vm (v : Com.Var.t) =
let vn = Pos.unmark v.name in
Expand All @@ -84,8 +93,7 @@ let gen_access_def_pointer vm (v : Com.Var.t) =
| VarInput i -> Printf.sprintf "(DS_ + %d/*%s*/)" i vn
| VarBase i -> Printf.sprintf "(DB_ + %d/*%s*/)" i vn
| VarComputed i -> Printf.sprintf "(DC_ + %d/*%s*/)" i vn
| VarRef (t, l, _) ->
Printf.sprintf "(D%s + %s->idx/*%s*/)" (gen_tab l) t vn
| VarRef i -> Printf.sprintf "(%s/*%s*/)" (gen_ref "def_" i) vn

let gen_access_pos_from_start vm (v : Com.Var.t) =
if Com.Var.is_temp v then
Expand All @@ -95,12 +103,14 @@ let gen_access_pos_from_start vm (v : Com.Var.t) =
| VarInput i -> Printf.sprintf "EST_SAISIE | %d" i
| VarBase i -> Printf.sprintf "EST_BASE | %d" i
| VarComputed i -> Printf.sprintf "EST_CALCULEE | %d" i
| VarRef (t, l, _) -> Printf.sprintf "%s | %s->idx" (gen_loc_type l) t
| VarRef i ->
let info = gen_ref "info_" i in
Printf.sprintf "%s->loc_cat | %s->idx" info info

let gen_size vm (v : Com.Var.t) =
let get_size (v : Com.Var.t) = Format.sprintf "%d" (Com.Var.size v) in
if Com.Var.is_temp v then get_size v
else
match Mir.VariableMap.find v vm with
| VarInput _ | VarBase _ | VarComputed _ -> get_size v
| VarRef (t, _, _) -> Format.sprintf "(%s->size)" t
| VarRef i -> Format.sprintf "(%s->size)" (gen_ref "info_" i)
Loading

0 comments on commit b15fb8e

Please sign in to comment.