diff --git a/Sujet.pdf b/Sujet.pdf index 55b846e457e848a4b1860cefa730a361bfe79e0d..e4ca4bc6d87144e413747c5002e9633bbc910e91 100644 Binary files a/Sujet.pdf and b/Sujet.pdf differ diff --git a/src/Makefile b/src/Makefile index 94e5b1b038cd1a3184de3bb2016872cd86755b61..02ef8aefa24f7571f3847bceee2bed0711a5e7cb 100644 --- a/src/Makefile +++ b/src/Makefile @@ -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 diff --git a/src/cfg_constprop.ml b/src/cfg_constprop.ml index 55440c63ee32a4817c641659b92670c3c0abceee..10ffa8a04e3dbfc7d1c3fc96c22fea114b305563 100644 --- a/src/cfg_constprop.ml +++ b/src/cfg_constprop.ml @@ -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 diff --git a/src/cfg_dead_assign.ml b/src/cfg_dead_assign.ml index e319094bc62d967d2cdbff918bb0e7d8d2e2aa64..8130533fdab83225fe79e4c2dd028ae284f9028d 100644 --- a/src/cfg_dead_assign.ml +++ b/src/cfg_dead_assign.ml @@ -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 diff --git a/src/cfg_loops.ml b/src/cfg_loops.ml deleted file mode 100644 index 9175654367eaba4f9802629c335f52084a528bef..0000000000000000000000000000000000000000 --- a/src/cfg_loops.ml +++ /dev/null @@ -1,11 +0,0 @@ -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 diff --git a/src/cfg_nop_elim.ml b/src/cfg_nop_elim.ml index aae822522f4fb120370e58b9a32f93c5383a3b74..119db24264f239961770804dd84f514f5c04f5af 100644 --- a/src/cfg_nop_elim.ml +++ b/src/cfg_nop_elim.ml @@ -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 diff --git a/src/e_regexp.ml b/src/e_regexp.ml index 58f07775c88b155cafae363d2077e3cc481eab05..779f7f28d636e23ab0733df9797e9be879943a56 100644 --- a/src/e_regexp.ml +++ b/src/e_regexp.ml @@ -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)); diff --git a/src/elang_gen.ml b/src/elang_gen.ml index eb6615b109ae955bbfacc6f310fa77caf1a3325b..29c5029150aca06db8bc6ca704332ae9fbb8ba2a 100644 --- a/src/elang_gen.ml +++ b/src/elang_gen.ml @@ -1,10 +1,11 @@ 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 diff --git a/src/lexer_generator.ml b/src/lexer_generator.ml index f79e1dbf2bf4305a159b886dc73cb407b5ded0ac..06192ef87ea5c27187c59a50121930bdc00ec905 100644 --- a/src/lexer_generator.ml +++ b/src/lexer_generator.ml @@ -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 diff --git a/src/linear_dse.ml b/src/linear_dse.ml index e0ac6d97bf1576b80f8390ccc96b14342cc7cf96..c96ed7eccfa0570db8c7610cf2f670ad2522ec07 100644 --- a/src/linear_dse.ml +++ b/src/linear_dse.ml @@ -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 -> diff --git a/src/ltl_gen.ml b/src/ltl_gen.ml index 06edd325206226d5cfb63a11d9fcd6e3ace70c27..609470626ef64f1258b4e29bae8775798135e8a3 100644 --- a/src/ltl_gen.ml +++ b/src/ltl_gen.ml @@ -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. *) diff --git a/src/ltl_print.ml b/src/ltl_print.ml index 57869ea001c1cd7872fbd8858e836306c3d0ca17..4c6e20482158d437b792b44a788beb58ac7524d8 100644 --- a/src/ltl_print.ml +++ b/src/ltl_print.ml @@ -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 diff --git a/src/options.ml b/src/options.ml index 1c0772e2985065c16d018eacab623a88eb3439c5..aac5b749e7a5610e1c11924b70fd7a0a19b00439 100644 --- a/src/options.ml +++ b/src/options.ml @@ -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 diff --git a/src/prog.ml b/src/prog.ml index ffe49805f8df8110f0786f8950f80bc6fd99bdfc..5da26745e8461b83070928a8f3647a567394b2c7 100644 --- a/src/prog.ml +++ b/src/prog.ml @@ -1,6 +1,6 @@ +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 diff --git a/src/regalloc.ml b/src/regalloc.ml index ec29f3ee409b000f013e9a0340321a28d4c9a195..76e7c48a3ad12944b5f60a9358814d2ffc3f4ef1 100644 --- a/src/regalloc.ml +++ b/src/regalloc.ml @@ -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. *) diff --git a/src/rtl.ml b/src/rtl.ml index 395f73aec2511fd490e9246a2040098d583d863c..3ce33fdec0214095ec8ced78b74b5e8e5c76b275 100644 --- a/src/rtl.ml +++ b/src/rtl.ml @@ -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 diff --git a/src/symbols.ml b/src/symbols.ml index eb3eb8e1611f41f5604e00acb298e8a530ee1356..8659b7511b8b4b9b7c2e2817685332e523cab7e7 100644 --- a/src/symbols.ml +++ b/src/symbols.ml @@ -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" diff --git a/src/utils.ml b/src/utils.ml index aec74d5ff09c3737afc1d35d4617625c553e9873..48ad33f9c0eef6eccb7c40fa7f7d3a42e4d5da32 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -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]