diff options
| -rw-r--r-- | src/codegen.ml | 154 |
1 files changed, 88 insertions, 66 deletions
diff --git a/src/codegen.ml b/src/codegen.ml index 2b45c3f..6570f7e 100644 --- a/src/codegen.ml +++ b/src/codegen.ml @@ -29,11 +29,12 @@ type cg_env = { } let env_push n e = + let kk = e.c_fp_used + n in { c_penv = e.c_penv; c_names = e.c_names; c_ret_ref = e.c_ret_ref; - c_fp_used = e.c_fp_used + n; - c_save_regs = e.c_save_regs } + c_fp_used = kk; + c_save_regs = e.c_save_regs }, -kk let globals_env = ref Smap.empty @@ -75,11 +76,17 @@ let rec stmt_does_call = function type expr_type = | Addr (* top register contains address of value *) + | AddrByReg of int * register (* value at int(register) *) | Copy (* top register contains copy of value *) | Value of register (* other register is home to the value *) +let cla r a = match a with + | Addr -> nop + | AddrByReg(x, rg) -> la r areg (x, rg) + | _ -> assert false 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 let crb r q a = match a with @@ -108,10 +115,7 @@ let saver env save_regs = ) (nop, nop, env) save_regs in - let d = env2.c_fp_used - env.c_fp_used in - (if d = 0 then nop else la sp areg (-env2.c_fp_used, fp)) ++ sc, - lc ++ (if d = 0 then nop else la sp areg (-env.c_fp_used, fp)), - env2 + sc, lc, env2 (* Convention : doit garder $sp invariant ; renvoie le résultat dans le premier registre de free_regs @@ -127,14 +131,14 @@ let rec gen_expr env free_regs save_regs e = | TENull -> move r zero, Copy | TEThis -> (* convention : this is always the first argument, so in a0 *) begin match Smap.find "this" env.c_names with - | VRegister(k) when k <> r -> move r k, Copy + | VRegister(k) when k <> r -> nop, Value k | VStack(i) -> lw r areg (i, fp), Copy | _ -> assert false end | TEIdent(i) -> begin match Smap.find i env.c_names with | VGlobal -> la r alab i, Addr - | VStack(i) -> la r areg (i, fp), Addr + | VStack(i) -> nop, AddrByReg(i, fp) | VStackByRef(i) -> lw r areg (i, fp), Addr | VRegister(k) -> nop, Value k | VRegisterByRef(k) when k <> r -> move r k, Addr @@ -144,10 +148,12 @@ let rec gen_expr env free_regs save_regs e = begin match more with | [] -> let t1, ae1 = gen_expr env free_regs save_regs e1 in - let t2, ae2 = gen_expr (env_push 4 env) free_regs save_regs e2 in + let env2, tspot = env_push 4 env in + let t2, ae2 = gen_expr env2 free_regs save_regs e2 in let t2 = t2 ++ cr r ae2 in begin match ae1 with - | Addr -> t1 ++ push r ++ t2 ++ pop spare_reg ++ sw r areg (0, spare_reg), Copy + | Addr -> t1 ++ sw r areg (tspot, fp) ++ t2 ++ lw spare_reg areg (tspot, fp) ++ sw r areg (0, spare_reg), Copy + | AddrByReg (x, rg) when t1 = nop -> t2 ++ sw r areg (x, rg), Copy | Value k when t1 = nop && k <> r -> t2 ++ move k r, Copy | _ -> assert false end @@ -157,41 +163,48 @@ let rec gen_expr env free_regs save_regs e = let t2 = t2 ++ cr r ae2 in begin match ae1 with | Addr -> t2 ++ t1 ++ sw r areg (0, b), Copy + | AddrByReg (x, rg) when t1 = nop -> t2 ++ sw r areg (x, rg), Copy | Value k when t1 = nop && k <> r -> t2 ++ move k r, Copy | _ -> assert false end end | TECallFun(id, args, b) -> let code_save_regs, code_restore_regs, env_regs_saved = saver env save_regs in - let args_code, _, su = code_for_args env_regs_saved args [ a0; a1; a2; a3 ] in - code_save_regs ++ args_code ++ jal id ++ (if su <> 0 then popn su else nop) - ++ (if r <> v0 then move r v0 else nop) ++ code_restore_regs, if b then Addr else Copy + 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 | TECallVirtual(obj, fi, args, b) -> let code_save_regs, code_restore_regs, env_regs_saved = saver env save_regs in - let args_code, sr, su = code_for_args env_regs_saved args [ a1; a2; a3 ] in - let code2, a = gen_expr (env_push su env_regs_saved) (a0::use_regs) sr obj in - assert (a = Addr); + 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 code_save_regs - ++ args_code ++ code2 ++ lw v0 areg (0, a0) ++ lw v0 areg (fi, v0) - ++ jalr v0 ++ (if su <> 0 then popn su else nop) + ++ args_code ++ code2 ++ cla a0 a ++ 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 | TEUnary (x, e) -> let t, a = gen_expr env free_regs save_regs e in begin match x with - | Ast.Deref -> t ++ cr r a, Addr - | Ast.Ref -> assert (a = Addr); t, Copy + | Ast.Deref -> + begin match a with + | Value r when t = nop -> nop, AddrByReg (0, r) + | _ -> t ++ cr r a, Addr + end + | Ast.Ref -> t ++ cla r a, Copy | Ast.Plus -> t ++ cr r a, Copy | Ast.Minus -> t ++ cr r a ++ neg r r, Copy | Ast.Not -> t ++ cr r a ++ not_ r r, Copy | 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 | Value v when t = nop && v <> r -> add v v oi 1 ++ move r v, Copy | _ -> assert false end | Ast.PreDecr -> begin match a with | Addr -> t ++ lw spare_reg areg (0, r) ++ sub spare_reg spare_reg oi 1 ++ sw spare_reg areg (0, r), Addr + | AddrByReg (k, rg) when t = nop -> lw r areg (k, rg) ++ sub r r oi 1 ++ sw r areg (k, rg), Copy | Value v when t = nop && v <> r -> sub v v oi 1 ++ move r v, Copy | _ -> assert false end @@ -199,6 +212,8 @@ let rec gen_expr env free_regs save_regs e = begin match a with | Addr -> t ++ move spare_reg r ++ lw spare_reg2 areg(0, spare_reg) ++ move r spare_reg2 ++ add spare_reg2 spare_reg2 oi 1 ++ sw spare_reg2 areg(0, spare_reg), Copy + | AddrByReg (k, rg) when t = nop -> + lw r areg (k, rg) ++ add spare_reg r oi 1 ++ sw spare_reg areg (k, rg), Copy | Value v when t = nop && v <> r -> move r v ++ add v v oi 1, Copy | _ -> assert false end @@ -206,6 +221,8 @@ let rec gen_expr env free_regs save_regs e = begin match a with | Addr -> t ++ move spare_reg r ++ lw spare_reg2 areg(0, spare_reg) ++ move r spare_reg2 ++ sub spare_reg2 spare_reg2 oi 1 ++ sw spare_reg2 areg(0, spare_reg), Copy + | AddrByReg (k, rg) when t = nop -> + lw r areg (k, rg) ++ sub spare_reg r oi 1 ++ sw spare_reg areg (k, rg), Copy | Value v when t = nop && v <> r -> move r v ++ sub v v oi 1, Copy | _ -> assert false end @@ -213,11 +230,12 @@ let rec gen_expr env free_regs save_regs e = | TEBinary(e1, op, e2) when op <> Ast.Lor && op <> Ast.Land -> let rs, rb, precode = match more with | [] -> - let t1, ae1 = gen_expr (env_push 4 env) free_regs save_regs e1 in + let env2, tspot = env_push 4 env in + let t1, ae1 = gen_expr env2 free_regs save_regs e1 in let t2, ae2 = gen_expr env free_regs save_regs e2 in let t1 = t1 ++ cr r ae1 in let t2 = t2 ++ cr r ae2 in - r, spare_reg, t2 ++ push r ++ t1 ++ pop spare_reg + r, spare_reg, t2 ++ sw r areg (tspot, fp) ++ t1 ++ lw spare_reg areg (tspot, fp) | b::_ -> let t1, ae1 = gen_expr env free_regs save_regs e1 in let t2, ae2 = gen_expr env more (r::save_regs) e2 in @@ -249,8 +267,10 @@ let rec gen_expr env free_regs save_regs e = | TEMember(e, i) -> let c, a = gen_expr env free_regs save_regs e in if i <> 0 then begin - assert (a = Addr); - c ++ la r areg (i, r), Addr + match a with + | Addr -> c ++ la r areg (i, r), Addr + | AddrByReg (k, rg) when c = nop -> nop, AddrByReg (k + i, rg) + | _ -> assert false end else c, a | TEPointerCast(e, i) -> @@ -258,31 +278,30 @@ let rec gen_expr env free_regs save_regs e = c ++ cr r a ++ (if i = 0 then nop else la r areg (i, r)), Copy | TENew(cls, constr, args) -> let code_save_regs, code_restore_regs, env_regs_saved = saver env save_regs in - let args_code, _, stack_used = code_for_args env_regs_saved args [ a1; a2; a3 ] in + let args_code, _, env_args = code_for_args env_regs_saved args [ a1; a2; a3 ] in code_save_regs ++ args_code ++ li v0 9 ++ li a0 cls.tc_size ++ syscall ++ move a0 v0 - ++ jal constr ++ move r a0 - ++ (if stack_used <> 0 then popn stack_used else nop) ++ code_restore_regs, Copy + ++ 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 + 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 | [] -> - let c, addr = gen_expr (env_push u env) use_regs [] arg in + let c, addr = gen_expr kenv use_regs [] arg in if byref then ( - assert (addr = Addr); - c ++ push v0 ++ code, r, sr, u + 4 + c ++ cla v0 addr ++ sw v0 areg (-kenv.c_fp_used + u, fp) ++ code, r, sr, u+4 ) else ( let c, freg = crb v0 c addr in - c ++ push freg ++ code, r, sr, u + 4 + c ++ sw freg areg (-kenv.c_fp_used + u, fp) ++ code, r, sr, u+4 ) - | reg::more_regs when u = 0 -> + | reg::more_regs -> let c, addr = gen_expr env (reg::use_regs) sr arg in - assert (addr = Addr || not byref); - code ++ c ++ (if not byref then cr reg addr else nop), more_regs, reg::sr, 0 - | _ -> assert false + 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, u + in code, sr, kenv let gen_expr_v0 env = gen_expr env use_regs env.c_save_regs @@ -332,50 +351,49 @@ let rec gen_stmt env = function comment "return" ++ c ++ (if not env.c_ret_ref then cr v0 a else nop) ++ b "_return", nop, env | TSDeclare (ty, id) -> let s = type_size env.c_penv ty in - let new_fp_used = env.c_fp_used + s in - let pos = - new_fp_used in + let env2, pos = env_push s env in let code = match ty with | TClass(i) -> let c = get_c env.c_penv i in let cproto = List.find (fun p -> p.tp_ret_type = None && p.tp_name = i && p.tp_args = []) c.tc_methods in - la sp areg (pos, fp) ++ + let code_save_regs, code_restore_regs, env_regs_saved = saver env2 env.c_save_regs in + code_save_regs ++ la a0 areg (pos, fp) ++ - jal cproto.tp_unique_ident - | _ -> la sp areg (pos, fp) ++ sw zero areg (0, sp) + la sp areg (-env_regs_saved.c_fp_used, fp) ++ + jal cproto.tp_unique_ident ++ code_restore_regs + | _ -> sw zero areg (pos, fp) in comment ("declare " ^ id) ++ code, nop, { c_penv = env.c_penv; c_names = Smap.add id (VStack pos) env.c_names; c_ret_ref = env.c_ret_ref; - c_fp_used = new_fp_used; + c_fp_used = env2.c_fp_used; c_save_regs = env.c_save_regs } | TSDeclareAssignConstructor(cls, id, constr, args) -> - let new_fp_used = env.c_fp_used + cls.tc_size in - let pos = - new_fp_used in + let env2, pos = env_push cls.tc_size env in let code = - let code_save_regs, code_restore_regs, env_regs_saved = saver (env_push cls.tc_size env) env.c_save_regs in - let args_code, _, su = code_for_args env_regs_saved args [ a1; a2; a3 ] in - la sp areg (pos, fp) ++ code_save_regs ++ args_code ++ la a0 areg(pos, fp) ++ jal constr ++ - (if su <> 0 then popn su else nop) ++ code_restore_regs + let code_save_regs, code_restore_regs, env_regs_saved = saver env2 env.c_save_regs in + let args_code, _, env_args = code_for_args env_regs_saved args [ a1; a2; a3 ] in + code_save_regs ++ args_code ++ la a0 areg(pos, fp) + ++ la sp areg (-env_args.c_fp_used, fp) ++ jal constr ++ + code_restore_regs in comment ("declare " ^ id) ++ code, nop, { c_penv = env.c_penv; c_names = Smap.add id (VStack pos) env.c_names; c_ret_ref = env.c_ret_ref; c_save_regs = env.c_save_regs; - c_fp_used = new_fp_used; } + c_fp_used = env2.c_fp_used; } | TSDeclareAssignExpr ((ty, ref), id, e) -> let s = if ref then 4 else type_size env.c_penv ty in assert (s = 4); - let new_fp_used = env.c_fp_used + 4 in - let pos = - new_fp_used in - let code, a = gen_expr_v0 (env_push 4 env) e in - assert (a = Addr || not ref); - comment ("declare " ^ id) ++ la sp areg (pos, fp) ++ code ++ (if not ref then cr v0 a else nop) ++ sw v0 areg (pos, fp), nop, + let env2, pos = env_push 4 env in + let code, a = gen_expr_v0 env2 e in + comment ("declare " ^ id) ++ code ++ (if not ref then cr v0 a else cla v0 a) ++ sw v0 areg (pos, fp), nop, { c_penv = env.c_penv; c_names = Smap.add id (if ref then VStackByRef pos else VStack pos) env.c_names; c_ret_ref = env.c_ret_ref; - c_fp_used = new_fp_used; + c_fp_used = env2.c_fp_used; c_save_regs = env.c_save_regs } | TSWriteCout(sl) -> let save_code, restore_code, env2 = saver env (if List.mem a0 env.c_save_regs then [a0] else []) in @@ -402,8 +420,7 @@ and gen_block env b = t ++ tt, d ++ dd, e) (nop, nop, env) b in - let n = (fin_env.c_fp_used - env.c_fp_used) in - text ++ (if n = 0 then nop else la sp areg (-env.c_fp_used, fp)), data + text, data let gen_decl tenv decl = match decl with | TDGlobal(ty, id) -> @@ -434,7 +451,7 @@ let gen_decl tenv decl = match decl with let code_for_constructor, does_calls = match proto.tp_ret_type with | Some _ -> nop, (List.exists stmt_does_call block) | None -> let cls_name = (match proto.tp_class with | Some k -> k | None -> assert false) in - jal (cls_name ^ "0"), true in + la sp areg (-8, fp) ++ jal (cls_name ^ "0"), true in let code_for_virtual = match proto.tp_virtual with | Some (c, _) when c.h_pos <> 0 -> la a0 areg (-c.h_pos, a0) @@ -442,7 +459,7 @@ let gen_decl tenv decl = match decl with in let code1 = label proto.tp_unique_ident ++ - sw fp areg (-4, sp) ++ sw ra areg (-8, sp) ++ move fp sp ++ la sp areg (-8, fp) + sw fp areg (-4, sp) ++ sw ra areg (-8, sp) ++ move fp sp in if does_calls then @@ -461,10 +478,9 @@ let gen_decl tenv decl = match decl with let proto = List.find (fun p -> p.tp_ret_type = None && p.tp_args = [] && p.tp_name = cn) c.tc_methods in calls_something := true; code ++ (if parent.h_pos <> 0 then la a0 areg(parent.h_pos, a0) else nop) - ++ jal proto.tp_unique_ident ++ (if parent.h_pos <> 0 then lw a0 areg(0, sp) else nop) + ++ jal proto.tp_unique_ident ++ (if parent.h_pos <> 0 then lw a0 areg (-12, fp) else nop) ) nop c.tc_hier.h_supers in - let code_parents = if code_parents <> nop then push a0 ++ code_parents ++ popn 4 else nop in (* Build vtables and build constructor *) let rec make_vtables hh = (* calculate vtable contents *) @@ -498,16 +514,22 @@ let gen_decl tenv decl = match decl with let cs = get_c tenv s in let proto = List.find (fun p -> p.tp_ret_type = None && p.tp_args = [] && p.tp_name = s) cs.tc_methods in calls_something := true; - push a0 ++ - (if pos <> 0 then la a0 areg (pos, a0) else nop) ++ - jal proto.tp_unique_ident ++ pop a0 + (if pos <> 0 then la a0 areg (pos, a0) else nop) + ++ la sp areg (-12, fp) + ++ jal proto.tp_unique_ident ++ (if pos <> 0 then lw a0 areg (-12, fp) else nop) | _ -> sw zero areg (pos, a0) ) ++ code) c.tc_members nop in (* Put it all together *) label (c.tc_name ^ "0") - ++ (if !calls_something then push ra else nop) + ++ (if !calls_something then + sw fp areg (-4, sp) ++ move fp sp ++ + sw ra areg (-8, fp) ++ sw a0 areg (-12, fp) ++ la sp areg (-12, fp) + else nop) ++ code_parents ++ vtable_init_code ++ init_code_proper - ++ (if !calls_something then pop ra else nop) ++ jr ra, vtables + ++ (if !calls_something then + lw ra areg (-8, fp) ++ move sp fp ++ lw fp areg (-4, sp) + else nop) + ++ jr ra, vtables let generate p = |