diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/codegen.ml | 95 |
1 files changed, 69 insertions, 26 deletions
diff --git a/src/codegen.ml b/src/codegen.ml index e29c69f..f3f188c 100644 --- a/src/codegen.ml +++ b/src/codegen.ml @@ -38,7 +38,7 @@ type cg_env = { } let env_push n e = - e.c_need_fp := true; + if n <> 0 then e.c_need_fp := true; let kk = e.c_fp_used + n in { c_penv = e.c_penv; c_names = e.c_names; @@ -137,9 +137,9 @@ let cr r a = match a with (* conditionnally read *) | Addr -> lw r areg (0, r) | AddrByReg(x, rg) -> lw r areg (x, rg) | Copy -> nop - | Value(k) -> if r <> k then move r k else nop + | Value k -> if r <> k then move r k else nop let crb r q a = match a with - | Value k when q = nop -> nop, k + | Value k -> q, k | _ -> q ++ cr r a, r let use_regs = [ v0; v1; t0; t1; t2; t3; t4; t5; t6; t7; t8; t9 ] @@ -229,25 +229,36 @@ let rec gen_expr env free_regs save_regs e = end end | TECallFun(id, args, b) -> + let keep_result_in_v0 = (not (List.mem v0 save_regs)) || r = v0 in let code_save_regs, code_restore_regs, env_regs_saved = saver env save_regs in let args_code, _, env_args = code_for_args env_regs_saved args [ a0; a1; a2; a3 ] in - code_save_regs ++ args_code ++ la sp areg (-env_args.c_fp_used, fp) ++ jal id - ++ (if r <> v0 then move r v0 else nop) ++ code_restore_regs, - if b then Addr else Copy + code_save_regs + ++ args_code + ++ la sp areg (-env_args.c_fp_used, fp) ++ jal id + ++ (if keep_result_in_v0 then nop else move r v0) + ++ code_restore_regs, + if b + then (if keep_result_in_v0 then AddrByReg (0, v0) else Addr) + else (if keep_result_in_v0 then Value(v0) else Copy) | TECallVirtual(obj, fi, args, b) -> + let keep_result_in_v0 = (not (List.mem v0 save_regs)) || r = v0 in let code_save_regs, code_restore_regs, env_regs_saved = saver env save_regs in - let args_code, sr, env_args = code_for_args env_regs_saved args [ a1; a2; a3 ] in - let code2, a = gen_expr env_args (a0::use_regs) sr obj in + let args_code, sr, env_args = code_for_args env_regs_saved ((obj, true)::args) [ a0; a1; a2; a3 ] in code_save_regs - ++ args_code ++ code2 ++ cla a0 a ++ lw v0 areg (0, a0) ++ lw v0 areg (fi, v0) + ++ args_code + ++ lw v0 areg (0, a0) ++ lw v0 areg (fi, v0) ++ la sp areg (-env_args.c_fp_used, fp) ++ jalr v0 - ++ (if r <> v0 then move r v0 else nop) ++ code_restore_regs, if b then Addr else Copy + ++ (if keep_result_in_v0 then nop else move r v0) + ++ code_restore_regs, + if b + then (if keep_result_in_v0 then AddrByReg (0, v0) else Addr) + else (if keep_result_in_v0 then Value(v0) else Copy) | TEUnary (x, e) -> let t, a = gen_expr env free_regs save_regs e in begin match x with | Ast.Deref -> begin match a with - | Value r when t = nop -> nop, AddrByReg (0, r) + | Value r -> t, AddrByReg (0, r) | _ -> t ++ cr r a, Addr end | Ast.Ref -> t ++ cla r a, Copy @@ -257,7 +268,7 @@ let rec gen_expr env free_regs save_regs e = | Ast.PreIncr -> begin match a with | Addr -> t ++ lw spare_reg areg (0, r) ++ add spare_reg spare_reg oi 1 ++ sw spare_reg areg (0, r), Addr - | AddrByReg (k, rg) when t = nop -> lw r areg (k, rg) ++ add r r oi 1 ++ sw r areg (k, rg), Copy + | AddrByReg (k, rg) when t = nop -> t ++ lw r areg (k, rg) ++ add r r oi 1 ++ sw r areg (k, rg), Copy | Value v when t = nop && v <> r -> add v v oi 1 ++ move r v, Copy | _ -> assert false end @@ -344,24 +355,56 @@ let rec gen_expr env free_regs save_regs e = ++ la sp areg (-env_args.c_fp_used, fp) ++ jal constr ++ (if r <> a0 then move r a0 else nop) ++ code_restore_regs, Copy and code_for_args env arg_list regs = - let stack_use = max 0 (4 * (List.length arg_list - List.length regs)) in + (* assigne registers to possibly in-register arguments *) + let args_in_regs, args_in_stack, _ = List.fold_left + (fun (ir, is, fr) (arg, byref) -> + match fr with + | [] -> ir, (arg, byref)::is, [] + | r::nfr -> (r, (arg, byref))::ir, is, nfr) + ([], [], regs) arg_list in + (* allocate stack for remaining args *) + let stack_use = 4 * List.length args_in_stack in let kenv, _ = env_push stack_use env in - let code, _, sr, u = List.fold_left - (fun (code, r, sr, u) (arg, byref) -> - match r with - | [] -> + (* make code for in-stack arguments *) + let args_in_stack = List.rev args_in_stack in + let code_for_stack, _ = List.fold_left + (fun (code, u) (arg, byref) -> let c, addr = gen_expr kenv use_regs [] arg in - if byref then ( - c ++ cla v0 addr ++ sw v0 areg (-kenv.c_fp_used + u, fp) ++ code, r, sr, u+4 - ) else ( + (if byref then + c ++ cla v0 addr ++ sw v0 areg (-kenv.c_fp_used + u, fp) ++ code, u+4 + else let c, freg = crb v0 c addr in - c ++ sw freg areg (-kenv.c_fp_used + u, fp) ++ code, r, sr, u+4 + c ++ sw freg areg (-kenv.c_fp_used + u, fp) ++ code, u+4 ) - | reg::more_regs -> - let c, addr = gen_expr kenv (reg::use_regs) sr arg in - code ++ c ++ (if not byref then cr reg addr else cla reg addr), more_regs, reg::sr, u - ) (nop, regs, [], 0) arg_list - in code, sr, kenv + ) (nop, 0) args_in_stack in + (* make code for in-register arguments *) + let arg_reg_do_call, arg_reg_dont_call = + List.partition (fun (_, (e, _)) -> expr_does_call e) args_in_regs in + let rec mk_code_callz e = function + | [] -> nop + | (reg, (expr, byref))::more_args -> + let c, addr = gen_expr e (reg::use_regs) [] expr in + if more_args = [] then + c ++ (if byref then cla reg addr else cr reg addr) + else + let e2, pos = env_push 4 e in + (if byref then + c ++ cla reg addr ++ sw reg areg (pos, fp) + else + let tt, r2 = crb reg c addr in + tt ++ sw r2 areg (pos, fp) + ) ++ (mk_code_callz e2 more_args) ++ lw reg areg (pos, fp) + in + let code_reg_do_call = mk_code_callz kenv arg_reg_do_call in + let code_reg_dont_call, _ = + List.fold_left + (fun (code, ur) (reg, (expr, byref)) -> + let c, addr = gen_expr kenv (reg::use_regs) ur expr in + code ++ c ++ (if byref then cla reg addr else cr reg addr), reg::ur) + (nop, []) arg_reg_dont_call + in + let code = code_for_stack ++ code_reg_do_call ++ code_reg_dont_call + in code, (List.map fst args_in_regs), kenv let gen_expr_v0 env = gen_expr env use_regs env.c_save_regs |