Commit 4048103a authored by Armillon Damien's avatar Armillon Damien

fix regalloc for ptr

parent 9b110917
...@@ -28,10 +28,10 @@ test: main.native ...@@ -28,10 +28,10 @@ test: main.native
make -C tests make -C tests
testFun: main.native testFun: main.native
make -C tests DIR="type_funcall/*.e type_basic/*.e char/*.e" make -C tests DIR="type_funcall/*.e type_basic/*.e char/*.e" OPTS=-clever-regalloc
testP: main.native testP: main.native
make -C tests DIR=ptr/*.e make -C tests DIR=ptr/*.e OPTS=-clever-regalloc
testS: main.native testS: main.native
make -C tests DIR=structs/*.e make -C tests DIR=structs/*.e OPTS=-clever-regalloc
\ No newline at end of file \ No newline at end of file
...@@ -8,6 +8,7 @@ open Rtl ...@@ -8,6 +8,7 @@ open Rtl
let gen_live (i: rtl_instr) = let gen_live (i: rtl_instr) =
match i with match i with
| Rbinop (_, _, rs1, rs2) | Rbinop (_, _, rs1, rs2)
| Rstore (rs1,rs2,_)
| Rbranch (_, rs1, rs2, _) -> Set.of_list [rs1; rs2] | Rbranch (_, rs1, rs2, _) -> Set.of_list [rs1; rs2]
| Rprint rs | Rprint rs
| Runop (_, _, rs) | Runop (_, _, rs)
...@@ -16,7 +17,6 @@ let gen_live (i: rtl_instr) = ...@@ -16,7 +17,6 @@ let gen_live (i: rtl_instr) =
| Rret r -> Set.singleton r | Rret r -> Set.singleton r
| Rcall (_,_,rl) -> Set.of_list rl | Rcall (_,_,rl) -> Set.of_list rl
| Rstk(_,_) | Rstk(_,_)
| Rstore (_,_,_)
| Rlabel _ | Rlabel _
| Rjmp _ | Rjmp _
| Rconst (_, _) -> Set.empty | Rconst (_, _) -> Set.empty
......
...@@ -267,8 +267,9 @@ let rtl_to_ltl_registers allocation l = ...@@ -267,8 +267,9 @@ let rtl_to_ltl_registers allocation l =
let written_ltl_regs fname l allocation = let written_ltl_regs fname l allocation =
written_rtl_regs l |> rtl_to_ltl_registers allocation written_rtl_regs l |> rtl_to_ltl_registers allocation
let caller_save live_out allocation rargs = let caller_save live_out allocation rargs rd =
let live_after = live_out in let live_after = if Option.is_some rd then Set.remove (Option.get rd) live_out else live_out in
let live_after_ltl = live_after |> rtl_to_ltl_registers allocation in let live_after_ltl = live_after |> rtl_to_ltl_registers allocation in
overwritten_args rargs allocation >>= fun overwritten_args_tosave -> overwritten_args rargs allocation >>= fun overwritten_args_tosave ->
let l = Set.union live_after_ltl overwritten_args_tosave in let l = Set.union live_after_ltl overwritten_args_tosave in
...@@ -333,13 +334,13 @@ let ltl_instrs_of_linear_instr numlocals fname live_out allocation ...@@ -333,13 +334,13 @@ let ltl_instrs_of_linear_instr numlocals fname live_out allocation
OK (l @ [LMov (reg_ret, r) ; LJmp epilogue_label]) OK (l @ [LMov (reg_ret, r) ; LJmp epilogue_label])
| Rlabel l -> OK [LLabel (Format.sprintf "%s_%d" fname l)] | Rlabel l -> OK [LLabel (Format.sprintf "%s_%d" fname l)]
| Rcall(rd,name,rl) -> | Rcall(rd,name,rl) ->
let* reg_to_save = caller_save live_out allocation rl in let* reg_to_save = caller_save live_out allocation rl rd in
let (save_regs_instructions, arg_saved, ofs) = save_caller_save (Set.to_list reg_to_save) (- (numspilled + numlocals + 1)) in let (save_regs_instructions, arg_saved, ofs) = save_caller_save (Set.to_list reg_to_save) (- (numspilled + numlocals + 1)) in
let* (parameter_passing_instructions,npush) = pass_parameters rl allocation arg_saved in let* (parameter_passing_instructions,npush) = pass_parameters rl allocation arg_saved in
let restore_save_instr = restore_caller_save arg_saved in let restore_save_instr = restore_caller_save arg_saved in
(match rd with (match rd with
| Some rd -> | Some rd ->
let* (store_result,reg_to_save) = store_loc reg_a0 allocation rd in let store_result = make_loc_mov (Reg reg_a0) (Hashtbl.find allocation rd) in (*store_loc reg_a0 allocation rd in*)
OK ( OK (
save_regs_instructions @ save_regs_instructions @
[LAddi (reg_sp,reg_s0 ,((ofs+1) * (Archi.wordsize ())))] @ [LAddi (reg_sp,reg_s0 ,((ofs+1) * (Archi.wordsize ())))] @
......
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