Prepared for passing arguments in registers.

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