diff options
Diffstat (limited to 'src/codegen.ml')
| -rw-r--r-- | src/codegen.ml | 186 |
1 files changed, 115 insertions, 71 deletions
diff --git a/src/codegen.ml b/src/codegen.ml index 70ed095..5dde4d7 100644 --- a/src/codegen.ml +++ b/src/codegen.ml @@ -3,11 +3,19 @@ open Typing exception Very_bad_error of string +(* Convention pour les registres : + - a0, a1, a2, a3 : contiennent les (éventuels) 4 premiers arguments de la fonction + - v0 : contient la valeur de retour des fonctions + - v0-v1, t0-t9, s0-s1 : utilisés pour les calculs + Tous les registres doivent être sauvés par l'appellant +*) + (* Environnement pour accéder aux variables *) type whereis_var = | VGlobal | VStack of int (* position relative à $fp *) | VStackByRef of int + | VRegister of register type cg_env = { c_penv : env; @@ -28,11 +36,20 @@ let id = (* Génération de code des machins *) -let cr r a = if a then lw r areg (0, r) else nop (* conditionnally read *) +type expr_type = + | Addr (* top register contains address of value *) + | Copy (* top register contains copy of value *) + | Value of register (* other register is home to the value *) + +let cr r a = match a with (* conditionnally read *) + | Addr -> lw r areg (0, r) + | Copy -> nop + | Value(k) -> if r <> k then move r k else nop + +let use_regs = [ v0; v1; t0; t1; t2; t3; t4; t5; t6; t7; t8; t9 ] +let spare_reg = s0 +let spare_reg2 = s1 -let use_regs = [ a0; a1; a2; a3; t0; t1; t2; t3 ] -let spare_reg = v0 -let spare_reg2 = v1 (* Convention : doit garder $sp invariant ; renvoie le résultat dans le premier registre de free_regs *) let rec gen_expr env free_regs save_regs e = @@ -45,15 +62,16 @@ let rec gen_expr env free_regs save_regs e = (fun code r -> code ++ pop r) nop save_regs in (* the generator... *) match e.te_desc with - | TEInt(k) -> li r k, false - | TENull -> move r zero, false - | TEThis -> (* convention : this is always the last-pushed argument *) - lw r areg (8, fp), false + | TEInt(k) -> li r k, Copy + | TENull -> move r zero, Copy + | TEThis -> (* convention : this is always the last-pushed argument, so in a0 *) + lw r areg (8, fp), Copy | TEIdent(i) -> begin match Smap.find i env.c_names with - | VGlobal -> la r alab i, true - | VStack(i) -> la r areg (i, fp), true - | VStackByRef(i) -> lw r areg (i, fp), true + | VGlobal -> la r alab i, Addr + | VStack(i) -> la r areg (i, fp), Addr + | VStackByRef(i) -> lw r areg (i, fp), Addr + | VRegister(r) -> nop, Value r end | TEAssign(e1, e2) -> let t2, ae2 = gen_expr env free_regs save_regs e2 in @@ -61,47 +79,73 @@ 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 - assert ae1; - t1 ++ push r ++ t2 ++ pop spare_reg ++ sw r areg (0, spare_reg), false + begin match ae1 with + | Addr -> t1 ++ push r ++ t2 ++ pop spare_reg ++ sw r areg (0, spare_reg), Copy + | Value k when t1 = nop && k <> r -> t2 ++ move k r, Copy + | _ -> assert false + end | b::_ -> let t1, ae1 = gen_expr env more (r::save_regs) e1 in - assert ae1; - t2 ++ t1 ++ sw r areg (0, b), false + begin match ae1 with + | Addr -> t2 ++ t1 ++ sw r areg (0, b), Copy + | Value k when t1 = nop && k <> r -> t2 ++ move k r, Copy + | _ -> assert false + end end | TECallFun(id, args, b) -> let code = List.fold_left (fun code (arg, byref) -> - let c, addr = gen_expr_a0 env arg in - assert (addr || not byref); - c ++ cr a0 (addr && not byref) ++ push a0 ++ code) nop args in + let c, addr = gen_expr_v0 env arg in + assert (addr = Addr || not byref); + c ++ (if not byref then cr v0 addr else nop) ++ push v0 ++ code) nop args in code_save_regs ++ code ++ jal id ++ popn (4 * (List.length args)) - ++ (if r <> a0 then move r a0 else nop) ++ code_restore_regs, b + ++ (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 = List.fold_left (fun code (arg, byref) -> - let c, addr = gen_expr_a0 env arg in - assert (addr || not byref); - c ++ cr a0 (addr && not byref) ++ push a0 ++ code) nop args in - let code2, a = gen_expr_a0 env obj in - assert a; + let c, addr = gen_expr_v0 env arg in + assert (addr = Addr || not byref); + c ++ (if not byref then cr v0 addr else nop) ++ push v0 ++ code) nop args in + let code2, a = gen_expr_v0 env obj in + assert (a = Addr); code_save_regs - ++ code ++ code2 ++ push a0 ++ lw a0 areg (0, a0) ++ lw a0 areg (fi, a0) - ++ jalr a0 ++ popn (4 * (1 + List.length args)) - ++ (if r <> a0 then move r a0 else nop) ++ code_restore_regs, b + ++ code ++ code2 ++ push v0 ++ lw v0 areg (0, v0) ++ lw v0 areg (fi, v0) + ++ jalr v0 ++ popn (4 * (1 + List.length args)) + ++ (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, true - | Ast.Ref -> assert a; t, false - | Ast.Plus -> t ++ cr r a, false - | Ast.Minus -> t ++ cr r a ++ neg r r, false - | Ast.Not -> t ++ cr r a ++ not_ r r, false - | Ast.PreIncr -> assert a; t ++ lw spare_reg areg (0, r) ++ add spare_reg spare_reg oi 1 ++ sw spare_reg areg (0, r), true - | Ast.PreDecr -> assert a; t ++ lw spare_reg areg (0, r) ++ sub spare_reg spare_reg oi 1 ++ sw spare_reg areg (0, r), true - | Ast.PostIncr -> assert a; 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), false - | Ast.PostDecr -> assert a; 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), false + | Ast.Deref -> t ++ cr r a, Addr + | Ast.Ref -> assert (a = Addr); t, 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 + | 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 + | Value v when t = nop && v <> r -> sub v v oi 1 ++ move r v, Copy + | _ -> assert false + end + | Ast.PostIncr -> + 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 + | Value v when t = nop && v <> r -> move r v ++ add v v oi 1, Copy + | _ -> assert false + end + | Ast.PostDecr -> + 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 + | Value v when t = nop && v <> r -> move r v ++ sub v v oi 1, Copy + | _ -> assert false + end end | TEBinary(e1, op, e2) when op <> Ast.Lor && op <> Ast.Land -> let rb, precode = match more with @@ -131,67 +175,67 @@ let rec gen_expr env free_regs save_regs e = | Ast.Gt -> sgt r r rb | Ast.Ge -> sge r r rb | _ -> assert false - ), false + ), Copy | TEBinary(e1, op, e2) (* when op = Ast.Lor || op = Ast.Land *) -> let t1, ae1 = gen_expr env 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 let lazy_lbl = id "_lazy" in - t1 ++ (if op = Ast.Lor then bnez r lazy_lbl else beqz r lazy_lbl) ++ t2 ++ label lazy_lbl ++ sne r r zero, false + t1 ++ (if op = Ast.Lor then bnez r lazy_lbl else beqz r lazy_lbl) ++ t2 ++ label lazy_lbl ++ sne r r zero, Copy | TEMember(e, i) -> let c, a = gen_expr env free_regs save_regs e in if i <> 0 then begin - assert a; - c ++ la r areg (i, r), true + assert (a = Addr); + c ++ la r areg (i, r), Addr end else c, a | TEPointerCast(e, i) -> let c, a = gen_expr env free_regs save_regs e in - c ++ cr r a ++ (if i = 0 then nop else la r areg (i, r)), false + c ++ cr r a ++ (if i = 0 then nop else la r areg (i, r)), Copy | TENew(cls, constr, args) -> let args_code = List.fold_left (fun code (arg, byref) -> - let c, addr = gen_expr_a0 env arg in - assert (addr || not byref); - c ++ cr a0 (addr && not byref) ++ push a0 ++ code) nop args in + let c, addr = gen_expr_v0 env arg in + assert (addr = Addr || not byref); + c ++ (if not byref then cr v0 addr else nop) ++ push v0 ++ code) nop args in let alloc = li v0 9 ++ li a0 cls.tc_size ++ syscall in code_save_regs ++ args_code ++ alloc ++ push v0 ++ jal constr - ++ pop r ++ popn (4 * List.length args) ++ code_restore_regs, false + ++ pop r ++ popn (4 * List.length args) ++ code_restore_regs, Copy -and gen_expr_a0 env = gen_expr env use_regs [] +and gen_expr_v0 env = gen_expr env use_regs [] let rec gen_stmt env = function | TSEmpty -> nop, nop, env | TSExpr(e) -> - comment "expr" ++ (fst (gen_expr_a0 env e)), nop, env + comment "expr" ++ (fst (gen_expr_v0 env e)), nop, env | TSIf(cond, s1, s2) -> - let c, a = gen_expr_a0 env cond in + let c, a = gen_expr_v0 env cond in let l_else = id "_cond_then" in let l_end = id "_cond_end" in let c_then, d_then, _ = gen_stmt env s1 in let c_else, d_else, _ = gen_stmt env s2 in - comment "if" ++ c ++ cr a0 a ++ beqz a0 l_else ++ c_then ++ b l_end ++ + comment "if" ++ c ++ cr v0 a ++ beqz v0 l_else ++ c_then ++ b l_end ++ label l_else ++ c_else ++ label l_end, d_then ++ d_else, env | TSWhile(cond, body) -> - let c, a = gen_expr_a0 env cond in + let c, a = gen_expr_v0 env cond in let l_begin = id "_while_begin" in let l_cond = id "_while_cond" in let c_body, d_body, _ = gen_stmt env body in comment "while" ++ b l_cond ++ label l_begin ++ c_body ++ - label l_cond ++ c ++ cr a0 a ++ bnez a0 l_begin, d_body, env + label l_cond ++ c ++ cr v0 a ++ bnez v0 l_begin, d_body, env | TSFor(before, cond, after, body) -> let l_begin = id "_for_begin" in let l_cond = id "_for_cond" in let c_before = List.fold_left - (fun code expr -> let c, _ = gen_expr_a0 env expr in code ++ c) nop before in + (fun code expr -> let c, _ = gen_expr_v0 env expr in code ++ c) nop before in let c_after = List.fold_left - (fun code expr -> let c, _ = gen_expr_a0 env expr in code ++ c) nop after in + (fun code expr -> let c, _ = gen_expr_v0 env expr in code ++ c) nop after in let c_cond = match cond with | None -> b l_begin - | Some x -> let c, a = gen_expr_a0 env x in - c ++ cr a0 a ++ bnez a0 l_begin in + | Some x -> let c, a = gen_expr_v0 env x in + c ++ cr v0 a ++ bnez v0 l_begin in let c_body, d_body, _ = gen_stmt env body in comment "for" ++ c_before ++ b l_cond ++ label l_begin ++ c_body ++ c_after ++ label l_cond ++ c_cond, d_body, env @@ -201,9 +245,9 @@ let rec gen_stmt env = function | TSReturn (None) -> comment "return" ++ b "_return", nop, env | TSReturn (Some e) -> - let c, a = gen_expr_a0 env e in - assert (a || not env.c_ret_ref); - comment "return" ++ c ++ cr a0 (not env.c_ret_ref && a) ++ b "_return", nop, env + let c, a = gen_expr_v0 env e in + assert (a = Addr || not env.c_ret_ref); + 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 @@ -213,8 +257,8 @@ let rec gen_stmt env = function 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 sub sp sp oi s ++ - la a0 areg (pos, fp) ++ - push a0 ++ + la v0 areg (pos, fp) ++ + push v0 ++ jal cproto.tp_unique_ident | _ -> push zero in @@ -229,10 +273,10 @@ let rec gen_stmt env = function let code = let args_code = List.fold_left (fun code (arg, byref) -> - let c, addr = gen_expr_a0 env arg in - assert (addr || not byref); - c ++ cr a0 (addr && not byref) ++ push a0 ++ code) nop args in - sub sp sp oi cls.tc_size ++ args_code ++ la a0 areg(pos, fp) ++ push a0 ++ jal constr ++ + let c, addr = gen_expr_v0 env arg in + assert (addr = Addr || not byref); + c ++ (if not byref then cr v0 addr else nop) ++ push v0 ++ code) nop args in + sub sp sp oi cls.tc_size ++ args_code ++ la v0 areg(pos, fp) ++ push v0 ++ jal constr ++ popn (4 * (List.length args + 1)) in comment ("declare " ^ id) ++ code, nop, { @@ -245,9 +289,9 @@ let rec gen_stmt env = function assert (s = 4); let new_fp_used = env.c_fp_used + 4 in let pos = - new_fp_used in - let code, a = gen_expr_a0 env e in - assert (a || not ref); - comment ("declare " ^ id) ++ sub sp sp oi 4 ++ code ++ cr a0 (a && not ref) ++ sw a0 areg (pos, fp), nop, { + let code, a = gen_expr_v0 env e in + assert (a = Addr || not ref); + comment ("declare " ^ id) ++ sub sp sp oi 4 ++ code ++ (if not ref then cr v0 a else nop) ++ 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; @@ -257,8 +301,8 @@ let rec gen_stmt env = function (fun (text, data) s -> match s with | TSEExpr(e) -> - let t, a = gen_expr_a0 env e in - text ++ t ++ cr a0 a ++ li v0 1 ++ syscall, data + let t, a = gen_expr_v0 env e in + text ++ t ++ cr v0 a ++ move a0 v0 ++ li v0 1 ++ syscall, data | TSEStr(s) -> let l, d = if Hashtbl.mem strings s then |