summaryrefslogtreecommitdiff
path: root/src/codegen.ml
diff options
context:
space:
mode:
Diffstat (limited to 'src/codegen.ml')
-rw-r--r--src/codegen.ml123
1 files changed, 72 insertions, 51 deletions
diff --git a/src/codegen.ml b/src/codegen.ml
index 1d6d026..423e6a6 100644
--- a/src/codegen.ml
+++ b/src/codegen.ml
@@ -10,13 +10,13 @@ type whereis_var =
| VStackByRef of int
type cg_env = {
- c_penv : env;
+ c_penv : env; (* environnement du programme (Typing.env) : contient les informations de types *)
c_names : whereis_var Smap.t;
- c_ret_ref : bool;
- c_fp_used : int;
+ c_ret_ref : bool; (* le résultat est-il renvoyé par référence ? *)
+ c_fp_used : int; (* nombre d'octets sous $fp utilisés par la fonction *)
}
-let globals_env = ref Smap.empty
+let globals_env = ref Smap.empty (* variables globales *)
let strings = Hashtbl.create 12 (* string -> label *)
@@ -26,7 +26,19 @@ let id =
fun prefix -> (last := !last + 1; prefix ^ (string_of_int !last))
-(* Génération de code des machins *)
+(* La génération de code à proprement parler !
+
+ La valeur d'une expression est générée dans le registre a0, la pile est utilisée
+ pour les calculs intermédiaires.
+
+ Le plus possible, le générateur de code enregistre dans a0 non pas la valeur
+ de l'expression mais l'adresse où cette valeur est stockée en mémoire. Évidemment,
+ une telle adresse n'existe que pour les expressions qui sont typées comme des
+ références ou des lvalues (c'est essentiellement la même chose).
+
+ La fonction cr effectue donc, dans le cas où on a l'addresse et non pas la valeur,
+ la lecture mémoire requise pour accéder à la valeur en question.
+ *)
let cr a = if a then lw a0 areg (0, a0) else nop (* conditionnally read *)
@@ -34,7 +46,8 @@ let cr a = if a then lw a0 areg (0, a0) else nop (* conditionnally read *)
let rec gen_expr env e = match e.te_desc with
| TEInt(k) -> li a0 k, false
| TENull -> move a0 zero, false
- | TEThis -> (* convention : this is always the last-pushed argument *)
+ | TEThis -> (* convention : this est toujours le premier argument de la fonction, c'est-à-dire
+ celui qui est pushé en dernier. on connait donc toujours son adresse *)
lw a0 areg (8, fp), false
| TEIdent(i) ->
begin match Smap.find i env.c_names with
@@ -72,12 +85,16 @@ let rec gen_expr env e = match e.te_desc with
| Ast.Plus -> t ++ cr a, false
| Ast.Minus -> t ++ cr a ++ neg a0 a0, false
| Ast.Not -> t ++ cr a ++ not_ a0 a0, false
- | Ast.PreIncr -> assert a; t ++ lw a1 areg (0, a0) ++ add a1 a1 oi 1 ++ sw a1 areg (0, a0), true
- | Ast.PreDecr -> assert a; t ++ lw a1 areg (0, a0) ++ sub a1 a1 oi 1 ++ sw a1 areg (0, a0), true
- | Ast.PostIncr -> assert a; t ++ move a1 a0 ++ lw a2 areg(0, a1) ++ move a0 a2 ++
- add a2 a2 oi 1 ++ sw a2 areg(0, a1), false
- | Ast.PostDecr -> assert a; t ++ move a1 a0 ++ lw a2 areg(0, a1) ++ move a0 a2 ++
- sub a2 a2 oi 1 ++ sw a2 areg(0, a1), false
+ | Ast.PreIncr -> assert a;
+ t ++ lw a1 areg (0, a0) ++ add a1 a1 oi 1 ++ sw a1 areg (0, a0), true
+ | Ast.PreDecr -> assert a;
+ t ++ lw a1 areg (0, a0) ++ sub a1 a1 oi 1 ++ sw a1 areg (0, a0), true
+ | Ast.PostIncr -> assert a;
+ t ++ move a1 a0 ++ lw a2 areg(0, a1) ++ move a0 a2
+ ++ add a2 a2 oi 1 ++ sw a2 areg(0, a1), false
+ | Ast.PostDecr -> assert a;
+ t ++ move a1 a0 ++ lw a2 areg(0, a1) ++ move a0 a2
+ ++ sub a2 a2 oi 1 ++ sw a2 areg(0, a1), false
end
| TEBinary(e1, op, e2) ->
let t1, ae1 = gen_expr env e1 in
@@ -126,24 +143,24 @@ let rec gen_expr env e = match e.te_desc with
let rec gen_stmt env = function
- | TSEmpty -> nop, nop, env
+ | TSEmpty -> nop, env
| TSExpr(e) ->
- comment "expr" ++ (fst (gen_expr env e)), nop, env
+ comment "expr" ++ (fst (gen_expr env e)), env
| TSIf(cond, s1, s2) ->
let c, a = gen_expr 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
+ let c_then, _ = gen_stmt env s1 in
+ let c_else, _ = gen_stmt env s2 in
comment "if" ++ c ++ cr a ++ beqz a0 l_else ++ c_then ++ b l_end ++
- label l_else ++ c_else ++ label l_end, d_then ++ d_else, env
+ label l_else ++ c_else ++ label l_end, env
| TSWhile(cond, body) ->
let c, a = gen_expr 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
+ let c_body, _ = gen_stmt env body in
comment "while" ++ b l_cond ++ label l_begin ++ c_body ++
- label l_cond ++ c ++ cr a ++ bnez a0 l_begin, d_body, env
+ label l_cond ++ c ++ cr a ++ bnez a0 l_begin, env
| TSFor(before, cond, after, body) ->
let l_begin = id "_for_begin" in
let l_cond = id "_for_cond" in
@@ -155,18 +172,18 @@ let rec gen_stmt env = function
| None -> b l_begin
| Some x -> let c, a = gen_expr env x in
c ++ cr a ++ bnez a0 l_begin in
- let c_body, d_body, _ = gen_stmt env body in
+ let c_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
+ ++ c_cond, env
| TSBlock(b) ->
- let c, d = gen_block env b in
- comment "block" ++ c, d, env
+ let c = gen_block env b in
+ comment "block" ++ c, env
| TSReturn (None) ->
- comment "return" ++ b "_return", nop, env
+ comment "return" ++ b "_return", env
| TSReturn (Some e) ->
let c, a = gen_expr env e in
assert (a || not env.c_ret_ref);
- comment "return" ++ c ++ cr (not env.c_ret_ref && a) ++ b "_return", nop, env
+ comment "return" ++ c ++ cr (not env.c_ret_ref && a) ++ b "_return", env
| TSDeclare (ty, id) ->
let s = type_size env.c_penv ty in
let new_fp_used = env.c_fp_used + s in
@@ -181,7 +198,7 @@ let rec gen_stmt env = function
jal cproto.tp_unique_ident
| _ -> push zero
in
- comment ("declare " ^ id) ++ code, nop,
+ comment ("declare " ^ id) ++ code,
{ env with
c_names = Smap.add id (VStack pos) env.c_names;
c_fp_used = new_fp_used }
@@ -197,7 +214,7 @@ let rec gen_stmt env = function
sub sp sp oi cls.tc_size ++ args_code ++ la a0 areg(pos, fp) ++ push a0 ++ jal constr ++
popn (4 * (List.length args + 1))
in
- comment ("declare " ^ id) ++ code, nop,
+ comment ("declare " ^ id) ++ code,
{ env with
c_names = Smap.add id (VStack pos) env.c_names;
c_fp_used = new_fp_used; }
@@ -208,36 +225,36 @@ let rec gen_stmt env = function
let pos = - new_fp_used in
let code, a = gen_expr env e in
assert (a || not r);
- comment ("declare " ^ id) ++ sub sp sp oi 4 ++ code ++ cr (a && not r) ++ sw a0 areg (pos, fp), nop,
+ comment ("declare " ^ id) ++ sub sp sp oi 4 ++ code ++ cr (a && not r) ++ sw a0 areg (pos, fp),
{ env with
c_names = Smap.add id (if r then VStackByRef pos else VStack pos) env.c_names;
c_fp_used = new_fp_used }
| TSWriteCout(sl) ->
- let text1, data1 = List.fold_left
- (fun (text, data) s ->
+ let text1 = List.fold_left
+ (fun text s ->
match s with
| TSEExpr(e) ->
let t, a = gen_expr env e in
- text ++ t ++ cr a ++ li v0 1 ++ syscall, data
+ text ++ t ++ cr a ++ li v0 1 ++ syscall
| TSEStr(s) ->
- let l, d =
+ let l =
if Hashtbl.mem strings s then
- Hashtbl.find strings s, nop
+ Hashtbl.find strings s
else
- let l = id "_s" in Hashtbl.add strings s l;
- l, label l ++ asciiz s
+ let l = id "_s" in
+ Hashtbl.add strings s l; l
in
- text ++ la a0 alab l ++ li v0 4 ++ syscall, data ++ d) (nop, nop) sl in
- comment "cout<<..." ++ text1, data1, env
+ text ++ la a0 alab l ++ li v0 4 ++ syscall) (nop) sl in
+ comment "cout<<..." ++ text1, env
and gen_block env b =
- let text, data, fin_env =
- List.fold_left (fun (t, d, e) s ->
- let tt, dd, e = gen_stmt e s in
- t ++ tt, d ++ dd, e)
- (nop, nop, env) b
+ let text, fin_env =
+ List.fold_left (fun (t, e) s ->
+ let tt, e = gen_stmt e s in
+ t ++ tt, e)
+ (nop, env) b
in
let n = (fin_env.c_fp_used - env.c_fp_used) in
- text ++ (if n = 0 then nop else popn n), data
+ text ++ (if n = 0 then nop else popn n)
let gen_decl tenv decl = match decl with
| TDGlobal(ty, id) ->
@@ -264,10 +281,10 @@ let gen_decl tenv decl = match decl with
lw a0 areg (8, fp) ++ la a0 areg (-c.h_pos, a0) ++ sw a0 areg (8, fp)
| _ -> nop
in
- let text, data = gen_block env block in
+ let text = gen_block env block in
label proto.tp_unique_ident ++
push fp ++ push ra ++ move fp sp ++ code_for_constructor ++ code_for_virtual ++
- text ++ b "_return", data
+ text ++ b "_return", nop
| TDClass(c) ->
(* Call default constructor of parent classes *)
let code_parents = List.fold_left
@@ -325,13 +342,17 @@ let generate p =
let more_text, more_data = gen_decl p.prog_env decl in
text ++ more_text, data ++ more_data) (nop, nop) p.prog_decls in
let text =
- label "main" ++ jal p.prog_main ++
- li v0 10 ++ syscall ++
- label "_return" ++ move sp fp ++ pop ra ++ pop fp ++
- label "_nothing" ++ jr ra ++
- text in
+ label "main"
+ ++ jal p.prog_main
+ ++ li v0 10 ++ syscall
+ ++ label "_return" ++ move sp fp ++ pop ra ++ pop fp
+ ++ label "_nothing" ++ jr ra
+ ++ text in
+ let str = Hashtbl.fold
+ (fun str lbl data -> data ++ label lbl ++ asciiz str)
+ strings nop in
{ text = text;
- data = data }
+ data = data ++ str }
with
| Assert_failure (k, a, b) -> raise (Very_bad_error (
"(unexpected) Assertion failure: "^k^" at "^(string_of_int a)^":"^(string_of_int b)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 12:27:16 +0000