Commit 71894415 authored by Armillon Damien's avatar Armillon Damien
Browse files

ltl functions !

parent c6e03578
......@@ -28,4 +28,4 @@ test: main.native
make -C tests
testFun: main.native
make -C tests DIR=funcall/*.e
\ No newline at end of file
make -C tests DIR=custom/*.e
\ No newline at end of file
......@@ -16,17 +16,20 @@ let gen_live (i: rtl_instr) =
| Rmov (_, rs) -> Set.singleton rs
| Rret r -> Set.singleton r
| Rlabel _ -> Set.empty
| Rcall (_,_,rl) -> Set.of_list rl
let kill_live (i: rtl_instr) =
match i with
| Rbinop (_, rd, _, _)
| Runop (_, rd,_)
| Rconst (rd, _)
| Rcall(Some rd,_,_)
| Rmov (rd,_) -> Set.singleton rd
| Rbranch (_, _, _, _)
| Rprint _
| Rret _
| Rjmp _
| Rcall(None,_,_)
| Rlabel _ -> Set.empty
let linear_succs (ins: rtl_instr) i labels =
......
......@@ -60,6 +60,15 @@ let rec exec_linear_instr oc lp fname f st (i: rtl_instr) =
| _ -> Error (Printf.sprintf "Ret on undefined register (%s)" (print_reg r))
end
| Rlabel n -> OK (None, st)
| Rcall (rs,name,regl) ->
let* f' = find_function lp name in
let params = List.map (Hashtbl.find st.regs) regl in
let* (v,st) = exec_linear_fun oc lp st name f' params in
if Option.is_some rs then
match v with
| Some v -> let rs = Option.get rs in Hashtbl.replace st.regs rs v; OK (None,st)
| None ->Error (Printf.sprintf "function %s return nothing can't assign in (%s)" name (print_reg (Option.get rs)))
else OK (None,st)
and exec_linear_instr_at oc lp fname ({ linearfunbody; } as f) st i =
let l = List.drop_while (fun x -> x <> Rlabel i) linearfunbody in
......
......@@ -215,11 +215,13 @@ let written_rtl_regs_instr (i: rtl_instr) =
| Rbinop (_, rd, _, _)
| Runop (_, rd, _)
| Rconst (rd, _)
| Rcall(Some rd,_,_)
| Rmov (rd, _) -> Set.singleton rd
| Rprint _
| Rret _
| Rlabel _
| Rbranch (_, _, _, _)
| Rcall(None,_,_)
| Rjmp _ -> Set.empty
let read_rtl_regs_instr (i: rtl_instr) =
......@@ -235,6 +237,7 @@ let read_rtl_regs_instr (i: rtl_instr) =
| Rlabel _
| Rconst (_, _)
| Rjmp _ -> Set.empty
| Rcall(_,_,rl) -> Set.of_list rl
let read_rtl_regs (l: rtl_instr list) =
List.fold_left (fun acc i -> Set.union acc (read_rtl_regs_instr i))
......@@ -323,6 +326,28 @@ 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)]
| Rcall(rd,name,rl) ->
let* reg_to_save = caller_save live_out allocation rl in
let (save_regs_instructions, arg_saved, ofs) = save_caller_save (Set.to_list reg_to_save) (- (numspilled+1)) in
let* (parameter_passing_instructions,npush) = pass_parameters rl allocation arg_saved in
let restore_save_instr = restore_caller_save arg_saved in
match rd with
| Some rd ->
let* (store_result,reg_to_save) = store_loc reg_a0 allocation rd in
OK (
save_regs_instructions @
[LAddi (reg_sp,reg_s0 ,((ofs+1) * (Archi.wordsize ())))] @
parameter_passing_instructions @
[LCall name]@
store_result@
restore_save_instr)
| None ->
OK (
save_regs_instructions @
[LAddi (reg_sp,reg_s0 ,((ofs+1)*(Archi.wordsize ())))] @
parameter_passing_instructions @
[LCall name] @
restore_save_instr)
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)
......
......@@ -18,6 +18,7 @@ type rtl_instr = Rbinop of binop * reg * reg * reg
| Rret of reg
| Rlabel of int
| Rprint of reg
| Rcall of reg option * string * reg list
type rtl_fun = { rtlfunargs: reg list;
rtlfunbody: (int, rtl_instr list) Hashtbl.t;
......@@ -30,13 +31,16 @@ let written_rtl_regs_instr (i: rtl_instr) =
| Rbinop (_, rd, _, _)
| Runop (_, rd, _)
| Rconst (rd, _)
| Rcall(Some rd,_,_)
| Rmov (rd, _) -> Set.singleton rd
| Rprint _
| Rret _
| Rlabel _
| Rbranch (_, _, _, _)
| Rcall(None,_,_)
| 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
......@@ -58,7 +58,14 @@ let rec rtl_instrs_of_cfg_expr (next_reg, var2reg) (e: expr) =
let (reg, operations, next_reg, var2reg) = rtl_instrs_of_cfg_expr (next_reg, var2reg) expr1 in
let (reg',operations',next_reg',var2reg') = rtl_instrs_of_cfg_expr (next_reg, var2reg) expr2 in
(next_reg',operations @ operations' @ [Rbinop(op,next_reg', reg,reg')], next_reg'+ 1, var2reg')
| _ -> (next_reg,[], next_reg,var2reg)
| Ecall(name, el) ->
let(cfg_list, args_reg,next_reg', var2reg') = List.fold_left (
fun (cfg_list, args_reg,next_reg', var2reg') e ->
let (rres,l,next_reg', var2reg') = rtl_instrs_of_cfg_expr (next_reg', var2reg') e in
(cfg_list@l, args_reg@[rres], next_reg', var2reg')
) ([], [], next_reg, var2reg) el in
(next_reg',cfg_list@[Rcall(Some next_reg', name, args_reg)], next_reg'+1, var2reg')
let is_cmp_op =
function Eclt -> Some Rclt
| Ecle -> Some Rcle
......@@ -94,7 +101,14 @@ let rtl_instrs_of_cfg_node ((next_reg:int), (var2reg: (string*int) list)) (c: cf
(l @ [Rprint(rres); Rjmp(s)], next_reg', var2reg')
| Cnop(s) -> ([Rjmp(s)], next_reg, var2reg)
| _ -> ([],next_reg,var2reg)
| Ccall(name,el,s) ->
let(cfg_list, args_reg,next_reg', var2reg') = List.fold_left (
fun (cfg_list, args_reg,next_reg', var2reg') e ->
let (rres,l,next_reg', var2reg') = rtl_instrs_of_cfg_expr (next_reg', var2reg') e in
(cfg_list@l, args_reg@[rres], next_reg', var2reg')
) ([], [], next_reg, var2reg) el in
(cfg_list@[Rcall(None, name, args_reg); Rjmp(s)], next_reg', var2reg')
let rtl_instrs_of_cfg_fun cfgfunname ({ cfgfunargs; cfgfunbody; cfgentry }: cfg_fun) =
let (rargs, next_reg, var2reg) =
......
......@@ -41,6 +41,8 @@ let dump_rtl_instr name (live_in, live_out) oc (i: rtl_instr) =
| Rret r -> Format.fprintf oc "ret %s" (print_reg r)
| Rprint r -> Format.fprintf oc "print %s" (print_reg r)
| Rlabel n -> Format.fprintf oc "%s_%d:" name n
| Rcall (Some r,n,el) -> Format.fprintf oc "%s <- %s(%s)" (print_reg r) n (String.concat ", " $ List.map print_reg el)
| Rcall (None,n,el) -> Format.fprintf oc "%s(%s)" n (String.concat ", " $ List.map print_reg el)
end;
Format.fprintf oc "\n";
dump_liveness live_out "after"
......
......@@ -77,6 +77,16 @@ let rec exec_rtl_instr oc rp rtlfunname f st (i: rtl_instr) =
| _ -> Error (Printf.sprintf "Print on undefined register (%s)" (print_reg r))
end
| Rlabel n -> OK (None, st)
| Rcall (rs,name,regl) ->
let* f' = find_function rp name in
let params = List.map (Hashtbl.find st.regs) regl in
let* (v,st) = exec_rtl_fun oc rp st name f' params in
if Option.is_some rs then
match v with
| Some v -> let rs = Option.get rs in Hashtbl.replace st.regs rs v; OK (None,st)
| None ->Error (Printf.sprintf "function %s return nothing can't assign in (%s)" name (print_reg (Option.get rs)))
else OK (None,st)
and exec_rtl_instr_at oc rp rtlfunname ({ rtlfunbody; } as f: rtl_fun) st i =
match Hashtbl.find_option rtlfunbody i with
......
......@@ -17,4 +17,5 @@
**/*.s
**/*.svg
results.html
__pycache__
\ No newline at end of file
__pycache__
custom
\ No newline at end of file
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