Sujet (builtins) + Détection de conflit dans alpaga + Résolution de bugs dans ltl_gen

ebfac096 · Wilke Pierre · 2fe25b0d · ebfac096 · ebfac096 · ebfac096
Commit ebfac096 authored 5 years ago by Wilke Pierre
--- a/Sujet.pdf
+++ b/Sujet.pdf
--- a/alpaga/ll_parser.ml
+++ b/alpaga/ll_parser.ml
@@ -101,6 +101,17 @@ let string_of_lltype = function
  | Follow i -> Printf.sprintf "<a style='color:red;' href=\"#rule-%d\">%d</a>" i i


+let check_conflicts (toks,nts,rules) () =
+  List.fold_left
+    (fun acc x ->
+       List.fold_left (fun acc t ->
+           let rs = (hashget_def lltable (x,t) []) in
+           if List.length rs > 1 then true else acc
+          ) acc toks
+    ) false
+    nts
+
+
 let print_table (toks,nts,rules) oc () =
  Format.fprintf oc "<!DOCTYPE html>" ;
  Format.fprintf oc "<html><head><link rel='stylesheet' type='text/css' href='style.css'/></head>\n";

--- a/alpaga/ml_parser_generator.ml
+++ b/alpaga/ml_parser_generator.ml
@@ -164,6 +164,9 @@ let _ =
    iter_first (toks, nts, rules) ();
    iter_follownt (toks, nts, rules) ();
    fill_lltable (toks, nts, rules) ();
+    let has_conflict = check_conflicts (toks, nts, rules) () in
+    if has_conflict
+    then Printf.fprintf stderr "Warning! There is a conflict in your grammar. Check the prediction table for more details.\n";
    (match !table_file with
     | Some tfile -> let oc = open_out tfile in
       print_html (toks, nts, rules) (Format.formatter_of_out_channel oc) ();

--- a/src/ltl_gen.ml
+++ b/src/ltl_gen.ml
@@ -299,7 +299,6 @@ let ltl_instrs_of_linear_instr fname live_out allocation
    store_loc reg_tmp1 allocation rd >>= fun (ld, rd) ->
    OK (ls @ LMov(rd, rs) :: ld)
  | Rprint r ->
-
    let (save_a_regs, arg_saved, ofs) =
      save_caller_save
        (range 32)
@@ -312,7 +311,7 @@ let ltl_instrs_of_linear_instr fname live_out allocation
    in
    parameter_passing >>= fun parameter_passing ->
    OK (LComment "Saving a0-a7,t0-t6" :: save_a_regs @
-        LAddi(reg_sp, reg_s0, !Archi.wordsize * ofs) ::
+        LAddi(reg_sp, reg_s0, !Archi.wordsize * (ofs + 1)) ::
        parameter_passing @
        LCall "print" ::
        LComment "Restoring a0-a7,t0-t6" :: restore_caller_save arg_saved)
@@ -400,7 +399,7 @@ let ltl_prog_of_linear lp =
        let f_alloc =
          match Hashtbl.find_option allocations fname with
          | None -> (Hashtbl.create 0, 0)
-          | Some (rig, allocation, next_stack_slot) -> (allocation, - next_stack_slot)
+          | Some (rig, allocation, next_stack_slot) -> (allocation, - next_stack_slot - 1)
        in
        let f_lives =
          match Hashtbl.find_option lives fname with

--- a/src/regalloc.ml
+++ b/src/regalloc.ml
@@ -41,11 +41,12 @@ let regs_in_instr_list (l: rtl_instr list) : reg Set.t =
 let regalloc_on_stack_fun (f: linear_fun) : ((reg, loc) Hashtbl.t * int)=
  let allocation = Hashtbl.create 10 in
  let regs = regs_in_instr_list f.linearfunbody in
+  let regs = Set.diff regs (Set.of_list f.linearfunargs) in
  let next_stack_slot =
    List.fold_left (fun next_stack_slot r ->
        Hashtbl.replace allocation r (Stk (next_stack_slot));
        next_stack_slot - 1
-      ) 0 (Set.to_list regs) in
+      ) (-1) (Set.to_list regs) in
  (allocation, next_stack_slot)


@@ -248,7 +249,7 @@ let regalloc_fun (f: linear_fun)
  let next_stack_slot =
    List.fold_left (fun next_stack_slot decision ->
        allocate allocation rig all_colors next_stack_slot decision
-      ) 0 stack in
+      ) (-1) stack in
  (rig, allocation, next_stack_slot)