Commit 10663ae7 authored by Wilke Pierre's avatar Wilke Pierre
Browse files

Dernière mise à jour du sujet avant le premier TP de 2021

parent 6fc62433
No preview for this file type
......@@ -16,12 +16,15 @@ all: $(TG)
$(TG): $(SRC)
ocamlbuild $(PROF) -cflags -warn-error,"+a-26" -cflags -w,"-26" -use-ocamlfind $(TG)
test_lexer: $(SRC)
test_lexer: archi.ml config.ml e_regexp.ml lexer_generator.ml symbols.ml test_lexer.ml utils.ml
ocamlbuild -use-ocamlfind test_lexer.native
./test_lexer.native
dot -Tsvg /tmp/dfa.dot -o /tmp/dfa.svg
dot -Tsvg /tmp/nfa.dot -o /tmp/nfa.svg
config.ml: ../configure
cd .. && ./configure
clean:
rm -rf _build
rm -f config.ml main.native
rm -f config.ml main.native test_lexer.native
......@@ -48,7 +48,9 @@ let constant_propagation_gdef = function
Gfun (constant_propagation_fun f)
let constant_propagation p =
assoc_map constant_propagation_gdef p
if !Options.no_cfg_constprop
then p
else assoc_map constant_propagation_gdef p
let pass_constant_propagation p =
let cfg = constant_propagation p in
......
......@@ -34,7 +34,9 @@ let dead_assign_elimination_gdef = function
Gfun f -> Gfun (iter_dead_assign_elimination_fun f)
let dead_assign_elimination p =
assoc_map dead_assign_elimination_gdef p
if !Options.no_cfg_dae
then p
else assoc_map dead_assign_elimination_gdef p
let pass_dead_assign_elimination cfg =
let cfg = dead_assign_elimination cfg in
......
open Batteries
open Elang
open Cfg_gen
open Cfg_print
open Cfg_liveness
open Cfg
open Utils
open Prog
let optimize_loop_cfg cfg = cfg
......@@ -79,8 +79,9 @@ let nop_elim_gdef gd =
Gfun f -> Gfun (nop_elim_fun f)
let nop_elimination cp =
assoc_map nop_elim_gdef cp
if !Options.no_cfg_ne
then cp
else assoc_map nop_elim_gdef cp
let pass_nop_elimination cfg =
let cfg = nop_elimination cfg in
......
......@@ -55,6 +55,8 @@ let lowercase_letters = "abcdefghijklmnopqrstuvwxyz"
let uppercase_letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
let digits = "0123456789"
let other_characters = "?!=<>_ :;,{}()[]^`-+*/%@\n\t\x00.\"\'\\|~#$&"
(* L'opérateur ^ dénote la concaténation des chaînes de caractères. *)
let alphabet = char_list_of_string (lowercase_letters ^ uppercase_letters ^ digits ^ other_characters)
let letter_regexp = char_range (char_list_of_string (uppercase_letters ^ lowercase_letters))
let digit_regexp = char_range (char_list_of_string digits)
......@@ -62,7 +64,7 @@ let identifier_material = char_range (char_list_of_string (uppercase_letters ^ l
let keyword_regexp s = str_regexp (char_list_of_string s)
(* La liste des expressions régulières permettant d'identifier les tokens du langage E *)
let list_regexp =
let list_regexp : (regexp * (string -> token option)) list =
[
(keyword_regexp "while", fun s -> Some (SYM_WHILE));
(keyword_regexp "int", fun s -> Some (SYM_INT));
......
open Ast
open Elang
open Prog
open Utils
open Report
open Elang_print
open Options
open Batteries
open Elang_print
open Utils
let tag_is_binop =
function
......
......@@ -64,7 +64,7 @@ let star_nfa n t =
que l'expression régulière [r].
[freshstate] correspond à un entier pour lequel il n'y a pas encore d'état dans
le nfa. Il suffit d'incrémenter [freshstate] pour obtenir de nouveaux états non utilisés.
[t] est une fonction du type [string -> token option] utile pour les état finaux.
[t] est une fonction du type [string -> token option] utile pour les états finaux.
*)
let rec nfa_of_regexp r freshstate t =
match r with
......
......@@ -7,6 +7,7 @@ open Prog
open Utils
open Report
open Linear_print
open Report
open Options
let dse_instr (ins: rtl_instr) live =
......@@ -22,6 +23,9 @@ let dse_fun live {linearfunargs; linearfunbody; linearfuninfo; } =
let dse_prog p live =
if !Options.no_linear_dse
then p
else
List.map (fun (fname,gdef) ->
match gdef with
Gfun f ->
......
......@@ -278,6 +278,7 @@ let caller_save live_out allocation rargs =
registers are saved at [fp - 8 * (curstackslot + 1)] *)
let ltl_instrs_of_linear_instr fname live_out allocation
numspilled epilogue_label ins =
let res =
match ins with
| Rbinop (b, rd, rs1, rs2) ->
load_loc reg_tmp1 allocation rs1 >>= fun (l1, r1) ->
......@@ -322,6 +323,9 @@ let ltl_instrs_of_linear_instr fname live_out allocation
load_loc reg_tmp1 allocation r >>= fun (l,r) ->
OK (l @ [LMov (reg_ret, r) ; LJmp epilogue_label])
| Rlabel l -> OK [LLabel (Format.sprintf "%s_%d" fname l)]
in
res >>= fun l ->
OK (LComment (Format.asprintf "#<span style=\"background: pink;\"><b>Linear instr</b>: %a #</span>" (Rtl_print.dump_rtl_instr fname (None, None)) ins)::l)
(** Retrieves the location of the n-th argument (in the callee). The first 8 are
passed in a0-a7, the next are passed on the stack. *)
......
......@@ -93,7 +93,7 @@ let dump_ltl_instr oc (i: ltl_instr) =
| LJmp l -> Format.fprintf oc "j %s" l
| LJmpr r -> Format.fprintf oc "jmpr %s" (print_reg r)
| LConst (rd, i) -> Format.fprintf oc "%s <- %d" (print_reg rd) i
| LComment l -> Format.fprintf oc "; %s" l
| LComment l -> Format.fprintf oc "<span style=\"color: gray;\">; %s</span>" l
| LBranch(cmp, rs1, rs2, s) ->
Format.fprintf oc "%s(%s,%s) ? j %s"
(print_cmpop cmp) (print_reg rs1) (print_reg rs2) s
......
......@@ -7,7 +7,6 @@ let e_dump : string option ref = ref None
let e_run = ref false
let cfg_dump : string option ref = ref None
let cfg_run = ref false
let cfg_run_after_loop = ref false
let cfg_run_after_cp = ref false
let cfg_run_after_dae = ref false
let cfg_run_after_ne = ref false
......
open Batteries
open Utils
type mem_access_size =
| MAS1
| MAS4
......@@ -61,7 +61,7 @@ let set_val env v i =
Hashtbl.replace env v i
let get_val env v =
Hashtbl.find_opt env v
Hashtbl.find_option env v
let find_function (ep: 'a prog) fname : 'a res =
match List.assoc_opt fname ep with
......
......@@ -99,13 +99,24 @@ let make_interf_live
Offert par la maison !
*)
let build_interference_graph (live_out : (int, reg Set.t) Hashtbl.t) : (reg, reg Set.t) Hashtbl.t =
let build_interference_graph (live_out : (int, reg Set.t) Hashtbl.t) code : (reg, reg Set.t) Hashtbl.t =
let interf = Hashtbl.create 17 in
(* On ajoute un sommet pour chaque variable qui apparaît dans le programme. *)
Hashtbl.iter (fun _ s ->
Set.iter (fun v -> Hashtbl.replace interf v Set.empty) s
) live_out;
make_interf_live interf live_out;
(* Les registres dans lesquels on écrit mais qui ne sont jamais vivants doivent être considérés comme en interférence avec tous les autres. *)
let written_regs = written_rtl_regs code in
let written_regs_never_live =
Hashtbl.fold (fun _ regset_live_together acc -> Set.diff acc regset_live_together) live_out
written_regs in
let other_regs = Hashtbl.keys interf |> Set.of_enum in
Set.iter (fun r ->
Set.iter (fun r_other ->
add_interf interf r r_other
) other_regs
) written_regs_never_live;
interf
(* [remove_from_rig rig v] supprime le sommet [v] du graphe d'interférences
......@@ -236,7 +247,8 @@ let regalloc_fun (f: linear_fun)
* (reg, loc) Hashtbl.t (* the allocation *)
* int (* the next stack slot *)
=
let rig = build_interference_graph live_out in
let rig = build_interference_graph live_out f.linearfunbody in
let allocation = Hashtbl.create 17 in
(* Les pseudo-registres qui contiennent les arguments sont traités séparément
dans [ltl_gen.ml]. On les enlève donc du graphe. *)
......
......@@ -24,3 +24,19 @@ type rtl_fun = { rtlfunargs: reg list;
rtlfunentry: int;
rtlfuninfo: (string*reg) list
}
let written_rtl_regs_instr (i: rtl_instr) =
match i with
| Rbinop (_, rd, _, _)
| Runop (_, rd, _)
| Rconst (rd, _)
| Rmov (rd, _) -> Set.singleton rd
| Rprint _
| Rret _
| Rlabel _
| Rbranch (_, _, _, _)
| Rjmp _ -> Set.empty
let written_rtl_regs (l: rtl_instr list) =
List.fold_left (fun acc i -> Set.union acc (written_rtl_regs_instr i))
Set.empty l
......@@ -55,6 +55,7 @@ type token =
| SYM_PRINT
| SYM_EXTERN
| SYM_INCLUDE of string
| SYM_AMPERSAND
let string_of_symbol = function
| SYM_EOF -> "SYM_EOF"
......@@ -103,3 +104,4 @@ let string_of_symbol = function
| SYM_PRINT -> "SYM_PRINT"
| SYM_EXTERN -> "SYM_EXTERN"
| SYM_INCLUDE(s) -> Printf.sprintf "SYM_INCLUDE(%s)" s
| SYM_AMPERSAND -> "SYM_AMPERSAND"
......@@ -74,8 +74,6 @@ let write_mem_bytes mem addr bl =
with _ -> Error (Format.sprintf "Problem when writing mem at address %d\n" ofs)
) (OK [])
(* let write_mem_int mem addr v =
* split_bytes !Archi.wordsize v |> rev |> write_mem_bytes mem addr *)
let write_mem_char mem addr c = write_mem_bytes mem addr [c]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment