Commit ebfac096 authored by Wilke Pierre's avatar Wilke Pierre
Browse files

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

parent 2fe25b0d
No preview for this file type
......@@ -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";
......
......@@ -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) ();
......
......@@ -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
......
......@@ -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)
......
Supports Markdown
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